blob: 73aef8bcdd66a1616541b508c7a2677e692a9f7d (
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
|
(.module:
[library
[lux #*
["." debug]
[abstract
[monad (#+ Monad do)]]
[control
["." state]
["." try (#+ Try) ("#\." functor)]
["ex" exception (#+ Exception exception:)]
["." io]
[parser
["s" code]]]
[data
["." product]
["." text
["%" format (#+ format)]]]
[time
["." instant]
["." 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)))
(def: .public (run' state operation)
(All [s o]
(-> s (Operation s o) (Try [s o])))
(operation state))
(def: .public (run state operation)
(All [s o]
(-> s (Operation s o) (Try o)))
(|> state
operation
(\ try.monad map 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.lift try.monad)))
(def: .public (except exception parameters)
(All [e] (-> (Exception e) e Operation))
(..failure (ex.error exception parameters)))
(def: .public (lift error)
(All [s a] (-> (Try a) (Operation s a)))
(function (_ state)
(try\map (|>> [state]) error)))
(syntax: .public (assertion exception message test)
(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 (compose 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)))
|
