aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2017-10-17 00:18:39 -0400
committerEduardo Julian2017-10-17 00:18:39 -0400
commit98bfe062d911163a063f7139a840410964f12878 (patch)
tree72e01cf099855bea06d4c40a78b47c1ec4afc842 /stdlib/source
parent7127550a3a8bc07f34a9a7f9404b5eea6a3b11cd (diff)
- Simplified CLI.
- Added way to parse CLI argument anywhere within the inputs.
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/cli.lux86
1 files changed, 40 insertions, 46 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>
[]