aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/try.lux
blob: f4eaec65672717086ef133d6ee79d3c429a47846 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do Monad)]
    {[0 #spec]
     [/
      ["$." functor (#+ Injection Comparison)]
      ["$." apply]
      ["$." monad]
      ["$." equivalence]]}]
   [control
    pipe
    ["." io]]
   [data
    ["." text ("#\." equivalence)]
    [number
     ["n" nat]]]
   [math
    ["." random (#+ Random)]]]
  {1
   ["." / (#+ Try)]})

(def: injection
  (Injection Try)
  (|>> #/.Success))

(def: comparison
  (Comparison Try)
  (function (_ ==)
    (:: (/.equivalence ==) =)))

(def: #export (try element)
  (All [a] (-> (Random a) (Random (Try a))))
  ($_ random.or
      (random.unicode 1)
      element))

(def: #export test
  Test
  (<| (_.covering /._)
      (_.with-cover [/.Try])
      (do random.monad
        [expected random.nat
         alternative (|> random.nat (random.filter (|>> (n.= expected) not)))
         error (random.unicode 1)
         #let [(^open "io\.") io.monad]])
      ($_ _.and
          (_.with-cover [/.equivalence]
            ($equivalence.spec (/.equivalence n.equivalence) (..try random.nat)))
          (_.with-cover [/.functor]
            ($functor.spec ..injection ..comparison /.functor))
          (_.with-cover [/.apply]
            ($apply.spec ..injection ..comparison /.apply))
          (_.with-cover [/.monad]
            ($monad.spec ..injection ..comparison /.monad))

          (_.cover [/.succeed]
                   (case (/.succeed expected)
                     (#/.Success actual)
                     (n.= expected actual)

                     _
                     false))
          (_.cover [/.fail]
                   (case (/.fail error)
                     (#/.Failure message)
                     (text\= error message)

                     _
                     false))
          (_.cover [/.assume]
                   (n.= expected
                        (/.assume (/.succeed expected))))
          (_.cover [/.from-maybe]
                   (case [(/.from-maybe (#.Some expected))
                          (/.from-maybe #.None)]
                     [(#/.Success actual) (#/.Failure _)]
                     (n.= expected actual)

                     _
                     false))
          (_.cover [/.to-maybe]
                   (case [(/.to-maybe (/.succeed expected))
                          (/.to-maybe (/.fail error))]
                     [(#.Some actual) #.None]
                     (n.= expected actual)

                     _
                     false))
          (_.cover [/.default]
                   (and (n.= expected
                             (/.default alternative (/.succeed expected)))
                        (n.= alternative
                             (/.default alternative (: (Try Nat)
                                                       (/.fail error))))))
          (_.cover [/.with /.lift]
                   (let [lift (/.lift io.monad)]
                     (|> (do (/.with io.monad)
                           [a (lift (io\wrap expected))
                            b (wrap alternative)]
                           (wrap (n.+ a b)))
                         io.run
                         (case> (#/.Success result)
                                (n.= (n.+ expected alternative)
                                     result)

                                _
                                false))))
          )))