From 6d4950f84e4ec1d35dff95c9816d75f360d4a349 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 19 Apr 2019 18:49:43 -0400
Subject: Moved the CLI parser under "lux/control/parser/".

---
 stdlib/source/lux/control/cli.lux             | 176 --------------------------
 stdlib/source/lux/control/parser/cli.lux      | 176 ++++++++++++++++++++++++++
 stdlib/source/program/compositor/cli.lux      |  10 +-
 stdlib/source/test/lux.lux                    |   5 +-
 stdlib/source/test/lux/control.lux            |   6 +-
 stdlib/source/test/lux/control/cli.lux        |  75 -----------
 stdlib/source/test/lux/control/parser/cli.lux |  77 +++++++++++
 7 files changed, 264 insertions(+), 261 deletions(-)
 delete mode 100644 stdlib/source/lux/control/cli.lux
 create mode 100644 stdlib/source/lux/control/parser/cli.lux
 delete mode 100644 stdlib/source/test/lux/control/cli.lux
 create mode 100644 stdlib/source/test/lux/control/parser/cli.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/control/cli.lux b/stdlib/source/lux/control/cli.lux
deleted file mode 100644
index ae712d644..000000000
--- a/stdlib/source/lux/control/cli.lux
+++ /dev/null
@@ -1,176 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    [monad (#+ do)]]
-   [data
-    [collection
-     ["." list ("#@." monoid monad)]]
-    ["." text ("#@." equivalence)
-     format]
-    ["." error (#+ Error)]]
-   [macro (#+ with-gensyms)
-    ["." code]
-    ["s" syntax (#+ Syntax syntax:)]]
-   [tool
-    [compiler
-     ["." host]]]]
-  [//
-   ["." io]
-   ["p" parser (#+ Parser)]
-   [concurrency
-    ["." process]]])
-
-(type: #export (CLI a)
-  {#.doc "A command-line interface parser."}
-  (Parser (List Text) a))
-
-(def: #export (run inputs parser)
-  (All [a] (-> (List Text) (CLI a) (Error a)))
-  (case (p.run inputs parser)
-    (#error.Success [remaining output])
-    (case remaining 
-      #.Nil
-      (#error.Success output)
-
-      _
-      (#error.Failure (format "Remaining CLI inputs: " (text.join-with " " remaining))))
-
-    (#error.Failure error)
-    (#error.Failure error)))
-
-(def: #export any
-  {#.doc "Just returns the next input without applying any logic."}
-  (CLI Text)
-  (function (_ inputs)
-    (case inputs
-      (#.Cons arg inputs')
-      (#error.Success [inputs' arg])
-      
-      _
-      (#error.Failure "Cannot parse empty arguments."))))
-
-(def: #export (parse parser)
-  {#.doc "Parses the next input with a parsing function."}
-  (All [a] (-> (-> Text (Error a)) (CLI a)))
-  (function (_ inputs)
-    (do error.monad
-      [[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 Any))
-  (function (_ inputs)
-    (do error.monad
-      [[remaining raw] (any inputs)]
-      (if (text@= reference raw)
-        (wrap [remaining []])
-        (error.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)
-    (loop [immediate inputs]
-      (case (p.run immediate cli)
-        (#error.Success [remaining output])
-        (#error.Success [remaining output])
-
-        (#error.Failure error)
-        (case immediate
-          #.Nil
-          (#error.Failure error)
-          
-          (#.Cons to-omit immediate')
-          (do error.monad
-            [[remaining output] (recur immediate')]
-            (wrap [(#.Cons to-omit remaining)
-                   output])))))))
-
-(def: #export end
-  {#.doc "Ensures there are no more inputs."}
-  (CLI Any)
-  (function (_ inputs)
-    (case inputs
-      #.Nil (#error.Success [inputs []])
-      _     (#error.Failure (format "Unknown parameters: " (text.join-with " " inputs))))))
-
-(def: #export (named name value)
-  (All [a] (-> Text (CLI a) (CLI a)))
-  (|> value
-      (p.after (..this name))
-      ..somewhere))
-
-(def: #export (parameter [short long] value)
-  (All [a] (-> [Text Text] (CLI a) (CLI a)))
-  (|> value
-      (p.after (p.either (..this short) (..this long)))
-      ..somewhere))
-
-(type: Program-Args
-  (#Raw Text)
-  (#Parsed (List [Code Code])))
-
-(def: program-args^
-  (Syntax Program-Args)
-  (p.or s.local-identifier
-        (s.tuple (p.some (p.either (do p.monad
-                                     [name s.local-identifier]
-                                     (wrap [(code.identifier ["" name]) (` any)]))
-                                   (s.record (p.and s.any s.any)))))))
-
-(syntax: #export (program:
-                   {args program-args^}
-                   body)
-  {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)."
-              "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module."
-              (program: all-args
-                (do io.monad
-                  [foo init-program
-                   bar (do-something all-args)]
-                  (wrap [])))
-
-              (program: [name]
-                (io (log! (text@compose "Hello, " name))))
-
-              (program: [{config config^}]
-                (do io.monad
-                  [data (init-program config)]
-                  (do-something data))))}
-  (with-gensyms [g!program]
-    (case args
-      (#Raw args)
-      (wrap (list (` ("lux def program"
-                      (.function ((~ g!program) (~ (code.identifier ["" args])))
-                        ((~! do) (~! io.monad)
-                         []
-                         (~ body)))))))
-      
-      (#Parsed args)
-      (with-gensyms [g!args g!_ g!output g!message]
-        (wrap (list (` ("lux def program"
-                        (.function ((~ g!program) (~ g!args))
-                          (case ((: (~! (..CLI (io.IO .Any)))
-                                    ((~! do) (~! p.monad)
-                                     [(~+ (|> args
-                                              (list@map (function (_ [binding parser])
-                                                          (list binding parser)))
-                                              list@join))
-                                      (~ g!_) ..end]
-                                     ((~' wrap) ((~! do) (~! io.monad)
-                                                 [(~ g!output) (~ body)
-                                                  (~+ (`` (for {(~~ (static host.old))
-                                                                (list)}
-                                                               (list g!_
-                                                                     (` process.run!)))))]
-                                                 ((~' wrap) (~ g!output))))))
-                                 (~ g!args))
-                            (#error.Success [(~ g!_) (~ g!output)])
-                            (~ g!output)
-
-                            (#error.Failure (~ g!message))
-                            (.error! (~ g!message))
-                            ))))
-                    )))
-      )))
diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux
new file mode 100644
index 000000000..e3ac37255
--- /dev/null
+++ b/stdlib/source/lux/control/parser/cli.lux
@@ -0,0 +1,176 @@
+(.module:
+  [lux #*
+   [abstract
+    [monad (#+ do)]]
+   [data
+    [collection
+     ["." list ("#@." monoid monad)]]
+    ["." text ("#@." equivalence)
+     format]
+    ["." error (#+ Error)]]
+   [macro (#+ with-gensyms)
+    ["." code]
+    ["s" syntax (#+ Syntax syntax:)]]
+   [tool
+    [compiler
+     ["." host]]]]
+  ["." //
+   [//
+    ["." io]
+    [concurrency
+     ["." process]]]])
+
+(type: #export (Parser a)
+  {#.doc "A command-line interface parser."}
+  (//.Parser (List Text) a))
+
+(def: #export (run inputs parser)
+  (All [a] (-> (List Text) (Parser a) (Error a)))
+  (case (//.run inputs parser)
+    (#error.Success [remaining output])
+    (case remaining 
+      #.Nil
+      (#error.Success output)
+
+      _
+      (#error.Failure (format "Remaining CLI inputs: " (text.join-with " " remaining))))
+
+    (#error.Failure error)
+    (#error.Failure error)))
+
+(def: #export any
+  {#.doc "Just returns the next input without applying any logic."}
+  (Parser Text)
+  (function (_ inputs)
+    (case inputs
+      (#.Cons arg inputs')
+      (#error.Success [inputs' arg])
+      
+      _
+      (#error.Failure "Cannot parse empty arguments."))))
+
+(def: #export (parse parser)
+  {#.doc "Parses the next input with a parsing function."}
+  (All [a] (-> (-> Text (Error a)) (Parser a)))
+  (function (_ inputs)
+    (do error.monad
+      [[remaining raw] (any inputs)
+       output (parser raw)]
+      (wrap [remaining output]))))
+
+(def: #export (this reference)
+  {#.doc "Checks that a token is in the inputs."}
+  (-> Text (Parser Any))
+  (function (_ inputs)
+    (do error.monad
+      [[remaining raw] (any inputs)]
+      (if (text@= reference raw)
+        (wrap [remaining []])
+        (error.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] (-> (Parser a) (Parser a)))
+  (function (_ inputs)
+    (loop [immediate inputs]
+      (case (//.run immediate cli)
+        (#error.Success [remaining output])
+        (#error.Success [remaining output])
+
+        (#error.Failure error)
+        (case immediate
+          #.Nil
+          (#error.Failure error)
+          
+          (#.Cons to-omit immediate')
+          (do error.monad
+            [[remaining output] (recur immediate')]
+            (wrap [(#.Cons to-omit remaining)
+                   output])))))))
+
+(def: #export end
+  {#.doc "Ensures there are no more inputs."}
+  (Parser Any)
+  (function (_ inputs)
+    (case inputs
+      #.Nil (#error.Success [inputs []])
+      _     (#error.Failure (format "Unknown parameters: " (text.join-with " " inputs))))))
+
+(def: #export (named name value)
+  (All [a] (-> Text (Parser a) (Parser a)))
+  (|> value
+      (//.after (..this name))
+      ..somewhere))
+
+(def: #export (parameter [short long] value)
+  (All [a] (-> [Text Text] (Parser a) (Parser a)))
+  (|> value
+      (//.after (//.either (..this short) (..this long)))
+      ..somewhere))
+
+(type: Program-Args
+  (#Raw Text)
+  (#Parsed (List [Code Code])))
+
+(def: program-args^
+  (Syntax Program-Args)
+  (//.or s.local-identifier
+         (s.tuple (//.some (//.either (do //.monad
+                                        [name s.local-identifier]
+                                        (wrap [(code.identifier ["" name]) (` any)]))
+                                      (s.record (//.and s.any s.any)))))))
+
+(syntax: #export (program:
+                   {args program-args^}
+                   body)
+  {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)."
+              "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module."
+              (program: all-args
+                (do io.monad
+                  [foo init-program
+                   bar (do-something all-args)]
+                  (wrap [])))
+
+              (program: [name]
+                (io (log! (text@compose "Hello, " name))))
+
+              (program: [{config config^}]
+                (do io.monad
+                  [data (init-program config)]
+                  (do-something data))))}
+  (with-gensyms [g!program]
+    (case args
+      (#Raw args)
+      (wrap (list (` ("lux def program"
+                      (.function ((~ g!program) (~ (code.identifier ["" args])))
+                        ((~! do) (~! io.monad)
+                         []
+                         (~ body)))))))
+      
+      (#Parsed args)
+      (with-gensyms [g!args g!_ g!output g!message]
+        (wrap (list (` ("lux def program"
+                        (.function ((~ g!program) (~ g!args))
+                          (case ((: (~! (..Parser (io.IO .Any)))
+                                    ((~! do) (~! //.monad)
+                                     [(~+ (|> args
+                                              (list@map (function (_ [binding parser])
+                                                          (list binding parser)))
+                                              list@join))
+                                      (~ g!_) ..end]
+                                     ((~' wrap) ((~! do) (~! io.monad)
+                                                 [(~ g!output) (~ body)
+                                                  (~+ (`` (for {(~~ (static host.old))
+                                                                (list)}
+                                                               (list g!_
+                                                                     (` process.run!)))))]
+                                                 ((~' wrap) (~ g!output))))))
+                                 (~ g!args))
+                            (#error.Success [(~ g!_) (~ g!output)])
+                            (~ g!output)
+
+                            (#error.Failure (~ g!message))
+                            (.error! (~ g!message))
+                            ))))
+                    )))
+      )))
diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux
index 8df1cc839..4453d5d36 100644
--- a/stdlib/source/program/compositor/cli.lux
+++ b/stdlib/source/program/compositor/cli.lux
@@ -1,8 +1,8 @@
 (.module:
   [lux #*
    [control
-    ["p" parser]
-    ["." cli (#+ CLI)]]
+    ["p" parser
+     ["." cli (#+ Parser)]]]
    [world
     [file (#+ Path)]]]
   ## [///
@@ -21,7 +21,7 @@
 
 (template [<name> <long>]
   [(def: #export <name>
-     (CLI Text)
+     (Parser Text)
      (cli.named <long> cli.any))]
 
   [source "--source"]
@@ -30,14 +30,14 @@
   )
 
 (def: #export configuration
-  (CLI Configuration)
+  (Parser Configuration)
   ($_ p.and
       (p.some ..source)
       ..target
       ..module))
 
 (def: #export service
-  (CLI Service)
+  (Parser Service)
   ($_ p.or
       (p.after (cli.this "build") ..configuration)
       (p.after (cli.this "repl") ..configuration)))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index ab5d2e1d4..f62a071ae 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -12,9 +12,10 @@
       [monad (#+ do)]
       [predicate (#+ Predicate)]]
      [control
-      [cli (#+ program:)]
       ["." io (#+ io)]
-      ["." function]]
+      ["." function]
+      [parser
+       [cli (#+ program:)]]]
      [data
       ["." name]
       [number
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index bacb4cb24..61d69459f 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -2,7 +2,6 @@
   [lux #*
    ["_" test (#+ Test)]]
   ["." / #_
-   ["#." cli]
    ["#." continuation]
    ["#." exception]
    ["#." io]
@@ -20,7 +19,8 @@
     ["#." actor]
     ["#." stm]]
    ["#." parser #_
-    ["#/." text]]
+    ["#/." text]
+    ["#/." cli]]
    [security
     ["#." privacy]
     ["#." integrity]]
@@ -40,6 +40,7 @@
   Test
   ($_ _.and
       /parser/text.test
+      /parser/cli.test
       ))
 
 (def: security
@@ -52,7 +53,6 @@
 (def: #export test
   Test
   ($_ _.and
-      /cli.test
       /continuation.test
       /exception.test
       /io.test
diff --git a/stdlib/source/test/lux/control/cli.lux b/stdlib/source/test/lux/control/cli.lux
deleted file mode 100644
index ff7a3abb3..000000000
--- a/stdlib/source/test/lux/control/cli.lux
+++ /dev/null
@@ -1,75 +0,0 @@
-(.module:
-  [lux #*
-   data/text/format
-   ["M" abstract/monad (#+ Monad do)]
-   ["_" test (#+ Test)]
-   ["r" math/random]
-   [control
-    pipe
-    ["p" parser]]
-   [data
-    ["." error]
-    [number
-     ["." nat ("#;." decimal)]]
-    ["." text ("#;." equivalence)]
-    [collection
-     ["." list]]]]
-  {1
-   ["." /]})
-
-(def: #export test
-  Test
-  (<| (_.context (%name (name-of /.CLI)))
-      (do r.monad
-        [num-args (|> r.nat (:: @ map (n/% 10)))
-         #let [gen-arg (:: @ map nat;encode r.nat)]
-         yes gen-arg
-         #let [gen-ignore (r.filter (|>> (text;= yes) not)
-                                    (r.unicode 5))]
-         no gen-ignore
-         pre-ignore (r.list 5 gen-ignore)
-         post-ignore (r.list 5 gen-ignore)]
-        ($_ _.and
-            (_.test "Can read any argument."
-                    (|> (/.run (list yes) /.any)
-                        (case> (#error.Failure _)
-                               #0
-                               
-                               (#error.Success arg)
-                               (text;= arg yes))))
-            (_.test "Can test tokens."
-                    (and (|> (/.run (list yes) (/.this yes))
-                             (case> (#error.Failure _)
-                                    #0
-
-                                    (#error.Success _)
-                                    #1))
-                         (|> (/.run (list no) (/.this yes))
-                             (case> (#error.Failure _)
-                                    #1
-
-                                    (#error.Success _)
-                                    #0))))
-            (_.test "Can use custom token parsers."
-                    (|> (/.run (list yes) (/.parse nat;decode))
-                        (case> (#error.Failure _)
-                               #0
-                               
-                               (#error.Success parsed)
-                               (text;= (nat;encode parsed)
-                                       yes))))
-            (_.test "Can query if there are any more inputs."
-                    (and (|> (/.run (list) /.end)
-                             (case> (#error.Success []) #1 _ #0))
-                         (|> (/.run (list yes) (p.not /.end))
-                             (case> (#error.Success []) #0 _ #1))))
-            (_.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> (#error.Failure _)
-                               #0
-
-                               (#error.Success _)
-                               #1)))
-            ))))
diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux
new file mode 100644
index 000000000..a476c97c6
--- /dev/null
+++ b/stdlib/source/test/lux/control/parser/cli.lux
@@ -0,0 +1,77 @@
+(.module:
+  [lux #*
+   [data
+    text/format
+    ["." name]]
+   ["M" abstract/monad (#+ Monad do)]
+   ["_" test (#+ Test)]
+   ["r" math/random]
+   [control
+    pipe
+    ["p" parser]]
+   [data
+    ["." error]
+    [number
+     ["." nat ("#@." decimal)]]
+    ["." text ("#@." equivalence)]
+    [collection
+     ["." list]]]]
+  {1
+   ["." /]})
+
+(def: #export test
+  Test
+  (<| (_.context (name.module (name-of /._)))
+      (do r.monad
+        [num-args (|> r.nat (:: @ map (n/% 10)))
+         #let [gen-arg (:: @ map nat@encode r.nat)]
+         yes gen-arg
+         #let [gen-ignore (r.filter (|>> (text@= yes) not)
+                                    (r.unicode 5))]
+         no gen-ignore
+         pre-ignore (r.list 5 gen-ignore)
+         post-ignore (r.list 5 gen-ignore)]
+        ($_ _.and
+            (_.test "Can read any argument."
+                    (|> (/.run (list yes) /.any)
+                        (case> (#error.Failure _)
+                               #0
+                               
+                               (#error.Success arg)
+                               (text@= arg yes))))
+            (_.test "Can test tokens."
+                    (and (|> (/.run (list yes) (/.this yes))
+                             (case> (#error.Failure _)
+                                    #0
+
+                                    (#error.Success _)
+                                    #1))
+                         (|> (/.run (list no) (/.this yes))
+                             (case> (#error.Failure _)
+                                    #1
+
+                                    (#error.Success _)
+                                    #0))))
+            (_.test "Can use custom token parsers."
+                    (|> (/.run (list yes) (/.parse nat@decode))
+                        (case> (#error.Failure _)
+                               #0
+                               
+                               (#error.Success parsed)
+                               (text@= (nat@encode parsed)
+                                       yes))))
+            (_.test "Can query if there are any more inputs."
+                    (and (|> (/.run (list) /.end)
+                             (case> (#error.Success []) #1 _ #0))
+                         (|> (/.run (list yes) (p.not /.end))
+                             (case> (#error.Success []) #0 _ #1))))
+            (_.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> (#error.Failure _)
+                               #0
+
+                               (#error.Success _)
+                               #1)))
+            ))))
-- 
cgit v1.2.3