From 55e411f34d81d8deb0b7d0e25c987dbe16035354 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 2 Dec 2016 09:59:01 -0400 Subject: - Updated lux/cli tests. --- stdlib/source/lux/cli.lux | 23 +++--- stdlib/test/test/lux/cli.lux | 166 +++++++++++++++++++++++-------------------- stdlib/test/tests.lux | 4 +- 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] [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 + 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 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 decode) any) - ## any) - ## (list "123" "foo"))) - ## (match (#;Right (#;Right "foo")) - ## (cli;run (alt (parse (:: number;Codec decode) any) - ## any) - ## (list "foo"))) - (match (#;Left _) - (cli;run (alt (parse (:: number;Codec decode) any) - (parse (:: number;Codec decode) any)) - (list "foo"))) - (match (#;Left _) - (cli;run (not (parse (:: number;Codec decode) any)) - (list "123"))) - (match (#;Right []) - (cli;run (not (parse (:: number;Codec 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] -- cgit v1.2.3