aboutsummaryrefslogtreecommitdiff
path: root/stdlib/test/test/lux/cli.lux
blob: e8dbf1f823faf0ace3e1bada7368f34afc831b50 (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
(;module:
  lux
  (lux [io]
       (control monad)
       (data text/format
             [text "Text/" Eq<Text>]
             [number]
             [product]
             [sum]
             (coll [list]))
       (codata function)
       ["&" cli]
       ["R" math/random]
       pipe)
  lux/test)

(test: "CLI"
  [num-args (|> R;nat (:: @ map (n.% +10)))
   #let [(^open "Nat/") number;Codec<Text,Nat>
         gen-arg (:: @ map Nat/encode R;nat)]
   option-name (R;text +5)
   args (R;list num-args gen-arg)]
  ($_ seq
      (assert "Can read any argument."
              (|> (&;run &;any args)
                  (case> (#;Left _)
                         (n.= +0 num-args)
                         
                         (#;Right arg)
                         (and (not (n.= +0 num-args))
                              (Text/= arg (default (undefined)
                                            (list;head args)))))))

      (assert "Can safely fail parsing an argument."
              (|> (&;run (&;opt &;any) args)
                  (case> (#;Right (#;Some arg))
                         (and (not (n.= +0 num-args))
                              (Text/= arg (default (undefined)
                                            (list;head args))))

                         (#;Right #;None)
                         (n.= +0 num-args)

                         _
                         false)))
      
      (assert "Can read multiple arguments."
              (and (|> (&;run (&;some &;any) args)
                       (case> (#;Left _)
                              false
                              
                              (#;Right args')
                              (n.= num-args (list;size args'))))
                   (|> (&;run (&;many &;any) args)
                       (case> (#;Left _)
                              (n.= +0 num-args)
                              
                              (#;Right args')
                              (n.= num-args (list;size args'))))))

      (assert "Can use custom token parsers."
              (|> (&;run (&;parse Nat/decode) args)
                  (case> (#;Left _)
                         (n.= +0 num-args)
                         
                         (#;Right parsed)
                         (Text/= (Nat/encode parsed)
                                 (default (undefined)
                                   (list;head args))))))

      (assert "Can obtain option values."
              (and (|> (&;run (&;option (list option-name)) (list& option-name args))
                       (case> (#;Left _)
                              (n.= +0 num-args)
                              
                              (#;Right value)
                              (Text/= value (default (undefined)
                                              (list;head args)))))
                   (|> (&;run (&;option (list option-name)) args)
                       (case> (#;Left _) true (#;Right _) false))))

      (assert "Can check flags."
              (and (|> (&;run (&;flag (list option-name)) (list& option-name args))
                       (case> (#;Right true) true _ false))
                   (|> (&;run (&;flag (list option-name)) args)
                       (case> (#;Right false) true _ false))))

      (assert "Can query if there are any more inputs."
              (and (|> (&;run &;end args)
                       (case> (#;Right []) (n.= +0 num-args)
                              _ (n.> +0 num-args)))
                   (|> (&;run (&;not &;end) args)
                       (case> (#;Right []) (n.> +0 num-args)
                              _ (n.= +0 num-args)))))
      ))