blob: 6d425011c8a9091fb39c7994e6fd3477d22adddb (
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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
(.module:
[lux #*
[abstract
[monoid (#+ Monoid)]
[equivalence (#+ Equivalence)]
[apply (#+ Apply)]
["." functor (#+ Functor)]
["." monad (#+ Monad do)]]])
## (type: (Maybe a)
## #.None
## (#.Some a))
(structure: #export monoid (All [a] (Monoid (Maybe a)))
(def: identity #.None)
(def: (compose mx my)
(case mx
#.None
my
(#.Some x)
(#.Some x))))
(structure: #export functor (Functor Maybe)
(def: (map f ma)
(case ma
#.None #.None
(#.Some a) (#.Some (f a)))))
(structure: #export apply (Apply Maybe)
(def: &functor ..functor)
(def: (apply ff fa)
(case [ff fa]
[(#.Some f) (#.Some a)]
(#.Some (f a))
_
#.None)))
(structure: #export monad (Monad Maybe)
(def: &functor ..functor)
(def: (wrap x)
(#.Some x))
(def: (join mma)
(case mma
#.None
#.None
(#.Some mx)
mx)))
(structure: #export (equivalence a-equivalence) (All [a] (-> (Equivalence a) (Equivalence (Maybe a))))
(def: (= mx my)
(case [mx my]
[#.None #.None]
#1
[(#.Some x) (#.Some y)]
(:: a-equivalence = x y)
_
#0)))
(structure: #export (with monad)
(All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a))))))
(def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))
(def: wrap (|>> (:: ..monad wrap) (:: monad wrap)))
(def: (join MmMma)
(do monad
[mMma MmMma]
(case mMma
#.None
(wrap #.None)
(#.Some Mma)
Mma))))
(def: #export (lift monad)
(All [M a] (-> (Monad M) (-> (M a) (M (Maybe a)))))
(:: monad map (:: ..monad wrap)))
(macro: #export (default tokens state)
{#.doc (doc "Allows you to provide a default value that will be used"
"if a (Maybe x) value turns out to be #.None."
"Note: the expression for the default value will not be computed if the base computation succeeds."
(default +20 (#.Some +10))
"=>"
+10
(default +20 #.None)
"=>"
+20)}
(case tokens
(^ (list else maybe))
(let [g!temp (: Code [dummy-cursor (#.Identifier ["" ""])])
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))))
|