blob: c3f544604567c2e9c9cf577ddab2d78bcd45fda3 (
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:
[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)}
)))
|
