blob: 48b08b54bb9a2dcec21127b6acbe5a749cd2ee21 (
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
125
126
127
128
129
|
(.using
[library
[lux (.except except with)
[abstract
[functor (.only Functor)]
[monad (.only Monad do)]]
[control
["[0]" state]
["[0]" try (.only Try) (.open: "[1]#[0]" functor)]
["[0]" exception (.only Exception)]
["[0]" io]]
[data
["[0]" product]
[text
["%" format (.only format)]]]
[time
["[0]" instant]
["[0]" duration]]]]
[//
[meta
[archive (.only Archive)]]])
(type: .public (Operation s o)
(state.+State Try s o))
(implementation: .public functor
(All (_ s) (Functor (Operation s)))
(def: (each f it)
(function (_ state)
(case (it state)
{try.#Success [state' output]}
{try.#Success [state' (f output)]}
{try.#Failure error}
{try.#Failure error}))))
(implementation: .public monad
(All (_ s) (Monad (Operation s)))
(def: functor ..functor)
(def: (in it)
(function (_ state)
{try.#Success [state it]}))
(def: (conjoint it)
(function (_ state)
(case (it state)
{try.#Success [state' it']}
(it' state')
{try.#Failure error}
{try.#Failure error}))))
(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
(at try.monad each product.right)))
(def: .public state
(All (_ s o)
(Operation s s))
(function (_ state)
{try.#Success [state state]}))
(def: .public (with 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 (exception.error exception parameters)))
(def: .public (lifted error)
(All (_ s a) (-> (Try a) (Operation s a)))
(function (_ state)
(try#each (|>> [state]) error)))
(def: .public assertion
(template (assertion exception message test)
[(if test
(at ..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]))))
|