Coverage report: /home/runner/work/geb/geb/src/geb/decision.lisp

KindCoveredAll%
expression7101 6.9
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :geb-decision)
2
 
3
 (def yes   (alias yes   (so1)) "The [YES] term")
4
 (def no    (alias no    (so1)) "The [NO] term")
5
 (def maybe (alias maybe (so1)) "The [MAYBE] term")
6
 
7
 (def inj-maybe
8
   (alias inj-maybe (comp
9
                     (->right yes (coprod no maybe))
10
                     (->right no maybe)))
11
   "Injects [MAYBE] from [SO1]")
12
 (def inj-no
13
   (alias inj-no (comp
14
                  (->right yes (coprod no maybe))
15
                  (->left no maybe)))
16
   "Injects [NO] from [SO1]")
17
 
18
 (def inj-yes (alias inj-yes (->left yes (coprod no maybe)))
19
   "Injects [YES] from [SO1]")
20
 
21
 (def decision
22
   (alias decision (coprod yes (coprod no maybe)))
23
   "The [DECISION] type")
24
 
25
 
26
 ;; for now
27
 (defun distrib (obj1 obj2)
28
   (distribute obj1 (mcar obj2) (mcadr obj2)))
29
 
30
 ;; implement mega-case instead of working with mcase
31
 ;; (defun mega-case ())
32
 
33
 ;; make mega-distribute as well, it's a pain
34
 
35
 (def demote
36
   (alias demote
37
          (mcase (const inj-maybe yes)
38
                 (const inj-no    (coprod no maybe))))
39
   "Demotes a decision. Thus if the decision was [YES], now it's now
40
 [MAYBE], if it was [MAYBE] it is now [NO]")
41
 
42
 (def promote
43
   (alias promote
44
          (mcase inj-yes
45
                 (mcase (const inj-maybe no)
46
                        (const inj-yes maybe))))
47
   "The inverse of demote. Promotes a decision so if the decision was
48
 [NO] it is now [MAYBE], and if it was [MAYBE] it is now [YES]")
49
 
50
 (def merge-opinion
51
   (alias merge-opinion
52
          (comp
53
           (mcase (comp promote
54
                        (<-left decision yes))
55
                  ;; no + maybe
56
                  (comp
57
                   (mcase (comp demote
58
                                (<-left decision no))
59
                          (<-left decision maybe))
60
                   (distribute decision no maybe)))
61
           (distrib decision decision)))
62
   "merges two [DECISION]S. Taking the average of the decisions.")