aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/world/shell.lux
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)))))
          )))