blob: d3c7e24f8e7901cdab4f9c1a525ef69abebd442d (
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)]
[number
["n" nat]
["i" int]]
[collection
["." list]]]
[math
["." random]]]
{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 [/.mock /.Simulation]
($/.spec (/.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' [/.async /.Can-Write]
(try.default false verdict)))))
)))
|
