aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data/error.lux
blob: 8f89ccb8fefe2bfd418c7f31896ef646b45c172f (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]
   [abstract
    [monad (#+ do Monad)]
    {[0 #test]
     [/
      ["$." functor (#+ Injection Comparison)]
      ["$." apply]
      ["$." monad]
      ["$." equivalence]]}]
   [control
    pipe]
   [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.unicode 1)
      element))

(def: #export test
  Test
  (<| (_.context (%name (name-of /._)))
      ($_ _.and
          ($equivalence.spec (/.equivalence nat.equivalence) (..error 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 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)

                                 _
                                 false)))))
          )))