blob: e433d74549ddf2d407a74075ae53d2d91ca8fad8 (
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
|
(;module:
lux
(lux (control ["F" functor]
["A" applicative]
["M" monad #+ do Monad])))
## [Types]
(type: #export (Error a)
(#Error Text)
(#Success a))
## [Structures]
(struct: #export _ (F;Functor Error)
(def: (map f ma)
(case ma
(#Error msg) (#Error msg)
(#Success datum) (#Success (f datum)))))
(struct: #export _ (A;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 (A;compose (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 Monad<M>)
(All [M a] (-> (Monad M) (-> (M a) (M (Error a)))))
(M;lift 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))
(def: #export (assume error)
(All [a] (-> (Error a) a))
(case error
(#Success value)
value
(#Error message)
(error! message)))
(macro: #export (default tokens compiler)
{#;doc (doc "Allows you to provide a default value that will be used"
"if a (Error x) value turns out to be #Error."
(is 10
(default 20 (#Success 10)))
(is 20
(default 20 (#Error "KABOOM!"))))}
(case tokens
(^ (list else error))
(#Success [compiler (list (` (case (~ error)
(#;;Success (~' g!temp))
(~' g!temp)
(#;;Error (~ [dummy-cursor (#;Symbol ["" ""])]))
(~ else))))])
_
(#Error "Wrong syntax for default")))
|
