blob: fa7d77f228bbf395e38075a79255a0e147025eb2 (
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
|
(.module:
[lux #*
["_" test (#+ Test)]
["." debug]
[abstract
[monad (#+ do)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]
["." io (#+ IO)]
[concurrency
["." promise (#+ Promise)]]
[security
["!" capability]]
[parser
["." environment (#+ Environment)]]]
[data
["." text ("#\." equivalence)]
[collection
["." list]]]
[math
["." random]
[number
["n" nat]
["i" int]]]]
{1
["." /
[//
[file (#+ Path)]]]}
{[1 #spec]
["$." /]})
(exception: dead)
(def: (simulation [environment working_directory command arguments])
(-> [Environment Path /.Command (List /.Argument)]
(/.Simulation Bit))
(structure
(def: (on_read dead?)
(if dead?
(exception.throw ..dead [])
(do try.monad
[to_echo (try.from_maybe (list.head arguments))]
(wrap [dead? to_echo]))))
(def: (on_error dead?)
(if dead?
(exception.throw ..dead [])
(exception.return [dead? ""])))
(def: (on_write message dead?)
(if dead?
(exception.throw ..dead [])
(#try.Success dead?)))
(def: (on_destroy dead?)
(if dead?
(exception.throw ..dead [])
(#try.Success true)))
(def: (on_await dead?)
(if dead?
(exception.throw ..dead [])
(#try.Success [true /.normal])))))
(def: (io_shell command oops input destruction exit)
(-> /.Command Text Text Text /.Exit (/.Shell IO))
(structure
(def: execute
((debug.private /.can_execute)
(function (_ [environment working_directory command arguments])
(io.io
(#try.Success
(: (/.Process IO)
(structure
(def: read
((debug.private /.can_read)
(function (_ _)
(io.io (#try.Success command)))))
(def: error
((debug.private /.can_read)
(function (_ _)
(io.io (#try.Success oops)))))
(def: write
((debug.private /.can_write)
(function (_ message)
(io.io (#try.Failure message)))))
(def: destroy
((debug.private /.can_destroy)
(function (_ _)
(io.io (#try.Failure destruction)))))
(def: await
((debug.private /.can_wait)
(function (_ _)
(io.io (#try.Success exit))))))))))))))
(def: #export test
Test
(<| (_.covering /._)
($_ _.and
(_.for [/.async /.mock /.Simulation]
($/.spec (/.async (/.mock (|>> ..simulation #try.Success)
false))))
(_.cover [/.error]
(not (i.= /.normal /.error)))
(do random.monad
[command (random.ascii/alpha 5)
oops (random.ascii/alpha 5)
input (random.ascii/alpha 5)
destruction (random.ascii/alpha 5)
exit random.int
#let [shell (/.async (..io_shell command oops input destruction exit))]]
(wrap (do {! promise.monad}
[verdict (do (try.with !)
[process (!.use (\ shell execute) [environment.empty "~" command (list)])
read (!.use (\ process read) [])
error (!.use (\ process error) [])
wrote! (do !
[write (!.use (\ process write) [input])]
(wrap (#try.Success (case write
(#try.Success _)
false
(#try.Failure write)
(text\= input write)))))
destroyed! (do !
[destroy (!.use (\ process destroy) [])]
(wrap (#try.Success (case destroy
(#try.Success _)
false
(#try.Failure destroy)
(text\= destruction destroy)))))
await (!.use (\ process await) [])]
(wrap (and (text\= command read)
(text\= oops error)
wrote!
destroyed!
(i.= exit await))))]
(_.cover' [/.Can_Write]
(try.default false verdict)))))
)))
|
