blob: 3c247eea30d43275483378938e0caecced832ede (
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
99
100
101
|
(;module:
lux
(lux (control ["m" monoid]
["F" functor]
["A" applicative]
[monad #+ do Monad]
[eq #+ Eq])))
## [Types]
## (type: (Maybe a)
## #;None
## (#;Some a))
## [Structures]
(struct: #export Monoid<Maybe> (All [a] (m;Monoid (Maybe a)))
(def: identity #;None)
(def: (compose xs ys)
(case xs
#;None ys
(#;Some x) (#;Some x))))
(struct: #export _ (F;Functor Maybe)
(def: (map f ma)
(case ma
#;None #;None
(#;Some a) (#;Some (f a)))))
(struct: #export _ (A;Applicative Maybe)
(def: functor Functor<Maybe>)
(def: (wrap x)
(#;Some x))
(def: (apply ff fa)
(case [ff fa]
[(#;Some f) (#;Some a)]
(#;Some (f a))
_
#;None)))
(struct: #export _ (Monad Maybe)
(def: applicative Applicative<Maybe>)
(def: (join mma)
(case mma
#;None #;None
(#;Some xs) xs)))
(struct: #export (Eq<Maybe> Eq<a>) (All [a] (-> (Eq a) (Eq (Maybe a))))
(def: (= mx my)
(case [mx my]
[#;None #;None]
true
[(#;Some x) (#;Some y)]
(:: Eq<a> = x y)
_
false)))
(struct: #export (MaybeT Monad<M>)
(All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a))))))
(def: applicative (A;compose (get@ #monad;applicative Monad<M>) Applicative<Maybe>))
(def: (join MmMma)
(do Monad<M>
[mMma MmMma]
(case mMma
#;None
(wrap #;None)
(#;Some Mma)
Mma))))
(def: #export (lift Monad<M>)
(All [M a] (-> (Monad M) (-> (M a) (M (Maybe a)))))
(monad;lift Monad<M> (:: Monad<Maybe> wrap)))
(macro: #export (default tokens state)
{#;doc "## Allows you to provide a default value that will be used
## if a (Maybe x) value turns out to be #;None.
(default 20 (#;Some 10)) => 10
(default 20 #;None) => 20"}
(case tokens
(^ (list else maybe))
(let [g!temp (: Code [dummy-cursor (#;Symbol ["" ""])])
code (` (case (~ maybe)
(#;Some (~ g!temp))
(~ g!temp)
#;None
(~ else)))]
(#;Right [state (list code)]))
_
(#;Left "Wrong syntax for default")))
(def: #export assume
(All [a] (-> (Maybe a) a))
(|>> (default (undefined))))
|
