blob: a54785eed5189f0877144868f6c69a0e2ddcf6b6 (
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
115
116
117
118
119
120
121
122
123
124
|
(.module:
[library
[lux "*"
["[0]" debug]
[abstract
[monad {"+" [Monad do]}]]
[control
["[0]" state]
["[0]" try {"+" [Try]} ("[1]\[0]" functor)]
["ex" exception {"+" [Exception exception:]}]
["[0]" io]
[parser
["<[0]>" code]]]
[data
["[0]" product]
["[0]" text
["%" format {"+" [format]}]]]
[time
["[0]" instant]
["[0]" duration]]
[macro
[syntax {"+" [syntax:]}]]]]
[//
[meta
[archive {"+" [Archive]}]]])
(type: .public (Operation s o)
(state.+State Try s o))
(def: .public monad
(All (_ s) (Monad (Operation s)))
(state.with try.monad))
(type: .public (Phase s i o)
(-> Archive i (Operation s o)))
(type: .public Wrapper
(All (_ s i o) (-> (Phase s i o) Any)))
(def: .public (result' state operation)
(All (_ s o)
(-> s (Operation s o) (Try [s o])))
(operation state))
(def: .public (result state operation)
(All (_ s o)
(-> s (Operation s o) (Try o)))
(|> state
operation
(\ try.monad each product.right)))
(def: .public get_state
(All (_ s o)
(Operation s s))
(function (_ state)
{try.#Success [state state]}))
(def: .public (set_state state)
(All (_ s o)
(-> s (Operation s Any)))
(function (_ _)
{try.#Success [state []]}))
(def: .public (sub [get set] operation)
(All (_ s s' o)
(-> [(-> s s') (-> s' s s)]
(Operation s' o)
(Operation s o)))
(function (_ state)
(do try.monad
[[state' output] (operation (get state))]
(in [(set state' state) output]))))
(def: .public failure
(-> Text Operation)
(|>> {try.#Failure} (state.lifted try.monad)))
(def: .public (except exception parameters)
(All (_ e) (-> (Exception e) e Operation))
(..failure (ex.error exception parameters)))
(def: .public (lifted error)
(All (_ s a) (-> (Try a) (Operation s a)))
(function (_ state)
(try\each (|>> [state]) error)))
(syntax: .public (assertion [exception <code>.any
message <code>.any
test <code>.any])
(in (list (` (if (~ test)
(\ ..monad (~' in) [])
(..except (~ exception) (~ message)))))))
(def: .public identity
(All (_ s a) (Phase s a a))
(function (_ archive input state)
{try.#Success [state input]}))
(def: .public (composite pre post)
(All (_ s0 s1 i t o)
(-> (Phase s0 i t)
(Phase s1 t o)
(Phase [s0 s1] i o)))
(function (_ archive input [pre/state post/state])
(do try.monad
[[pre/state' temp] (pre archive input pre/state)
[post/state' output] (post archive temp post/state)]
(in [[pre/state' post/state'] output]))))
(def: .public (timed definition description operation)
(All (_ s a)
(-> Name Text (Operation s a) (Operation s a)))
(do ..monad
[_ (in [])
.let [pre (io.run! instant.now)]
output operation
.let [_ (|> instant.now
io.run!
instant.relative
(duration.difference (instant.relative pre))
%.duration
(format (%.name definition) " [" description "]: ")
debug.log!)]]
(in output)))
|
