blob: f614305e06731ef40d8d085bb97dfb2331b61301 (
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
|
(;module:
lux
(lux (control functor
applicative
["M" monad #*])))
## [Types]
(type: #export (Error a)
(#Error Text)
(#Success a))
## [Structures]
(struct: #export _ (Functor Error)
(def: (map f ma)
(case ma
(#Error msg) (#Error msg)
(#Success datum) (#Success (f datum)))))
(struct: #export _ (Applicative Error)
(def: functor Functor<Error>)
(def: (wrap a)
(#Success a))
(def: (apply ff fa)
(case ff
(#Success f)
(case fa
(#Success a)
(#Success (f a))
(#Error msg)
(#Error msg))
(#Error msg)
(#Error msg))
))
(struct: #export _ (Monad Error)
(def: applicative Applicative<Error>)
(def: (join mma)
(case mma
(#Error msg) (#Error msg)
(#Success ma) ma)))
(struct: #export (ErrorT Monad<M>)
(All [M] (-> (Monad M) (Monad (All [a] (M (Error a))))))
(def: applicative (compA (get@ #M;applicative Monad<M>) Applicative<Error>))
(def: (join MeMea)
(do Monad<M>
[eMea MeMea]
(case eMea
(#Error error)
(wrap (#Error error))
(#Success Mea)
Mea))))
(def: #export (lift-error Monad<M>)
(All [M a] (-> (Monad M) (-> (M a) (M (Error a)))))
(liftM Monad<M> (:: Monad<Error> wrap)))
(def: #export (succeed value)
(All [a] (-> a (Error a)))
(#Success value))
(def: #export (fail message)
(All [a] (-> Text (Error a)))
(#Error message))
|