blob: d954c5581db5f5aae8633bd39a8530e728c63b61 (
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
|
(.module:
[library
[lux #*]]
[///
[functor (#+ Functor)]
[apply (#+ Apply)]
[monad (#+ Monad)]])
(type: .public (Free F a)
{#.doc "The Free Monad."}
(#Pure a)
(#Effect (F (Free F a))))
(implementation: .public (functor 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)))))
(implementation: .public (apply dsl)
(All [F] (-> (Functor F) (Apply (Free F))))
(def: &functor (..functor dsl))
(def: (apply ef ea)
(case [ef ea]
[(#Pure f) (#Pure a)]
(#Pure (f a))
[(#Pure f) (#Effect fa)]
(#Effect (\ dsl map
(\ (..functor dsl) map f)
fa))
[(#Effect ff) _]
(#Effect (\ dsl map
(function (_ f) (apply f ea))
ff))
)))
(implementation: .public (monad dsl)
(All [F] (-> (Functor F) (Monad (Free F))))
(def: &functor (..functor dsl))
(def: (in 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 dsl) join)
fefa))
)))
|
