aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/world/shell.lux
blob: 4cbdb27ed46d9a70ff4c65e1fdd9ef9baa8a4f8e (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
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]]
   [control
    ["." try (#+ Try)]
    ["." exception (#+ exception:)]
    ["." io (#+ IO)]
    [concurrency
     ["." promise (#+ Promise)]]
    [parser
     ["." environment (#+ Environment)]]]
   [data
    ["." text ("#\." equivalence)]
    [collection
     ["." list]]]
   [math
    ["." random]
    [number
     ["n" nat]
     ["i" int]]]]
  [\\
   ["." /
    [//
     [file (#+ Path)]]]]
  [\\spec
   ["$." /]])

(exception: dead)

(def: (mock [environment working_directory command arguments])
  (-> [Environment Path /.Command (List /.Argument)]
      (/.Mock Bit))
  (implementation
   (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))
  (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: #export 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))]]
            (wrap (do {! promise.monad}
                    [verdict (do (try.with !)
                               [process (\ shell execute [environment.empty "~" command (list)])
                                read (\ process read [])
                                error (\ process error [])
                                wrote! (do !
                                         [write (\ process write input)]
                                         (wrap (#try.Success (case write
                                                               (#try.Success _)
                                                               false
                                                               
                                                               (#try.Failure write)
                                                               (text\= input write)))))
                                destroyed! (do !
                                             [destroy (\ process destroy [])]
                                             (wrap (#try.Success (case destroy
                                                                   (#try.Success _)
                                                                   false
                                                                   
                                                                   (#try.Failure destroy)
                                                                   (text\= destruction destroy)))))
                                await (\ process await [])]
                               (wrap (and (text\= command read)
                                          (text\= oops error)
                                          wrote!
                                          destroyed!
                                          (i.= exit await))))]
                    (_.cover' [/.Shell]
                              (try.default false verdict)))))
          )))