blob: ae146be744a0c7c2a2bcf112c1b92a68fb907f22 (
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
|
(.module:
[lux #*
[control
["." state]
["ex" exception (#+ Exception exception:)]
[monad (#+ do)]]
[data
["." product]
["." error (#+ Error)]
["." text
format]]
[macro
["s" syntax (#+ syntax:)]]])
(type: #export (Operation s o)
(state.State' Error s o))
(def: #export Monad<Operation>
(state.Monad<State'> error.Monad<Error>))
(type: #export (Phase s i o)
(-> i (Operation s o)))
(def: #export (run' state operation)
(All [s o]
(-> s (Operation s o) (Error [s o])))
(operation state))
(def: #export (run state operation)
(All [s o]
(-> s (Operation s o) (Error o)))
(|> state
operation
(:: error.Monad<Error> map product.right)))
(def: #export fail
(-> Text Operation)
(|>> error.fail (state.lift error.Monad<Error>)))
(def: #export (throw exception parameters)
(All [e] (-> (Exception e) e Operation))
(state.lift error.Monad<Error>
(ex.throw exception parameters)))
(syntax: #export (assert exception message test)
(wrap (list (` (if (~ test)
(:: ..Monad<Operation> (~' wrap) [])
(..throw (~ exception) (~ message)))))))
(def: #export (with-stack exception message action)
(All [e s o] (-> (Exception e) e (Operation s o) (Operation s o)))
(<<| (ex.with-stack exception message)
action))
(def: #export identity
(All [s a] (Phase s a a))
(function (_ input state)
(#error.Success [state input])))
(def: #export (compose pre post)
(All [s0 s1 i t o]
(-> (Phase s0 i t)
(Phase s1 t o)
(Phase [s0 s1] i o)))
(function (_ input [pre/state post/state])
(do error.Monad<Error>
[[pre/state' temp] (pre input pre/state)
[post/state' output] (post temp post/state)]
(wrap [[pre/state' post/state'] output]))))
(type: #export Eval
(-> Type Code (Error Any)))
|
