aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data/error.lux
blob: 1dbe1969e629d41cfbe793d83102d38e30b9de7a (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)]
   ["." io]
   [control
    pipe
    [monad (#+ do Monad)]
    {[0 #test]
     [/
      [".T" functor (#+ Injection Comparison)]
      [".T" apply]
      [".T" monad]
      [".T" equivalence]]}]
   [data
    text/format
    [number
     ["." nat]]]
   [math
    ["r" random (#+ Random)]]]
  {1
   ["." / (#+ Error)]})

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

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

(def: #export (error element)
  (All [a] (-> (Random a) (Random (Error a))))
  ($_ r.or
      (r.ascii 10)
      element))

(def: #export test
  Test
  (<| (_.context (%name (name-of /.Error)))
      ($_ _.and
          (equivalenceT.test (/.equivalence nat.equivalence) (..error r.nat))
          (functorT.laws ..injection ..comparison /.functor)
          (applyT.laws ..injection ..comparison /.apply)
          (monadT.laws ..injection ..comparison /.monad)
          (do r.monad
            [left r.nat
             right r.nat
             #let [expected (n/+ left right)
                   (^open "io@.") io.monad]]
            (let []
              (_.test "Can add error 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)

                                   _
                                   #0))))))
          )))