aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/try.lux
blob: 40015c5df26d3623b5fd052b17add346b4132065 (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
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do Monad)]
    {[0 #test]
     [/
      ["$." functor (#+ Injection Comparison)]
      ["$." apply]
      ["$." monad]
      ["$." equivalence]]}]
   [control
    pipe
    ["." io]]
   [data
    ["%" text/format (#+ format)]
    [number
     ["." nat]]]
   [math
    ["r" 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))))
  ($_ r.or
      (r.unicode 1)
      element))

(def: #export test
  Test
  (<| (_.context (%.name (name-of /._)))
      ($_ _.and
          ($equivalence.spec (/.equivalence nat.equivalence) (..try r.nat))
          ($functor.spec ..injection ..comparison /.functor)
          ($apply.spec ..injection ..comparison /.apply)
          ($monad.spec ..injection ..comparison /.monad)
          (do r.monad
            [left r.nat
             right r.nat
             #let [expected (n/+ left right)
                   (^open "io@.") io.monad]]
            (_.test "Can add try functionality to any monad."
                    (let [lift (/.lift io.monad)]
                      (|> (do (/.with io.monad)
                            [a (lift (io@wrap left))
                             b (wrap right)]
                            (wrap (n/+ a b)))
                          io.run
                          (case> (#/.Success actual)
                                 (n/= expected actual)

                                 _
                                 false)))))
          )))