blob: b30de7b1f8f609d0c8cd8bb5932e1b99d7cc4272 (
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
|
(.module:
lux
[///
[functor (#+ Functor)]
[apply (#+ Apply)]
[monad (#+ Monad)]])
(type: #export (Free F a)
{#.doc "The Free Monad."}
(#Pure a)
(#Effect (F (Free F a))))
(structure: #export (Functor<Free> dsl)
(All [F] (-> (Functor F) (Functor (Free F))))
(def: (map f ea)
(case ea
(#Pure a)
(#Pure (f a))
(#Effect value)
(#Effect (:: dsl map (map f) value)))))
(structure: #export (Apply<Free> dsl)
(All [F] (-> (Functor F) (Apply (Free F))))
(def: functor (Functor<Free> dsl))
(def: (apply ef ea)
(case [ef ea]
[(#Pure f) (#Pure a)]
(#Pure (f a))
[(#Pure f) (#Effect fa)]
(#Effect (:: dsl map
(:: (Functor<Free> dsl) map f)
fa))
[(#Effect ff) _]
(#Effect (:: dsl map
(function (_ f) (apply f ea))
ff))
)))
(structure: #export (Monad<Free> dsl)
(All [F] (-> (Functor F) (Monad (Free F))))
(def: functor (Functor<Free> dsl))
(def: (wrap a)
(#Pure a))
(def: (join efefa)
(case efefa
(#Pure efa)
(case efa
(#Pure a)
(#Pure a)
(#Effect fa)
(#Effect fa))
(#Effect fefa)
(#Effect (:: dsl map
(:: (Monad<Free> dsl) join)
fefa))
)))
|