aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/cli.lux23
-rw-r--r--stdlib/test/test/lux/cli.lux166
-rw-r--r--stdlib/test/tests.lux4
3 files changed, 103 insertions, 90 deletions
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index d9039df13..459d6926f 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -71,24 +71,23 @@
(#;Right [inputs' arg])
_
- (#;Left "Can't extract from empty arguments."))))
+ (#;Left "Can't parse empty arguments."))))
-(def: #export (parse parser option)
+(def: #export (parse parser)
{#;doc "Parses the next input with a parsing function."}
- (All [a] (-> (-> Text (Error a)) (CLI Text) (CLI a)))
+ (All [a] (-> (-> Text (Error a)) (CLI a)))
(lambda [inputs]
- (case (option inputs)
- (#;Right [inputs' input])
- (case (parser input)
+ (case inputs
+ (#;Cons arg inputs')
+ (case (parser arg)
(#;Right value)
(#;Right [inputs' value])
(#;Left parser-error)
(#;Left parser-error))
-
- (#;Left option-error)
- (#;Left option-error)
- )))
+
+ _
+ (#;Left "Can't parse empty arguments."))))
(def: #export (option names)
{#;doc "Checks that a given option (with multiple possible names) has a value."}
@@ -126,8 +125,8 @@
#;Nil (#;Right [inputs []])
_ (#;Left (Text/append "Unknown parameters: " (text;join-with " " inputs))))))
-(def: #export (assert test message)
- (-> Bool Text (CLI Unit))
+(def: #export (assert message test)
+ (-> Text Bool (CLI Unit))
(lambda [inputs]
(if test
(#;Right [inputs []])
diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux
index c95ec9e9c..20a3cb5b6 100644
--- a/stdlib/test/test/lux/cli.lux
+++ b/stdlib/test/test/lux/cli.lux
@@ -1,84 +1,98 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
(;module:
- [lux #- not]
+ lux
(lux (codata [io])
(control monad)
(data text/format
+ [text "Text/" Eq<Text>]
[number]
[product]
- [sum])
+ [sum]
+ (struct [list]))
(codata function)
- [cli #- run])
- [lux/test #- assert])
+ ["&" cli]
+ (math ["R" random])
+ pipe)
+ lux/test)
+
+(test: "CLI"
+ [num-args (:: @ map (%+ +10) R;nat)
+ #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 _)
+ (=+ +0 num-args)
+
+ (#;Right arg)
+ (and (not (=+ +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 (=+ +0 num-args))
+ (Text/= arg (default (undefined)
+ (list;head args))))
+
+ (#;Right #;None)
+ (=+ +0 num-args)
+
+ _
+ false)))
+
+ (assert "Can read multiple arguments."
+ (and (|> (&;run (&;some &;any) args)
+ (case> (#;Left _)
+ false
+
+ (#;Right args')
+ (=+ num-args (list;size args'))))
+ (|> (&;run (&;many &;any) args)
+ (case> (#;Left _)
+ (=+ +0 num-args)
+
+ (#;Right args')
+ (=+ num-args (list;size args'))))))
+
+ (assert "Can use custom token parsers."
+ (|> (&;run (&;parse Nat/decode) args)
+ (case> (#;Left _)
+ (=+ +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 _)
+ (=+ +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))))
-(test: "lux/cli exports"
- (test-all (match (#;Right "foo")
- (cli;run any (list "foo" "bar" "baz")))
- (match (#;Left _)
- (cli;run any (list)))
- (match (#;Right 123)
- (cli;run (parse (:: number;Codec<Text,Int> decode) any) (list "123")))
- (match (#;Left _)
- (cli;run (option (list "-p" "--port")) (list)))
- (match (#;Left _)
- (cli;run (option (list "-p" "--port")) (list "yolo")))
- (match (#;Right "123")
- (cli;run (option (list "-p" "--port")) (list "-p" "123")))
- (match (#;Right "123")
- (cli;run (option (list "-p" "--port")) (list "--port" "123")))
- (match (#;Right false)
- (cli;run (flag (list "-h" "--help")) (list)))
- (match (#;Right false)
- (cli;run (flag (list "-h" "--help")) (list "yolo")))
- (match (#;Right true)
- (cli;run (flag (list "-h" "--help")) (list "-h")))
- (match (#;Right true)
- (cli;run (flag (list "-h" "--help")) (list "--help")))
- (match (#;Right [])
- (cli;run end (list)))
- (match (#;Left _)
- (cli;run end (list "yolo")))
- (match (#;Left "YOLO")
- (cli;run (assert false "YOLO") (list "yolo")))
- (match (#;Right [])
- (cli;run (assert true "YOLO") (list "yolo")))
- (match (#;Right #;None)
- (cli;run (opt any) (list)))
- (match (#;Right (#;Some "yolo"))
- (cli;run (opt any) (list "yolo")))
- (match (#;Right ["foo" "bar"])
- (cli;run (seq any any) (list "foo" "bar" "baz")))
- (match (#;Right ["foo" "bar"])
- (cli;run (seq any any) (list "foo" "bar")))
- (match (#;Left _)
- (cli;run (seq any any) (list "foo")))
- ## (match (#;Right (#;Left 123))
- ## (cli;run (alt (parse (:: number;Codec<Text,Int> decode) any)
- ## any)
- ## (list "123" "foo")))
- ## (match (#;Right (#;Right "foo"))
- ## (cli;run (alt (parse (:: number;Codec<Text,Int> decode) any)
- ## any)
- ## (list "foo")))
- (match (#;Left _)
- (cli;run (alt (parse (:: number;Codec<Text,Int> decode) any)
- (parse (:: number;Codec<Text,Real> decode) any))
- (list "foo")))
- (match (#;Left _)
- (cli;run (not (parse (:: number;Codec<Text,Int> decode) any))
- (list "123")))
- (match (#;Right [])
- (cli;run (not (parse (:: number;Codec<Text,Int> decode) any))
- (list "yolo")))
- (match (^ (#;Right (list "foo" "bar" "baz")))
- (cli;run (some any) (list "foo" "bar" "baz")))
- (match (^ (#;Right (list)))
- (cli;run (some any) (list)))
- (match (^ (#;Right (list "foo" "bar" "baz")))
- (cli;run (many any) (list "foo" "bar" "baz")))
- (match (#;Left _)
- (cli;run (many any) (list)))
- (match (#;Right "yolo")
- (cli;run (either (parse sum;right any)
- any)
- (list "yolo")))
- ))
+ (assert "Can query if there are any more inputs."
+ (and (|> (&;run &;end args)
+ (case> (#;Right []) (=+ +0 num-args) _ false))
+ (|> (&;run (&;not &;end) args)
+ (case> (#;Right []) (not (=+ +0 num-args)) _ false))))
+ ))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 94148e1d7..5314c2923 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -11,7 +11,8 @@
[cli #+ program:]
[test])
(test lux
- (lux (data [bit]
+ (lux ["_;" cli]
+ (data [bit]
[bool]
[char]
[error]
@@ -50,7 +51,6 @@
## [actor]
## )
## [host]
- ## ["_;" cli]
## [math]
## [pipe]
## [lexer]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 14:11:02 +0000