blob: 4451f1f6f8f52d7b1039a5311361cd98c0a7818a (
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
|
(.module:
[library
[lux #*
["_" test (#+ Test)]
[abstract
[monad (#+ do)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]
["." io (#+ IO)]
[concurrency
["." async (#+ Async)]]
[parser
["." environment (#+ Environment)]]]
[data
["." text ("#\." equivalence)]
[collection
["." list]]]
[math
["." random]
[number
["n" nat]
["i" int]]]]]
[\\library
["." /
[//
[file (#+ Path)]]]]
[\\specification
["$." /]])
(exception: dead)
(def: (mock [environment working_directory command arguments])
(-> [Environment Path /.Command (List /.Argument)]
(/.Mock Bit))
(implementation
(def: (on_read dead?)
(if dead?
(exception.except ..dead [])
(do try.monad
[echo (try.of_maybe (list.head arguments))]
(in [dead? echo]))))
(def: (on_error dead?)
(if dead?
(exception.except ..dead [])
(#try.Success [dead? ""])))
(def: (on_write message dead?)
(if dead?
(exception.except ..dead [])
(#try.Success dead?)))
(def: (on_destroy dead?)
(if dead?
(exception.except ..dead [])
(#try.Success true)))
(def: (on_await dead?)
(if dead?
(exception.except ..dead [])
(#try.Success [true /.normal])))))
(def: (io_shell command oops input destruction exit)
(-> /.Command Text Text Text /.Exit (/.Shell IO))
(implementation
(def: (execute [environment working_directory command arguments])
(<| io.io
#try.Success
(: (/.Process IO))
(implementation
(def: (read _)
(io.io (#try.Success command)))
(def: (error _)
(io.io (#try.Success oops)))
(def: (write message)
(io.io (#try.Failure message)))
(def: (destroy _)
(io.io (#try.Failure destruction)))
(def: (await _)
(io.io (#try.Success exit))))))))
(def: .public test
Test
(<| (_.covering /._)
($_ _.and
(_.for [/.async /.mock /.Mock]
($/.spec (/.async (/.mock (|>> ..mock #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))]]
(in (do {! async.monad}
[verdict (do (try.with !)
[process (\ shell execute [environment.empty "~" command (list)])
read (\ process read [])
error (\ process error [])
wrote! (do !
[write (\ process write input)]
(in (#try.Success (case write
(#try.Success _)
false
(#try.Failure write)
(text\= input write)))))
destroyed! (do !
[destroy (\ process destroy [])]
(in (#try.Success (case destroy
(#try.Success _)
false
(#try.Failure destroy)
(text\= destruction destroy)))))
await (\ process await [])]
(in (and (text\= command read)
(text\= oops error)
wrote!
destroyed!
(i.= exit await))))]
(_.cover' [/.Shell]
(try.else false verdict)))))
)))
|