- Simplified CLI.

- Added way to parse CLI argument anywhere within the inputs.

2 files changed, 75 insertions, 85 deletions

diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index 8f44d3df9..5b8806384 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -2,11 +2,10 @@
   lux
   (lux (control monad
                 ["p" parser])
-       (data (coll [list "L/" Monoid<List> Monad<List>])
-             [text "T/" Monoid<Text>]
+       (data (coll [list "list/" Monoid<List> Monad<List>])
+             [text "text/" Eq<Text>]
              text/format
-             ["E" error]
-             [sum])
+             ["E" error])
        [io]
        [meta #+ with-gensyms]
        (meta [code]
@@ -47,45 +46,40 @@
   {#;doc "Parses the next input with a parsing function."}
   (All [a] (-> (-> Text (E;Error a)) (CLI a)))
   (function [inputs]
-    (case inputs
-      (#;Cons arg inputs')
-      (case (parser arg)
-        (#E;Success value)
-        (#E;Success [inputs' value])
-
-        (#E;Error parser-error)
-        (#E;Error parser-error))
-      
-      _
-      (#E;Error "Cannot parse empty arguments."))))
-
-(def: #export (option names)
-  {#;doc "Checks that a given option (with multiple possible names) has a value."}
-  (-> (List Text) (CLI Text))
+    (do E;Monad<Error>
+      [[remaining raw] (any inputs)
+       output (parser raw)]
+      (wrap [remaining output]))))
+
+(def: #export (this reference)
+  {#;doc "Checks that a token is in the inputs."}
+  (-> Text (CLI Unit))
   (function [inputs]
-    (let [[pre post] (list;split-with (. ;not (list;member? text;Eq<Text> names)) inputs)]
-      (case post
-        #;Nil
-        (#E;Error ($_ T/compose "Missing option (" (text;join-with " " names) ")"))
-
-        (^ (list& _ value post'))
-        (#E;Success [(L/compose pre post') value])
-
-        _
-        (#E;Error ($_ T/compose "Option lacks value (" (text;join-with " " names) ")"))
-        ))))
-
-(def: #export (flag names)
-  {#;doc "Checks that a given flag (with multiple possible names) is set."}
-  (-> (List Text) (CLI Bool))
+    (do E;Monad<Error>
+      [[remaining raw] (any inputs)]
+      (if (text/= reference raw)
+        (wrap [remaining []])
+        (E;fail (format "Missing token: \"" reference "\""))))))
+
+(def: #export (somewhere cli)
+  {#;doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."}
+  (All [a] (-> (CLI a) (CLI a)))
   (function [inputs]
-    (let [[pre post] (list;split-with (. ;not (list;member? text;Eq<Text> names)) inputs)]
-      (case post
-        #;Nil
-        (#E;Success [pre false])
-
-        (#;Cons _ post')
-        (#E;Success [(L/compose pre post') true])))))
+    (loop [immediate inputs]
+      (case (p;run immediate cli)
+        (#E;Success [remaining output])
+        (#E;Success [remaining output])
+
+        (#E;Error error)
+        (case immediate
+          #;Nil
+          (#E;Error error)
+          
+          (#;Cons to-omit immediate')
+          (do E;Monad<Error>
+            [[remaining output] (recur immediate')]
+            (wrap [(#;Cons to-omit remaining)
+                   output])))))))
 
 (def: #export end
   {#;doc "Ensures there are no more inputs."}
@@ -93,7 +87,7 @@
   (function [inputs]
     (case inputs
       #;Nil (#E;Success [inputs []])
-      _     (#E;Error (T/compose "Unknown parameters: " (text;join-with " " inputs))))))
+      _     (#E;Error (format "Unknown parameters: " (text;join-with " " inputs))))))
 
 ## [Syntax]
 (type: Program-Args
@@ -118,7 +112,7 @@
                   (wrap [])))
 
               (program: (name)
-                (io (log! (T/compose "Hello, " name))))
+                (io (log! (text/compose "Hello, " name))))
 
               (program: ([config config^])
                 (do Monad<IO>
@@ -137,9 +131,9 @@
                                     (case ((: (;;CLI (io;IO Unit))
                                               (do ;;Monad<CLI>
                                                 [(~@ (|> args
-                                                         (L/map (function [[binding parser]]
-                                                                  (list binding parser)))
-                                                         L/join))
+                                                         (list/map (function [[binding parser]]
+                                                                     (list binding parser)))
+                                                         list/join))
                                                  (~ g!_) ;;end]
                                                 ((~' wrap) (do io;Monad<IO>
                                                              []
diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux
index 6c6b113ea..410751b13 100644
--- a/stdlib/test/test/lux/cli.lux
+++ b/stdlib/test/test/lux/cli.lux
@@ -4,59 +4,55 @@
        (control ["M" monad #+ do Monad]
                 pipe
                 ["p" parser])
-       (data text/format
-             [text "Text/" Eq<Text>]
-             [number]
-             [product]
+       (data [product]
              [sum]
+             ["E" error]
+             [number]
+             [text "text/" Eq<Text>]
+             text/format
              (coll [list]))
-       ["&" cli]
-       ["r" math/random])
+       ["r" math/random]
+       ["." cli])
   lux/test)
 
 (context: "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)
-   singleton gen-arg]
+   yes gen-arg
+   #let [gen-ignore (|> (r;text +5) (r;filter (|>. (text/= yes) not)))]
+   no gen-ignore
+   pre-ignore (r;list +5 gen-ignore)
+   post-ignore (r;list +5 gen-ignore)]
   ($_ seq
       (test "Can read any argument."
-            (|> (&;run (list singleton) &;any)
-                (case> (#;Left _)
+            (|> (.;run (list yes) .;any)
+                (case> (#E;Error _)
                        false
                        
-                       (#;Right arg)
-                       (Text/= arg singleton))))
-
+                       (#E;Success arg)
+                       (text/= arg yes))))
+      (test "Can test tokens."
+            (and (|> (.;run (list yes) (.;this yes))
+                     (case> (#E;Error _) false (#E;Success _) true))
+                 (|> (.;run (list no) (.;this yes))
+                     (case> (#E;Error _) true (#E;Success _) false))))
       (test "Can use custom token parsers."
-            (|> (&;run (list singleton) (&;parse Nat/decode))
-                (case> (#;Left _)
+            (|> (.;run (list yes) (.;parse Nat/decode))
+                (case> (#E;Error _)
                        false
                        
-                       (#;Right parsed)
-                       (Text/= (Nat/encode parsed)
-                               singleton))))
-
-      (test "Can obtain option values."
-            (and (|> (&;run (list option-name singleton) (&;option (list option-name)))
-                     (case> (#;Left _)
-                            false
-                            
-                            (#;Right value)
-                            (Text/= value singleton)))
-                 (|> (&;run (list singleton) (&;option (list option-name)))
-                     (case> (#;Left _) true (#;Right _) false))))
-
-      (test "Can check flags."
-            (and (|> (&;run (list option-name) (&;flag (list option-name)))
-                     (case> (#;Right true) true _ false))
-                 (|> (&;run (list) (&;flag (list option-name)))
-                     (case> (#;Right false) true _ false))))
-
+                       (#E;Success parsed)
+                       (text/= (Nat/encode parsed)
+                               yes))))
       (test "Can query if there are any more inputs."
-            (and (|> (&;run (list) &;end)
-                     (case> (#;Right []) true _ false))
-                 (|> (&;run (list singleton) (p;not &;end))
-                     (case> (#;Right []) false _ true))))
+            (and (|> (.;run (list) .;end)
+                     (case> (#E;Success []) true _ false))
+                 (|> (.;run (list yes) (p;not .;end))
+                     (case> (#E;Success []) false _ true))))
+      (test "Can parse CLI input anywhere."
+            (|> (.;run (list;concat (list pre-ignore (list yes) post-ignore))
+                       (|> (.;somewhere (.;this yes))
+                           (p;before (p;some .;any))))
+                (case> (#E;Error _) false (#E;Success _) true)))
       ))