blob: bd250ef05a8154dcc761a2d4aae39b6b79b444d6 (
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
|
(.using
[library
[lux "*"]]
[///
[functor {"+" Functor}]
[apply {"+" Apply}]
[monad {"+" Monad}]])
(type: .public (Free F a)
(Variant
{#Pure a}
{#Effect (F (Free F a))}))
(implementation: .public (functor dsl)
(All (_ F) (-> (Functor F) (Functor (Free F))))
(def: (each f ea)
(case ea
{#Pure a}
{#Pure (f a)}
{#Effect value}
{#Effect (# dsl each (each f) value)})))
(implementation: .public (apply dsl)
(All (_ F) (-> (Functor F) (Apply (Free F))))
(def: functor
(..functor dsl))
(def: (on ea ef)
(case [ef ea]
[{#Pure f} {#Pure a}]
{#Pure (f a)}
[{#Pure f} {#Effect fa}]
{#Effect (# dsl each
(# (..functor dsl) each f)
fa)}
[{#Effect ff} _]
{#Effect (# dsl each (on ea) ff)}
)))
(implementation: .public (monad dsl)
(All (_ F) (-> (Functor F) (Monad (Free F))))
(def: functor (..functor dsl))
(def: (in a)
{#Pure a})
(def: (conjoint efefa)
(case efefa
{#Pure efa}
(case efa
{#Pure a}
{#Pure a}
{#Effect fa}
{#Effect fa})
{#Effect fefa}
{#Effect (# dsl each
(# (monad dsl) conjoint)
fefa)}
)))
|