blob: 10d2d62ca8c20489eb0bd22bc1ab1ce548828d49 (
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
|
(.module:
[lux #*
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["." error (#+ Error)]
["." text]
[collection
["dict" dictionary (#+ Dictionary)]]]
["." function]]
["." //])
(type: #export (Extension i)
[Text (List i)])
(with-expansions [<Bundle> (as-is (Dictionary Text (Handler s i o)))]
(type: #export (Handler s i o)
(-> Text
(//.Compiler [<Bundle> s] i o)
(//.Compiler [<Bundle> s] (List i) o)))
(type: #export (Bundle s i o)
<Bundle>))
(type: #export (Operation s i o v)
(//.Operation [(Bundle s i o) s] v))
(type: #export (Compiler s i o)
(//.Compiler [(Bundle s i o) s] i o))
(do-template [<name>]
[(exception: #export (<name> {name Text})
(ex.report ["Name" name]))]
[unknown]
[cannot-overwrite]
)
(def: #export (install name handler)
(All [s i o]
(-> Text (Handler s i o) (Operation s i o Any)))
(function (_ [bundle state])
(if (dict.contains? name bundle)
(ex.throw cannot-overwrite name)
(#error.Success [[(dict.put name handler bundle) state]
[]]))))
(def: #export (apply compiler [name parameters])
(All [s i o]
(-> (Compiler s i o) (Extension i) (Operation s i o o)))
(function (_ (^@ stateE [bundle state]))
(case (dict.get name bundle)
#.None
(ex.throw unknown name)
(#.Some handler)
((handler name compiler) parameters stateE))))
(def: #export (localized get set transform)
(All [s s' i o v]
(-> (-> s s') (-> s' s s) (-> s' s')
(-> (Operation s i o v) (Operation s i o v))))
(function (_ operation)
(function (_ [bundle state])
(let [old (get state)]
(case (operation [bundle (set (transform old) state)])
(#error.Error error)
(#error.Error error)
(#error.Success [[bundle' state'] output])
(#error.Success [[bundle' (set old state')] output]))))))
(def: #export (temporary transform)
(All [s i o v]
(-> (-> s s)
(-> (Operation s i o v) (Operation s i o v))))
(function (_ operation)
(function (_ [bundle state])
(case (operation [bundle (transform state)])
(#error.Error error)
(#error.Error error)
(#error.Success [[bundle' state'] output])
(#error.Success [[bundle' state] output])))))
(def: #export (with-state state)
(All [s i o v]
(-> s (-> (Operation s i o v) (Operation s i o v))))
(..temporary (function.constant state)))
(def: #export (read get)
(All [s i o v]
(-> (-> s v) (Operation s i o v)))
(function (_ [bundle state])
(#error.Success [[bundle state] (get state)])))
(def: #export (update transform)
(All [s i o]
(-> (-> s s) (Operation s i o Any)))
(function (_ [bundle state])
(#error.Success [[bundle (transform state)] []])))
(def: #export (lift action)
(All [s i o v]
(-> (//.Operation s v)
(//.Operation [(Bundle s i o) s] v)))
(function (_ [bundle state])
(case (action state)
(#error.Error error)
(#error.Error error)
(#error.Success [state' output])
(#error.Success [[bundle state] output]))))
|
