blob: dd87d58661eb0ae4a280c35ede7b386a69717a1a (
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
130
131
132
133
134
135
136
137
138
139
140
141
142
|
(.require
[library
[lux (.except except with try)
[abstract
[functor (.only Functor)]
[monad (.only Monad do)]]
[control
["[0]" state]
["[0]" try (.only Try) (.use "[1]#[0]" functor)]
["[0]" exception (.only Exception)]
["[0]" io]]
[data
["[0]" product]
[text
["%" \\format (.only format)]]]
[world
[time
["[0]" instant]
["[0]" duration]]]]]
[//
[meta
[archive (.only Archive)]]])
(type .public (Operation s o)
(state.+State Try s o))
(def .public functor
(All (_ s) (Functor (Operation s)))
(implementation
(def (each f it)
(function (_ state)
(when (it state)
{try.#Success [state' output]}
{try.#Success [state' (f output)]}
{try.#Failure error}
{try.#Failure error})))))
(def .public monad
(All (_ s) (Monad (Operation s)))
(implementation
(def functor ..functor)
(def (in it)
(function (_ state)
{try.#Success [state it]}))
(def (conjoint it)
(function (_ state)
(when (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 (_ exception message test)
[(if test
(at ..monad in [])
(..except exception message))]))
(def .public (try it)
(All (_ state value)
(-> (Operation state value)
(Operation state (Try value))))
(function (_ state)
(when (it state)
{try.#Success [state' it']}
{try.#Success [state' {try.#Success it'}]}
{try.#Failure error}
{try.#Success [state {try.#Failure error}]})))
(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]))))
|
