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 [ ] [(def: #export - (CLI Text) + (Parser Text) (cli.named 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