blob: e23e9b5118cd89e3665925bdd8f2d5bb97e820db (
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
|
(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data [error #+ Error]
[text]
(collection ["dict" dictionary #+ Dictionary])))
[// #+ Operation Compiler])
(type: #export (Extension i)
(#Base i)
(#Extension [Text (List (Extension i))]))
(with-expansions [<Bundle> (as-is (Dictionary Text (-> Text (Handler s i o))))]
(type: #export (Handler s i o)
(-> (Compiler [s <Bundle>] (Extension i) (Extension o))
(Compiler [s <Bundle>] (List (Extension i)) (Extension o))))
(type: #export (Bundle s i o)
<Bundle>))
(do-template [<name>]
[(exception: #export (<name> {name Text})
(ex.report ["Name" name]))]
[unknown-extension]
[cannot-overwrite-existing-extension]
)
(def: #export (extend compiler)
(All [s i o]
(-> (Compiler s i o)
(Compiler [s (Bundle s i o)]
(Extension i)
(Extension o))))
(function (compiler' input (^@ stateE [stateB bundle]))
(case input
(#Base input')
(do error.Monad<Error>
[[stateB' output] (compiler input' stateB)]
(wrap [[stateB' bundle] (#Base output)]))
(#Extension name parameters)
(case (dict.get name bundle)
(#.Some handler)
(do error.Monad<Error>
[[stateE' output] (handler name compiler' parameters stateE)]
(wrap [stateE' output]))
#.None
(ex.throw unknown-extension name)))))
(def: #export (install name handler)
(All [s i o]
(-> Text (-> Text (Handler s i o))
(Operation [s (Bundle s i o)] Any)))
(function (_ (^@ stateE [_ bundle]))
(if (dict.contains? name bundle)
(ex.throw cannot-overwrite-existing-extension name)
(ex.return [stateE (dict.put name handler bundle)]))))
(def: #export fresh
Bundle
(dict.new text.Hash<Text>))
|
