diff options
| author | Eduardo Julian | 2016-12-01 15:12:42 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2016-12-01 15:12:42 -0400 |
| commit | a699799f30d438711ae80a0fa6388de6ada2432c (patch) | |
| tree | f50f15db45c5926101460f7aee59d1e16d46fd6a | |
| parent | 7f66c54f4c9753b94dbf46ec50b8b16549daf324 (diff) | |
- Simplified the Test type.
- Added Test combinators.
- Removed unnecessary testing macros (testing only needs assertions).
Diffstat (limited to '')
22 files changed, 960 insertions, 953 deletions
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index eba8034f9..e7a527dea 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -11,7 +11,7 @@ (control functor applicative monad) - (concurrency [promise #* "Promise/" Monad<Promise>]) + (concurrency [promise #+ Promise Monad<Promise>]) (data (struct [list "List/" Monad<List>]) [product] [text] @@ -31,68 +31,25 @@ (System.exit 0)) ## [Types] -(type: #export (Test a) - (Promise (Error a))) - -## [Structs] -(struct: #export _ (Functor Test) - (def: (map f fa) - (Promise/map (Error/map f) fa))) - -(struct: #export _ (Applicative Test) - (def: functor Functor<Test>) - - (def: (wrap a) - (Promise/wrap (#;Right a))) - - (def: (apply ff fa) - (do Monad<Promise> - [f' ff - a' fa] - (case [f' a'] - [(#;Right f) (#;Right a)] - (wrap (#;Right (f a))) - - (^or [(#;Left msg) _] [_ (#;Left msg)]) - (wrap (#;Left msg)))) - )) - -(struct: #export _ (Monad Test) - (def: applicative Applicative<Test>) - - (def: (join mma) - (Promise/join (Promise/map (lambda [mma'] - (case mma' - (#;Left msg) - (Promise/wrap (#;Left msg)) - - (#;Right ma) - ma)) - mma))) - ) +(type: #export Test + (Promise (Error Unit))) ## [Values] (def: #export (fail message) - (All [a] (-> Text (Test a))) + (All [a] (-> Text Test)) (:: Monad<Promise> wrap (#;Left message))) (def: #export (assert message test) - (-> Text Bool (Test Unit)) + (-> Text Bool Test) (if test - (:: Monad<Test> wrap []) + (:: Monad<Promise> wrap (#;Right [])) (fail message))) -(def: #export (from-promise promise) - (All [a] (-> (Promise a) (Test a))) - (do Monad<Promise> - [output promise] - (wrap (#;Right output)))) - (def: #hidden (run' tests) - (-> (List [Text (IO (Test Unit)) Text]) (Promise Unit)) + (-> (List [Text (IO Test) Text]) (Promise Unit)) (do Monad<Promise> [printings (mapM @ - (: (-> [Text (IO (Test Unit)) Text] (Promise Unit)) + (: (-> [Text (IO Test) Text] (Promise Unit)) (lambda [[module test description]] (do @ [#let [pre (io;run (System.currentTimeMillis []))] @@ -113,27 +70,26 @@ (type: #export Seed Nat) -(def: #export (try seed random-test) - (-> Seed (R;Random (Test Unit)) (Test Seed)) +(def: (try seed random-test) + (-> Seed (R;Random Test) (Promise (Error Seed))) (let [[prng [new-seed test]] (R;run (R;pcg-32 [pcg-32-magic-inc seed]) (do R;Monad<Random> [test random-test next-seed R;nat] (wrap [next-seed test])))] - (do Monad<Test> - [_ test] - (wrap new-seed)))) + (do Monad<Promise> + [result test] + (case result + (#;Left error) + (wrap (#;Left error)) + + (#;Right _) + (wrap (#;Right new-seed)))))) (def: (repeat' seed times random-test) - (-> Seed Nat (R;Random (Test Unit)) (Test Seed)) - (case times - +0 + (-> Seed Nat (R;Random Test) Test) + (if (=+ +0 times) (fail "Can't try a test 0 times.") - - +1 - (try seed random-test) - - _ (do Monad<Promise> [output (try seed random-test)] (case output @@ -141,15 +97,16 @@ (fail (format "Test failed with this seed: " (%n seed) "\n" error)) (#;Right seed') - (repeat' seed' (dec+ times) random-test))))) + (if (=+ +1 times) + (wrap (#;Right [])) + (repeat' seed' (dec+ times) random-test)) + )))) (def: #export (repeat times random-test) - (-> Nat (R;Random (Test Unit)) (Test Unit)) - (do Monad<Test> - [_ (repeat' (int-to-nat (io;run (System.currentTimeMillis []))) - times - random-test)] - (wrap []))) + (-> Nat (R;Random Test) Test) + (repeat' (int-to-nat (io;run (System.currentTimeMillis []))) + times + random-test)) ## [Syntax] (type: Property-Test @@ -214,7 +171,7 @@ (with-gensyms [g!test] (wrap (list (` (def: #export (~ g!test) {#;;test (#;TextM (~ description))} - (IO (Test Unit)) + (IO Test) (io (~ body))))))))) (def: (exported-tests module-name) @@ -232,57 +189,6 @@ (list;filter product;left) (List/map product;right))))) -(syntax: #export (match pattern expression) - {#;doc (doc "Runs an expression and pattern-matches against it using the given pattern." - "If the pattern-matching succeeds, the test succeeds." - (match 15 (|> 5 - (?> [even?] [(* 2)] - [odd?] [(* 3)]))))} - (with-gensyms [g!_] - (wrap (list (` (: (Test Unit) - (case (~ expression) - (~ pattern) - (~' (:: Monad<Test> wrap [])) - - (~ g!_) - (fail (~ (ast;text (format "Pattern was not matched: " (ast;ast-to-text pattern) - "\n\n" "From expression: " (ast;ast-to-text expression)))))))))))) - -(def: #hidden (should-pass' veredict expr-repr) - (All [a] (-> (Error a) Text (Test a))) - (case veredict - (#;Left message) (fail (format "'" message "' @ " expr-repr)) - (#;Right value) (:: Monad<Test> wrap value))) - -(def: #hidden (should-fail' veredict expr-repr) - (All [a] (-> (Error a) Text (Test Unit))) - (case veredict - (#;Left message) (:: Monad<Test> wrap []) - (#;Right value) (fail (format "Should have failed: " expr-repr)))) - -(do-template [<macro-name> <func-name> <doc>] - [(syntax: #export (<macro-name> expr) - {#;doc <doc>} - (wrap (list (` (<func-name> (~ expr) (~ (ast;text (ast;ast-to-text expr))))))))] - - [should-pass should-pass' "Verifies that a (Error a) computation succeeds/passes."] - [should-fail should-fail' "Verifies that a (Error a) computation fails."] - ) - -(syntax: #export (match+ pattern source) - {#;doc (doc "Same as \"match\", but the expression/source is expected to be of type (Test a)." - "That is, it's asynchronous and it may fail." - "If, however, it succeeds, it's value will be pattern-matched against." - (match+ 5 (commit (do Monad<STM> - [_ (write 5 _var) - value (read _var)] - (wrap (#;Right value))))))} - (with-gensyms [g!temp] - (wrap (list (` (: (Test Unit) - (do Monad<Test> - [(~ g!temp) (~ source)] - (match (~ pattern) (~ g!temp))))))))) - (syntax: #export (run) {#;doc (doc "Runs all the tests defined on the current module, and in all imported modules." (run))} @@ -295,7 +201,7 @@ #let [tests+ (List/map (lambda [[module-name test desc]] (` [(~ (ast;text module-name)) (~ (ast;symbol [module-name test])) (~ (ast;text desc))])) tests) - groups (list;split-all (|> (list;size tests+) (/+ concurrency-level) (++ +1) (min+ +16)) + groups (list;split-all (|> (list;size tests+) (/+ promise;concurrency-level) (++ +1) (min+ +16)) tests+)]] (wrap (list (` (: (IO Unit) (io (exec (do Monad<Promise> @@ -303,28 +209,30 @@ (list g!_ (` (run' (list (~@ group)))))) groups)))] (exec (log! "Test-suite finished!") - (future exit))) + (promise;future exit))) []))))))))) -(syntax: #export (all {tests (s;some s;any)}) - {#;doc (doc "Given a sequence of tests, runs them all sequentially, and succeeds if the all succeed." - (test: "lux/pipe exports" - (all (match 1 (|> 20 - (* 3) - (+ 4) - (_> 0 inc))) - (match 10 (|> 5 - (@> (+ @ @)))) - (match 15 (|> 5 - (?> [even?] [(* 2)] - [odd?] [(* 3)] - [(_> -1)]))) - )))} - (with-gensyms [g!_] - (let [pairs (|> tests - (List/map (: (-> AST (List AST)) (lambda [test] (list g!_ test)))) - List/join)] - (wrap (list (` (: (Test Unit) - (do Monad<Test> - [(~@ pairs)] - ((~' wrap) []))))))))) +(def: #export (seq left right) + (-> Test Test Test) + (do Monad<Promise> + [=left left + =right right] + (case [=left =right] + (^or [(#;Left error) _] + [_ (#;Left error)]) + (wrap (#;Left error)) + + _ + (wrap (#;Right []))))) + +(def: #export (alt left right) + (-> Test Test Test) + (do Monad<Promise> + [=left left + =right right] + (case =left + (#;Right _) + (wrap =left) + + _ + (wrap =right)))) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 947ec5b6f..f507e1e9a 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -14,15 +14,18 @@ [compiler] (macro ["s" syntax #+ syntax:]))) -(test: "Every value is identical to itself, and the 'id' function doesn't change values in any way." - [value R;int] - (assert "" (and (== value value) - (== value (id value))))) - -(test: "Values created separately can't be identical." - [x R;int - y R;int] - (match false (== x y))) +(test: "Value identity." + [size (|> R;nat (:: @ map (|>. (%+ +100) (max+ +10)))) + x (R;text size) + y (R;text size)] + ($_ seq + (assert "Every value is identical to itself, and the 'id' function doesn't change values in any way." + (and (== x x) + (== x (id x)))) + + (assert "Values created separately can't be identical." + (not (== x y))) + )) (do-template [category rand-gen inc dec even? odd? = < >] [(test: (format "[" category "] " "Moving up-down or down-up should result in same value.") @@ -137,28 +140,34 @@ ) (test: "Simple macros and constructs" - (all (match ["lux" "yolo"] (ident-for ;yolo)) - (match ["test/lux" "yolo"] (ident-for ;;yolo)) - (match ["" "yolo"] (ident-for yolo)) - (match ["lux/test" "yolo"] (ident-for lux/test;yolo)) - (match ["lux" "yolo"] (ident-for #;yolo)) - (match ["test/lux" "yolo"] (ident-for #;;yolo)) - (match ["" "yolo"] (ident-for #yolo)) - (match ["lux/test" "yolo"] (ident-for #lux/test;yolo)) - - (match 1000 (loop [counter 0 - value 1] - (if (< 3 counter) - (recur (inc counter) (* 10 value)) - value))) - - (match (^ (list 1 2 3)) - (list 1 2 3)) - (match (^ (list 1 2 3 4 5 6)) - (list& 1 2 3 (list 4 5 6))) - - (match "yolo" (default "yolo" - #;None)) - (match "lol" (default "yolo" - (#;Some "lol"))) - )) + ($_ seq + (assert "Can write easy loops for iterative programming." + (= 1000 + (loop [counter 0 + value 1] + (if (< 3 counter) + (recur (inc counter) (* 10 value)) + value)))) + + (assert "Can create lists easily through macros." + (and (case (list 1 2 3) + (#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) + true + + _ + false) + + (case (list& 1 2 3 (list 4 5 6)) + (#;Cons 1 (#;Cons 2 (#;Cons 3 (#;Cons 4 (#;Cons 5 (#;Cons 6 #;Nil)))))) + true + + _ + false))) + + (assert "Can have defaults for Maybe values." + (and (== "yolo" (default "yolo" + #;None)) + + (== "lol" (default "yolo" + (#;Some "lol"))))) + )) diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux index e20027818..a6d897519 100644 --- a/stdlib/test/test/lux/data/bit.lux +++ b/stdlib/test/test/lux/data/bit.lux @@ -17,49 +17,50 @@ (test: "Bitwise operations." [pattern R;nat idx (:: @ map (%+ width) R;nat)] - (all (assert "" (and (<+ (&;count (&;set idx pattern)) + ($_ seq + (assert "" (and (<+ (&;count (&;set idx pattern)) + (&;count (&;clear idx pattern))) + (<=+ (&;count pattern) (&;count (&;clear idx pattern))) - (<=+ (&;count pattern) - (&;count (&;clear idx pattern))) - (>=+ (&;count pattern) - (&;count (&;set idx pattern))) + (>=+ (&;count pattern) + (&;count (&;set idx pattern))) - (or (and (&;set? idx pattern) - (not (&;set? idx (&;clear idx pattern)))) - (and (not (&;set? idx pattern)) - (&;set? idx (&;set idx pattern)))) + (or (and (&;set? idx pattern) + (not (&;set? idx (&;clear idx pattern)))) + (and (not (&;set? idx pattern)) + (&;set? idx (&;set idx pattern)))) - (or (and (&;set? idx pattern) - (not (&;set? idx (&;flip idx pattern)))) - (and (not (&;set? idx pattern)) - (&;set? idx (&;flip idx pattern)))) - - (=+ width - (++ (&;count pattern) - (&;count (&;~ pattern)))) + (or (and (&;set? idx pattern) + (not (&;set? idx (&;flip idx pattern)))) + (and (not (&;set? idx pattern)) + (&;set? idx (&;flip idx pattern)))) + + (=+ width + (++ (&;count pattern) + (&;count (&;~ pattern)))) - (=+ +0 - (&;& pattern - (&;~ pattern))) - (=+ (&;~ +0) - (&;| pattern - (&;~ pattern))) - (=+ (&;~ +0) - (&;^ pattern - (&;~ pattern))) - (=+ +0 - (&;^ pattern - pattern)) + (=+ +0 + (&;& pattern + (&;~ pattern))) + (=+ (&;~ +0) + (&;| pattern + (&;~ pattern))) + (=+ (&;~ +0) + (&;^ pattern + (&;~ pattern))) + (=+ +0 + (&;^ pattern + pattern)) - (|> pattern (&;rotate-left idx) (&;rotate-right idx) (=+ pattern)) - (|> pattern (&;rotate-right idx) (&;rotate-left idx) (=+ pattern)) - (|> pattern (&;rotate-left idx) (&;rotate-left (-+ idx width)) (=+ pattern)) - (|> pattern (&;rotate-right idx) (&;rotate-right (-+ idx width)) (=+ pattern)) - )) - - (assert "Shift right respect the sign of ints." - (let [value (nat-to-int pattern)] - (if (< 0 value) - (< 0 (&;>> idx value)) - (>= 0 (&;>> idx value))))) - )) + (|> pattern (&;rotate-left idx) (&;rotate-right idx) (=+ pattern)) + (|> pattern (&;rotate-right idx) (&;rotate-left idx) (=+ pattern)) + (|> pattern (&;rotate-left idx) (&;rotate-left (-+ idx width)) (=+ pattern)) + (|> pattern (&;rotate-right idx) (&;rotate-right (-+ idx width)) (=+ pattern)) + )) + + (assert "Shift right respect the sign of ints." + (let [value (nat-to-int pattern)] + (if (< 0 value) + (< 0 (&;>> idx value)) + (>= 0 (&;>> idx value))))) + )) diff --git a/stdlib/test/test/lux/data/char.lux b/stdlib/test/test/lux/data/char.lux index ab2e84d59..025dd4b32 100644 --- a/stdlib/test/test/lux/data/char.lux +++ b/stdlib/test/test/lux/data/char.lux @@ -38,10 +38,11 @@ ))) (test: "Special cases" - (all (assert "" (space? #" ")) - (assert "" (space? #"\n")) - (assert "" (space? #"\t")) - (assert "" (space? #"\r")) - (assert "" (space? #"\f")) - (assert "" (not (space? #"a"))) - )) + ($_ seq + (assert "" (space? #" ")) + (assert "" (space? #"\n")) + (assert "" (space? #"\t")) + (assert "" (space? #"\r")) + (assert "" (space? #"\f")) + (assert "" (not (space? #"a"))) + )) diff --git a/stdlib/test/test/lux/data/error.lux b/stdlib/test/test/lux/data/error.lux index a1d2cb6ff..cc92a1276 100644 --- a/stdlib/test/test/lux/data/error.lux +++ b/stdlib/test/test/lux/data/error.lux @@ -7,36 +7,43 @@ lux (lux (codata [io]) (control monad) - (data error)) + (data ["&" error]) + pipe) lux/test) -(test: "lux/data/error exports" - (all (match (#;Right 11) - (:: Functor<Error> map inc (: (Error Int) - (#;Right 10)))) - (match (#;Left "YOLO") - (:: Functor<Error> map inc (: (Error Int) - (#;Left "YOLO")))) - - (match (#;Right 20) - (:: Applicative<Error> wrap 20)) - (match (#;Right 11) - (let [(^open) Applicative<Error>] - (apply (wrap inc) (wrap 10)))) - (match (#;Left "YOLO") - (let [(^open) Applicative<Error>] - (apply (wrap inc) (#;Left "YOLO")))) - - (match (#;Right 30) - (do Monad<Error> - [f (wrap +) - a (wrap 10) - b (wrap 20)] - (wrap (f a b)))) - (match (#;Left "YOLO") - (do Monad<Error> - [f (wrap +) - a (#;Left "YOLO") - b (wrap 20)] - (wrap (f a b)))) - )) +(test: "Errors" + (let [(^open "&/") &;Monad<Error>] + ($_ seq + (assert "Functor correctly handles both cases." + (and (|> (: (&;Error Int) (#;Right 10)) + (&/map inc) + (case> (#;Right 11) true _ false)) + + (|> (: (&;Error Int) (#;Left "YOLO")) + (&/map inc) + (case> (#;Left "YOLO") true _ false)) + )) + + (assert "Applicative correctly handles both cases." + (and (|> (&/wrap 20) + (case> (#;Right 20) true _ false)) + (|> (&/apply (&/wrap inc) (&/wrap 10)) + (case> (#;Right 11) true _ false)) + (|> (&/apply (&/wrap inc) (#;Left "YOLO")) + (case> (#;Left "YOLO") true _ false)))) + + (assert "Monad correctly handles both cases." + (and (|> (do &;Monad<Error> + [f (wrap +) + a (wrap 10) + b (wrap 20)] + (wrap (f a b))) + (case> (#;Right 30) true _ false)) + (|> (do &;Monad<Error> + [f (wrap +) + a (#;Left "YOLO") + b (wrap 20)] + (wrap (f a b))) + (case> (#;Left "YOLO") true _ false)) + )) + ))) diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux index 8cb85175f..53ce4968e 100644 --- a/stdlib/test/test/lux/data/ident.lux +++ b/stdlib/test/test/lux/data/ident.lux @@ -28,26 +28,42 @@ #let [ident2 [module2 name2]] #let [(^open "&/") &;Eq<Ident> (^open "&/") &;Codec<Text,Ident>]] - (all (assert "Can get the module & name parts of an ident." - (and (== module1 (&;module ident1)) - (== name1 (&;name ident1)))) + ($_ seq + (assert "Can get the module & name parts of an ident." + (and (== module1 (&;module ident1)) + (== name1 (&;name ident1)))) - (assert "Can compare idents for equality." - (and (&/= ident1 ident1) - (if (&/= ident1 ident2) - (and (Text/= module1 module2) - (Text/= name1 name2)) - (or (not (Text/= module1 module2)) - (not (Text/= name1 name2)))))) + (assert "Can compare idents for equality." + (and (&/= ident1 ident1) + (if (&/= ident1 ident2) + (and (Text/= module1 module2) + (Text/= name1 name2)) + (or (not (Text/= module1 module2)) + (not (Text/= name1 name2)))))) - (assert "Can encode idents as text." - (|> ident1 - &/encode &/decode - (case> (#;Right dec-ident) (&/= ident1 dec-ident) - _ false))) + (assert "Can encode idents as text." + (|> ident1 + &/encode &/decode + (case> (#;Right dec-ident) (&/= ident1 dec-ident) + _ false))) - (assert "Encoding an ident without a module component results in text equal to the name of the ident." - (if (text;empty? module1) - (Text/= name1 (&/encode ident1)) - true)) - )) + (assert "Encoding an ident without a module component results in text equal to the name of the ident." + (if (text;empty? module1) + (Text/= name1 (&/encode ident1)) + true)) + )) + +(test: "Ident-related macros." + (let [(^open "&/") &;Eq<Ident>] + ($_ seq + (assert "Can obtain Ident from symbol." + (and (&/= ["lux" "yolo"] (ident-for ;yolo)) + (&/= ["test/lux" "yolo"] (ident-for ;;yolo)) + (&/= ["" "yolo"] (ident-for yolo)) + (&/= ["lux/test" "yolo"] (ident-for lux/test;yolo)))) + + (assert "Can obtain Ident from tag." + (and (&/= ["lux" "yolo"] (ident-for #;yolo)) + (&/= ["test/lux" "yolo"] (ident-for #;;yolo)) + (&/= ["" "yolo"] (ident-for #yolo)) + (&/= ["lux/test" "yolo"] (ident-for #lux/test;yolo))))))) diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux index f492a801e..4f8c26cb1 100644 --- a/stdlib/test/test/lux/data/identity.lux +++ b/stdlib/test/test/lux/data/identity.lux @@ -8,29 +8,33 @@ (lux (codata [io]) (control monad comonad) - (data identity - [text "Text/" Monoid<Text>])) + (data ["&" identity] + [text "Text/" Monoid<Text> Eq<Text>])) lux/test) -(test: "lux/data/identity exports" - (all (match "yololol" (:: Functor<Identity> map (Text/append "yolo") "lol")) - - (match "yolo" (:: Applicative<Identity> wrap "yolo")) - (match "yololol" (let [(^open) Applicative<Identity>] - (apply (wrap (Text/append "yolo")) (wrap "lol")))) - - (match "yololol" - (do Monad<Identity> - [f (wrap Text/append) - a (wrap "yolo") - b (wrap "lol")] - (wrap (f a b)))) - - (match "yololol" (:: CoMonad<Identity> unwrap "yololol")) - (match "yololol" - (be CoMonad<Identity> - [f Text/append - a "yolo" - b "lol"] - (f a b))) - )) +(test: "Identity" + (let [(^open "&/") &;Monad<Identity> + (^open "&/") &;CoMonad<Identity>] + ($_ seq + (assert "Functor does not affect values." + (Text/= "yololol" (&/map (Text/append "yolo") "lol"))) + + (assert "Applicative does not affect values." + (and (Text/= "yolo" (&/wrap "yolo")) + (Text/= "yololol" (&/apply (&/wrap (Text/append "yolo")) (&/wrap "lol"))))) + + (assert "Monad does not affect values." + (Text/= "yololol" (do &;Monad<Identity> + [f (wrap Text/append) + a (wrap "yolo") + b (wrap "lol")] + (wrap (f a b))))) + + (assert "CoMonad does not affect values." + (and (Text/= "yololol" (&/unwrap "yololol")) + (Text/= "yololol" (be &;CoMonad<Identity> + [f Text/append + a "yolo" + b "lol"] + (f a b))))) + ))) diff --git a/stdlib/test/test/lux/data/log.lux b/stdlib/test/test/lux/data/log.lux index c052a29da..3a02638c7 100644 --- a/stdlib/test/test/lux/data/log.lux +++ b/stdlib/test/test/lux/data/log.lux @@ -7,26 +7,30 @@ lux (lux (codata [io]) (control monad) - (data log - [text "Text/" Monoid<Text>] - [number]) + (data ["&" log] + [text "Text/" Monoid<Text> Eq<Text>] + [number] + [product]) (codata function)) lux/test) -(test: "lux/data/log exports" - (all (match ["" 11] - (:: Functor<Log> map inc ["" 10])) - (match ["" 20] - (:: (Applicative<Log> text;Monoid<Text>) wrap 20)) - (match ["" 30] - (let [(^open) (Applicative<Log> text;Monoid<Text>)] - (apply (wrap (+ 10)) (wrap 20)))) - (match ["" 30] - (do (Monad<Log> text;Monoid<Text>) - [f (wrap +) - a (wrap 10) - b (wrap 20)] - (wrap (f a b)))) - (match ["YOLO" []] - (log "YOLO")) - )) +(test: "Logs" + (let [(^open "&/") (&;Monad<Log> text;Monoid<Text>)] + ($_ seq + (assert "Functor respects Log." + (= 11 (product;right (&/map inc ["" 10])))) + + (assert "Applicative respects Log." + (and (= 20 (product;right (&/wrap 20))) + (= 30 (product;right (&/apply (&/wrap (+ 10)) (&/wrap 20)))))) + + (assert "Monad respects Log." + (= 30 (product;right (do (&;Monad<Log> text;Monoid<Text>) + [f (wrap +) + a (wrap 10) + b (wrap 20)] + (wrap (f a b)))))) + + (assert "Can log any value." + (Text/= "YOLO" (product;left (&;log "YOLO")))) + ))) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux index bd44593d7..d5f20c489 100644 --- a/stdlib/test/test/lux/data/maybe.lux +++ b/stdlib/test/test/lux/data/maybe.lux @@ -7,43 +7,44 @@ lux (lux (codata [io]) (control monad) - (data maybe + (data ["&" maybe] [text "Text/" Monoid<Text>] - [number])) + [number]) + pipe) lux/test) -(test: "lux/data/maybe exports" - (all (match #;None (:: Monoid<Maybe> unit)) - (match (#;Some "yolo") (:: Monoid<Maybe> append (#;Some "yolo") (#;Some "lol"))) - (match (#;Some "yolo") (:: Monoid<Maybe> append (#;Some "yolo") #;None)) - (match (#;Some "lol") (:: Monoid<Maybe> append #;None (#;Some "lol"))) - (match #;None (: (Maybe Text) (:: Monoid<Maybe> append #;None #;None))) - - (match #;None (:: Functor<Maybe> map (Text/append "yolo") #;None)) - (match (#;Some "yololol") (:: Functor<Maybe> map (Text/append "yolo") (#;Some "lol"))) - - (match (#;Some "yolo") (:: Applicative<Maybe> wrap "yolo")) - (match (#;Some "yololol") - (let [(^open) Applicative<Maybe>] - (apply (wrap (Text/append "yolo")) (wrap "lol")))) - - (match (#;Some "yololol") - (do Monad<Maybe> - [f (wrap Text/append) - a (wrap "yolo") - b (wrap "lol")] - (wrap (f a b)))) +(test: "Maybe" + (let [(^open "&/") &;Monoid<Maybe> + (^open "&/") &;Monad<Maybe> + (^open "Maybe/") (&;Eq<Maybe> text;Eq<Text>)] + ($_ seq + (assert "Can compare Maybe values." + (and (Maybe/= #;None #;None) + (Maybe/= (#;Some "yolo") (#;Some "yolo")) + (not (Maybe/= (#;Some "yolo") (#;Some "lol"))) + (not (Maybe/= (#;Some "yolo") #;None)))) - (match true (:: (Eq<Maybe> text;Eq<Text>) = - (: (Maybe Text) #;None) - (: (Maybe Text) #;None))) - (match true (:: (Eq<Maybe> text;Eq<Text>) = - (#;Some "yolo") - (#;Some "yolo"))) - (match false (:: (Eq<Maybe> text;Eq<Text>) = - (#;Some "yolo") - (#;Some "lol"))) - (match false (:: (Eq<Maybe> text;Eq<Text>) = - (#;Some "yolo") - (: (Maybe Text) #;None))) - )) + (assert "Monoid respects Maybe." + (and (Maybe/= #;None &/unit) + (Maybe/= (#;Some "yolo") (&/append (#;Some "yolo") (#;Some "lol"))) + (Maybe/= (#;Some "yolo") (&/append (#;Some "yolo") #;None)) + (Maybe/= (#;Some "lol") (&/append #;None (#;Some "lol"))) + (Maybe/= #;None (: (Maybe Text) (&/append #;None #;None))))) + + (assert "Functor respects Maybe." + (and (Maybe/= #;None (&/map (Text/append "yolo") #;None)) + (Maybe/= (#;Some "yololol") (&/map (Text/append "yolo") (#;Some "lol"))))) + + (assert "Applicative respects Maybe." + (and (Maybe/= (#;Some "yolo") (&/wrap "yolo")) + (Maybe/= (#;Some "yololol") + (&/apply (&/wrap (Text/append "yolo")) (&/wrap "lol"))))) + + (assert "Monad respects Maybe." + (Maybe/= (#;Some "yololol") + (do &;Monad<Maybe> + [f (wrap Text/append) + a (wrap "yolo") + b (wrap "lol")] + (wrap (f a b))))) + ))) diff --git a/stdlib/test/test/lux/data/product.lux b/stdlib/test/test/lux/data/product.lux index 51c23e47d..f74c9a4d8 100644 --- a/stdlib/test/test/lux/data/product.lux +++ b/stdlib/test/test/lux/data/product.lux @@ -13,8 +13,14 @@ (codata function)) lux/test) -(test: "Product operations" - (all (match 1 (left [1 2])) - (match 2 (right [1 2])) - (match [2 1] (swap [1 2])) - )) +(test: "Products" + ($_ seq + (assert "Can access the sides of a pair." + (and (= 1 (left [1 2])) + (= 2 (right [1 2])))) + + (assert "Can swap the sides of a pair." + (let [[_left _right] (swap [1 2])] + (and (= 2 _left) + (= 1 _right)))) + )) diff --git a/stdlib/test/test/lux/data/struct/array.lux b/stdlib/test/test/lux/data/struct/array.lux index 171631bd9..ba4b5a3ae 100644 --- a/stdlib/test/test/lux/data/struct/array.lux +++ b/stdlib/test/test/lux/data/struct/array.lux @@ -27,28 +27,29 @@ (&;new size)) manual-copy (: (&;Array Nat) (&;new size))]] - (all (assert "Size function must correctly return size of array." - (=+ size (&;size original))) - (assert "Cloning an array should yield and identical array, but not the same one." - (and (:: (&;Eq<Array> number;Eq<Nat>) = original clone) - (not (== original clone)))) - (assert "Full-range manual copies should give the same result as cloning." - (exec (&;copy size +0 original +0 copy) - (and (:: (&;Eq<Array> number;Eq<Nat>) = original copy) - (not (== original copy))))) - (assert "Array folding should go over all values." - (exec (:: &;Fold<Array> fold - (lambda [x idx] - (exec (&;put idx x manual-copy) - (inc+ idx))) - +0 - original) - (:: (&;Eq<Array> number;Eq<Nat>) = original manual-copy))) - (assert "Transformations between (full) arrays and lists shouldn't cause lose or change any values." - (|> original - &;to-list &;from-list - (:: (&;Eq<Array> number;Eq<Nat>) = original))) - )) + ($_ seq + (assert "Size function must correctly return size of array." + (=+ size (&;size original))) + (assert "Cloning an array should yield and identical array, but not the same one." + (and (:: (&;Eq<Array> number;Eq<Nat>) = original clone) + (not (== original clone)))) + (assert "Full-range manual copies should give the same result as cloning." + (exec (&;copy size +0 original +0 copy) + (and (:: (&;Eq<Array> number;Eq<Nat>) = original copy) + (not (== original copy))))) + (assert "Array folding should go over all values." + (exec (:: &;Fold<Array> fold + (lambda [x idx] + (exec (&;put idx x manual-copy) + (inc+ idx))) + +0 + original) + (:: (&;Eq<Array> number;Eq<Nat>) = original manual-copy))) + (assert "Transformations between (full) arrays and lists shouldn't cause lose or change any values." + (|> original + &;to-list &;from-list + (:: (&;Eq<Array> number;Eq<Nat>) = original))) + )) (test: "Array mutation" [size bounded-size @@ -57,55 +58,58 @@ (R;filter (|>. &;to-list (list;any? odd?+)))) #let [value (default (undefined) (&;get idx array))]] - (all (assert "Shouldn't be able to find a value in an unoccupied cell." - (case (&;get idx (&;remove idx array)) - (#;Some _) false - #;None true)) - (assert "You should be able to access values put into the array." - (case (&;get idx (&;put idx value array)) - (#;Some value') (=+ value' value) - #;None false)) - (assert "All cells should be occupied on a full array." - (and (=+ size (&;occupied array)) - (=+ +0 (&;vacant array)))) - (assert "Filtering mutates the array to remove invalid values." - (exec (&;filter even?+ array) - (and (<+ size (&;occupied array)) - (>+ +0 (&;vacant array)) - (=+ size (++ (&;occupied array) - (&;vacant array)))))) - )) + ($_ seq + (assert "Shouldn't be able to find a value in an unoccupied cell." + (case (&;get idx (&;remove idx array)) + (#;Some _) false + #;None true)) + (assert "You should be able to access values put into the array." + (case (&;get idx (&;put idx value array)) + (#;Some value') (=+ value' value) + #;None false)) + (assert "All cells should be occupied on a full array." + (and (=+ size (&;occupied array)) + (=+ +0 (&;vacant array)))) + (assert "Filtering mutates the array to remove invalid values." + (exec (&;filter even?+ array) + (and (<+ size (&;occupied array)) + (>+ +0 (&;vacant array)) + (=+ size (++ (&;occupied array) + (&;vacant array)))))) + )) (test: "Finding values." [size bounded-size array (|> (R;array size R;nat) (R;filter (|>. &;to-list (list;any? even?+))))] - (all (assert "Can find values inside arrays." - (|> (&;find even?+ array) - (case> (#;Some _) true - #;None false))) - (assert "Can find values inside arrays (with access to indices)." - (|> (&;find+ (lambda [idx n] - (and (even?+ n) - (<+ size idx))) - array) - (case> (#;Some _) true - #;None false))))) + ($_ seq + (assert "Can find values inside arrays." + (|> (&;find even?+ array) + (case> (#;Some _) true + #;None false))) + (assert "Can find values inside arrays (with access to indices)." + (|> (&;find+ (lambda [idx n] + (and (even?+ n) + (<+ size idx))) + array) + (case> (#;Some _) true + #;None false))))) (test: "Functor" [size bounded-size array (R;array size R;nat)] (let [(^open) &;Functor<Array> (^open) (&;Eq<Array> number;Eq<Nat>)] - (all (assert "Functor shouldn't alter original array." - (let [copy (map id array)] - (and (= array copy) - (not (== array copy))))) - (assert "Functor should go over all available array elements." - (let [there (map inc+ array) - back-again (map dec+ there)] - (and (not (= array there)) - (= array back-again))))))) + ($_ seq + (assert "Functor shouldn't alter original array." + (let [copy (map id array)] + (and (= array copy) + (not (== array copy))))) + (assert "Functor should go over all available array elements." + (let [there (map inc+ array) + back-again (map dec+ there)] + (and (not (= array there)) + (= array back-again))))))) (test: "Monoid" [sizeL bounded-size @@ -115,16 +119,17 @@ #let [(^open) &;Monoid<Array> (^open) (&;Eq<Array> number;Eq<Nat>) fusion (append left right)]] - (all (assert "Appending two arrays should produce a new one twice as large." - (=+ (++ sizeL sizeR) (&;size fusion))) - (assert "First elements of fused array should equal the first array." - (|> (: (&;Array Nat) - (&;new sizeL)) - (&;copy sizeL +0 fusion +0) - (= left))) - (assert "Last elements of fused array should equal the second array." - (|> (: (&;Array Nat) - (&;new sizeR)) - (&;copy sizeR sizeL fusion +0) - (= right))) - )) + ($_ seq + (assert "Appending two arrays should produce a new one twice as large." + (=+ (++ sizeL sizeR) (&;size fusion))) + (assert "First elements of fused array should equal the first array." + (|> (: (&;Array Nat) + (&;new sizeL)) + (&;copy sizeL +0 fusion +0) + (= left))) + (assert "Last elements of fused array should equal the second array." + (|> (: (&;Array Nat) + (&;new sizeR)) + (&;copy sizeR sizeL fusion +0) + (= right))) + )) diff --git a/stdlib/test/test/lux/data/struct/dict.lux b/stdlib/test/test/lux/data/struct/dict.lux index 06b9550aa..2e14ddfff 100644 --- a/stdlib/test/test/lux/data/struct/dict.lux +++ b/stdlib/test/test/lux/data/struct/dict.lux @@ -27,110 +27,111 @@ (R;filter (lambda [key] (not (&;contains? key dict))))) test-val (|> R;nat (R;filter (lambda [val] (not (list;member? number;Eq<Nat> (&;values dict) val)))))] - (all (assert "Size function should correctly represent Dict size." - (=+ size (&;size dict))) - - (assert "Dicts of size 0 should be considered empty." - (if (=+ +0 size) - (&;empty? dict) - (not (&;empty? dict)))) - - (assert "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list;Eq<List> (eq;conj char;Eq<Char> number;Eq<Nat>)) = - (&;entries dict) - (list;zip2 (&;keys dict) - (&;values dict)))) - - (assert "Dict should be able to recognize it's own keys." - (list;every? (lambda [key] (&;contains? key dict)) - (&;keys dict))) - - (assert "Should be able to get every key." - (list;every? (lambda [key] (case (&;get key dict) - (#;Some _) true - _ false)) - (&;keys dict))) - - (assert "Shouldn't be able to access non-existant keys." - (case (&;get non-key dict) - (#;Some _) false - _ true)) - - (assert "Should be able to put and then get a value." - (case (&;get non-key (&;put non-key test-val dict)) - (#;Some v) (=+ test-val v) - _ true)) - - (assert "Should be able to put~ and then get a value." - (case (&;get non-key (&;put~ non-key test-val dict)) - (#;Some v) (=+ test-val v) - _ true)) - - (assert "Shouldn't be able to put~ an existing key." - (or (=+ +0 size) - (let [first-key (|> dict &;keys list;head (default (undefined)))] - (case (&;get first-key (&;put~ first-key test-val dict)) - (#;Some v) (not (=+ test-val v)) - _ true)))) - - (assert "Removing a key should make it's value inaccessible." - (let [base (&;put non-key test-val dict)] - (and (&;contains? non-key base) - (not (&;contains? non-key (&;remove non-key base)))))) - - (assert "Should be possible to update values via their keys." - (let [base (&;put non-key test-val dict) - updt (&;update non-key inc+ base)] - (case [(&;get non-key base) (&;get non-key updt)] - [(#;Some x) (#;Some y)] - (=+ (inc+ x) y) + ($_ seq + (assert "Size function should correctly represent Dict size." + (=+ size (&;size dict))) + + (assert "Dicts of size 0 should be considered empty." + (if (=+ +0 size) + (&;empty? dict) + (not (&;empty? dict)))) + + (assert "The functions 'entries', 'keys' and 'values' should be synchronized." + (:: (list;Eq<List> (eq;conj char;Eq<Char> number;Eq<Nat>)) = + (&;entries dict) + (list;zip2 (&;keys dict) + (&;values dict)))) + + (assert "Dict should be able to recognize it's own keys." + (list;every? (lambda [key] (&;contains? key dict)) + (&;keys dict))) + + (assert "Should be able to get every key." + (list;every? (lambda [key] (case (&;get key dict) + (#;Some _) true + _ false)) + (&;keys dict))) + + (assert "Shouldn't be able to access non-existant keys." + (case (&;get non-key dict) + (#;Some _) false + _ true)) + + (assert "Should be able to put and then get a value." + (case (&;get non-key (&;put non-key test-val dict)) + (#;Some v) (=+ test-val v) + _ true)) + + (assert "Should be able to put~ and then get a value." + (case (&;get non-key (&;put~ non-key test-val dict)) + (#;Some v) (=+ test-val v) + _ true)) + + (assert "Shouldn't be able to put~ an existing key." + (or (=+ +0 size) + (let [first-key (|> dict &;keys list;head (default (undefined)))] + (case (&;get first-key (&;put~ first-key test-val dict)) + (#;Some v) (not (=+ test-val v)) + _ true)))) + + (assert "Removing a key should make it's value inaccessible." + (let [base (&;put non-key test-val dict)] + (and (&;contains? non-key base) + (not (&;contains? non-key (&;remove non-key base)))))) + + (assert "Should be possible to update values via their keys." + (let [base (&;put non-key test-val dict) + updt (&;update non-key inc+ base)] + (case [(&;get non-key base) (&;get non-key updt)] + [(#;Some x) (#;Some y)] + (=+ (inc+ x) y) - _ - false))) - - (assert "Additions and removals to a Dict should affect its size." - (let [plus (&;put non-key test-val dict) - base (&;remove non-key plus)] - (and (=+ (inc+ (&;size dict)) (&;size plus)) - (=+ (dec+ (&;size plus)) (&;size base))))) + _ + false))) + + (assert "Additions and removals to a Dict should affect its size." + (let [plus (&;put non-key test-val dict) + base (&;remove non-key plus)] + (and (=+ (inc+ (&;size dict)) (&;size plus)) + (=+ (dec+ (&;size plus)) (&;size base))))) - (assert "A Dict should equal itself & going to<->from lists shouldn't change that." - (let [(^open) (&;Eq<Dict> number;Eq<Nat>)] - (and (= dict dict) - (|> dict &;entries (&;from-list char;Hash<Char>) (= dict))))) + (assert "A Dict should equal itself & going to<->from lists shouldn't change that." + (let [(^open) (&;Eq<Dict> number;Eq<Nat>)] + (and (= dict dict) + (|> dict &;entries (&;from-list char;Hash<Char>) (= dict))))) - (assert "Merging a Dict to itself changes nothing." - (let [(^open) (&;Eq<Dict> number;Eq<Nat>)] - (= dict (&;merge dict dict)))) + (assert "Merging a Dict to itself changes nothing." + (let [(^open) (&;Eq<Dict> number;Eq<Nat>)] + (= dict (&;merge dict dict)))) - (assert "If you merge, and the second dict has overlapping keys, it should overwrite yours." - (let [dict' (|> dict &;entries - (List/map (lambda [[k v]] [k (inc+ v)])) - (&;from-list char;Hash<Char>)) - (^open) (&;Eq<Dict> number;Eq<Nat>)] - (= dict' (&;merge dict' dict)))) + (assert "If you merge, and the second dict has overlapping keys, it should overwrite yours." + (let [dict' (|> dict &;entries + (List/map (lambda [[k v]] [k (inc+ v)])) + (&;from-list char;Hash<Char>)) + (^open) (&;Eq<Dict> number;Eq<Nat>)] + (= dict' (&;merge dict' dict)))) - (assert "Can merge values in such a way that they become combined." - (list;every? (lambda [[x x*2]] (=+ (*+ +2 x) x*2)) - (list;zip2 (&;values dict) - (&;values (&;merge-with ++ dict dict))))) + (assert "Can merge values in such a way that they become combined." + (list;every? (lambda [[x x*2]] (=+ (*+ +2 x) x*2)) + (list;zip2 (&;values dict) + (&;values (&;merge-with ++ dict dict))))) - (assert "Should be able to select subset of keys from dict." - (|> dict - (&;put non-key test-val) - (&;select (list non-key)) - &;size - (=+ +1))) + (assert "Should be able to select subset of keys from dict." + (|> dict + (&;put non-key test-val) + (&;select (list non-key)) + &;size + (=+ +1))) - (assert "Should be able to re-bind existing values to different keys." - (or (=+ +0 size) - (let [first-key (|> dict &;keys list;head (default (undefined))) - rebound (&;re-bind first-key non-key dict)] - (and (=+ (&;size dict) (&;size rebound)) - (&;contains? non-key rebound) - (not (&;contains? first-key rebound)) - (=+ (default (undefined) - (&;get first-key dict)) - (default (undefined) - (&;get non-key rebound))))))) - )) + (assert "Should be able to re-bind existing values to different keys." + (or (=+ +0 size) + (let [first-key (|> dict &;keys list;head (default (undefined))) + rebound (&;re-bind first-key non-key dict)] + (and (=+ (&;size dict) (&;size rebound)) + (&;contains? non-key rebound) + (not (&;contains? first-key rebound)) + (=+ (default (undefined) + (&;get first-key dict)) + (default (undefined) + (&;get non-key rebound))))))) + )) diff --git a/stdlib/test/test/lux/data/struct/list.lux b/stdlib/test/test/lux/data/struct/list.lux index 6baf13c6c..5803e8615 100644 --- a/stdlib/test/test/lux/data/struct/list.lux +++ b/stdlib/test/test/lux/data/struct/list.lux @@ -21,7 +21,7 @@ (|> R;nat (:: R;Monad<Random> map (|>. (%+ +100) (++ +10))))) -(test: "Lists" +(test: "Lists: Part 1" [size bounded-size idx (:: @ map (%+ size) R;nat) sample (R;list size R;nat) @@ -30,162 +30,185 @@ separator R;nat #let [(^open) (&;Eq<List> number;Eq<Nat>) (^open "&/") &;Functor<List>]] - (all (assert "The size function should correctly portray the size of the list." - (=+ size (&;size sample))) - - (assert "The repeat function should produce as many elements as asked of it." - (=+ size (&;size (&;repeat size [])))) - - (assert "Reversing a list does not change it's size." - (=+ (&;size sample) - (&;size (&;reverse sample)))) - - (assert "Reversing a list twice results in the original list." - (= sample - (&;reverse (&;reverse sample)))) - - (assert "Filtering by a predicate and its complement should result in a number of elements equal to the original list." - (and (=+ (&;size sample) - (++ (&;size (&;filter even?+ sample)) - (&;size (&;filter (bool;complement even?+) sample)))) - (let [[plus minus] (&;partition even?+ sample)] - (=+ (&;size sample) - (++ (&;size plus) - (&;size minus)))))) - - (assert "If every element in a list satisfies a predicate, there can't be any that satisfy its complement." - (if (&;every? even?+ sample) - (and (not (&;any? (bool;complement even?+) sample)) - (&;empty? (&;filter (bool;complement even?+) sample))) - (&;any? (bool;complement even?+) sample))) - - (assert "Any element of the list can be considered it's member." - (let [elem (default (undefined) - (&;at idx sample))] - (&;member? number;Eq<Nat> sample elem))) - - (assert "Appending the head and the tail should yield the original list." - (let [head (default (undefined) - (&;head sample)) - tail (default (undefined) - (&;tail sample))] - (= sample - (#;Cons head tail)))) - - (assert "Appending the inits and the last should yield the original list." - (let [(^open) &;Monoid<List> - inits (default (undefined) - (&;inits sample)) - last (default (undefined) - (&;last sample))] - (= sample - (append inits (list last))))) - - (assert "Functor should go over every element of the list." - (let [(^open) &;Functor<List> - there (map inc+ sample) - back-again (map dec+ there)] - (and (not (= sample there)) - (= sample back-again)))) - - (assert "Splitting a list into chunks and re-appending them should yield the original list." - (let [(^open) &;Monoid<List> - [left right] (&;split idx sample) - [left' right'] (&;split-with even?+ sample)] - (and (= sample - (append left right)) - (= sample - (append left' right')) - (= sample - (append (&;take idx sample) - (&;drop idx sample))) - (= sample - (append (&;take-while even?+ sample) - (&;drop-while even?+ sample))) - ))) - - (assert "Segmenting the list in pairs should yield as many elements as N/2." - (=+ (/+ +2 size) - (&;size (&;as-pairs sample)))) - - (assert "Sorting a list shouldn't change it's size." - (=+ (&;size sample) - (&;size (&;sort <+ sample)))) - - (assert "Sorting a list with one order should yield the reverse of sorting it with the opposite order." - (= (&;sort <+ sample) - (&;reverse (&;sort >+ sample)))) - - (assert "If you zip 2 lists, the result's size will be that of the smaller list." - (=+ (&;size (&;zip2 sample other-sample)) - (min+ (&;size sample) (&;size other-sample)))) - - (assert "I can pair-up elements of a list in order." - (let [(^open) &;Functor<List> - zipped (&;zip2 sample other-sample) - num-zipper (&;size zipped)] - (and (|> zipped (map product;left) (= (&;take num-zipper sample))) - (|> zipped (map product;right) (= (&;take num-zipper other-sample)))))) - - (assert "You can generate indices for any size, and they will be in ascending order." - (let [(^open) &;Functor<List> - indices (&;indices size)] - (and (=+ size (&;size indices)) - (= indices - (&;sort <+ indices)) - (&;every? (=+ (dec+ size)) - (&;zip2-with ++ - indices - (&;sort >+ indices))) - ))) - - (assert "The 'interpose' function places a value between every member of a list." - (let [(^open) &;Functor<List> - sample+ (&;interpose separator sample)] - (and (=+ (|> size (*+ +2) dec+) - (&;size sample+)) - (|> sample+ &;as-pairs (map product;right) (&;every? (=+ separator)))))) - - (assert "List append is a monoid." - (let [(^open) &;Monoid<List>] - (and (= sample (append unit sample)) - (= sample (append sample unit)) - (let [[left right] (&;split size (append sample other-sample))] - (and (= sample left) - (= other-sample right)))))) - - (assert "Applicative allows you to create singleton lists, and apply lists of functions to lists of values." - (let [(^open) &;Applicative<List>] - (and (= (list separator) (wrap separator)) - (= (map inc+ sample) - (apply (wrap inc+) sample))))) - - (assert "List concatenation is a monad." - (let [(^open) &;Monad<List> - (^open) &;Monoid<List>] - (= (append sample other-sample) - (join (list sample other-sample))))) - - (assert "You can find any value that satisfies some criterium, if such values exist in the list." - (case (&;find even?+ sample) - (#;Some found) - (and (even?+ found) - (&;any? even?+ sample) - (not (&;every? (bool;complement even?+) sample))) - - #;None - (and (not (&;any? even?+ sample)) - (&;every? (bool;complement even?+) sample)))) - - (assert "You can iteratively construct a list, generating values until you're done." - (= (&;range+ +0 (dec+ size)) - (&;iterate (lambda [n] (if (<+ size n) (#;Some (inc+ n)) #;None)) - +0))) - - (assert "Can enumerate all elements in a list." - (let [enum-sample (&;enumerate sample)] - (and (= (&;indices (&;size enum-sample)) - (&/map product;left enum-sample)) - (= sample - (&/map product;right enum-sample))))) - )) + ($_ seq + (assert "The size function should correctly portray the size of the list." + (=+ size (&;size sample))) + + (assert "The repeat function should produce as many elements as asked of it." + (=+ size (&;size (&;repeat size [])))) + + (assert "Reversing a list does not change it's size." + (=+ (&;size sample) + (&;size (&;reverse sample)))) + + (assert "Reversing a list twice results in the original list." + (= sample + (&;reverse (&;reverse sample)))) + + (assert "Filtering by a predicate and its complement should result in a number of elements equal to the original list." + (and (=+ (&;size sample) + (++ (&;size (&;filter even?+ sample)) + (&;size (&;filter (bool;complement even?+) sample)))) + (let [[plus minus] (&;partition even?+ sample)] + (=+ (&;size sample) + (++ (&;size plus) + (&;size minus)))))) + + (assert "If every element in a list satisfies a predicate, there can't be any that satisfy its complement." + (if (&;every? even?+ sample) + (and (not (&;any? (bool;complement even?+) sample)) + (&;empty? (&;filter (bool;complement even?+) sample))) + (&;any? (bool;complement even?+) sample))) + + (assert "Any element of the list can be considered it's member." + (let [elem (default (undefined) + (&;at idx sample))] + (&;member? number;Eq<Nat> sample elem))) + )) + +(test: "Lists: Part 2" + [size bounded-size + idx (:: @ map (%+ size) R;nat) + sample (R;list size R;nat) + other-size bounded-size + other-sample (R;list other-size R;nat) + separator R;nat + #let [(^open) (&;Eq<List> number;Eq<Nat>) + (^open "&/") &;Functor<List>]] + ($_ seq + (assert "Appending the head and the tail should yield the original list." + (let [head (default (undefined) + (&;head sample)) + tail (default (undefined) + (&;tail sample))] + (= sample + (#;Cons head tail)))) + + (assert "Appending the inits and the last should yield the original list." + (let [(^open) &;Monoid<List> + inits (default (undefined) + (&;inits sample)) + last (default (undefined) + (&;last sample))] + (= sample + (append inits (list last))))) + + (assert "Functor should go over every element of the list." + (let [(^open) &;Functor<List> + there (map inc+ sample) + back-again (map dec+ there)] + (and (not (= sample there)) + (= sample back-again)))) + + (assert "Splitting a list into chunks and re-appending them should yield the original list." + (let [(^open) &;Monoid<List> + [left right] (&;split idx sample) + [left' right'] (&;split-with even?+ sample)] + (and (= sample + (append left right)) + (= sample + (append left' right')) + (= sample + (append (&;take idx sample) + (&;drop idx sample))) + (= sample + (append (&;take-while even?+ sample) + (&;drop-while even?+ sample))) + ))) + + (assert "Segmenting the list in pairs should yield as many elements as N/2." + (=+ (/+ +2 size) + (&;size (&;as-pairs sample)))) + + (assert "Sorting a list shouldn't change it's size." + (=+ (&;size sample) + (&;size (&;sort <+ sample)))) + + (assert "Sorting a list with one order should yield the reverse of sorting it with the opposite order." + (= (&;sort <+ sample) + (&;reverse (&;sort >+ sample)))) + )) + +(test: "Lists: Part 3" + [size bounded-size + idx (:: @ map (%+ size) R;nat) + sample (R;list size R;nat) + other-size bounded-size + other-sample (R;list other-size R;nat) + separator R;nat + #let [(^open) (&;Eq<List> number;Eq<Nat>) + (^open "&/") &;Functor<List>]] + ($_ seq + (assert "If you zip 2 lists, the result's size will be that of the smaller list." + (=+ (&;size (&;zip2 sample other-sample)) + (min+ (&;size sample) (&;size other-sample)))) + + (assert "I can pair-up elements of a list in order." + (let [(^open) &;Functor<List> + zipped (&;zip2 sample other-sample) + num-zipper (&;size zipped)] + (and (|> zipped (map product;left) (= (&;take num-zipper sample))) + (|> zipped (map product;right) (= (&;take num-zipper other-sample)))))) + + (assert "You can generate indices for any size, and they will be in ascending order." + (let [(^open) &;Functor<List> + indices (&;indices size)] + (and (=+ size (&;size indices)) + (= indices + (&;sort <+ indices)) + (&;every? (=+ (dec+ size)) + (&;zip2-with ++ + indices + (&;sort >+ indices))) + ))) + + (assert "The 'interpose' function places a value between every member of a list." + (let [(^open) &;Functor<List> + sample+ (&;interpose separator sample)] + (and (=+ (|> size (*+ +2) dec+) + (&;size sample+)) + (|> sample+ &;as-pairs (map product;right) (&;every? (=+ separator)))))) + + (assert "List append is a monoid." + (let [(^open) &;Monoid<List>] + (and (= sample (append unit sample)) + (= sample (append sample unit)) + (let [[left right] (&;split size (append sample other-sample))] + (and (= sample left) + (= other-sample right)))))) + + (assert "Applicative allows you to create singleton lists, and apply lists of functions to lists of values." + (let [(^open) &;Applicative<List>] + (and (= (list separator) (wrap separator)) + (= (map inc+ sample) + (apply (wrap inc+) sample))))) + + (assert "List concatenation is a monad." + (let [(^open) &;Monad<List> + (^open) &;Monoid<List>] + (= (append sample other-sample) + (join (list sample other-sample))))) + + (assert "You can find any value that satisfies some criterium, if such values exist in the list." + (case (&;find even?+ sample) + (#;Some found) + (and (even?+ found) + (&;any? even?+ sample) + (not (&;every? (bool;complement even?+) sample))) + + #;None + (and (not (&;any? even?+ sample)) + (&;every? (bool;complement even?+) sample)))) + + (assert "You can iteratively construct a list, generating values until you're done." + (= (&;range+ +0 (dec+ size)) + (&;iterate (lambda [n] (if (<+ size n) (#;Some (inc+ n)) #;None)) + +0))) + + (assert "Can enumerate all elements in a list." + (let [enum-sample (&;enumerate sample)] + (and (= (&;indices (&;size enum-sample)) + (&/map product;left enum-sample)) + (= sample + (&/map product;right enum-sample))))) + )) diff --git a/stdlib/test/test/lux/data/struct/queue.lux b/stdlib/test/test/lux/data/struct/queue.lux index 895929ab4..5473532bc 100644 --- a/stdlib/test/test/lux/data/struct/queue.lux +++ b/stdlib/test/test/lux/data/struct/queue.lux @@ -18,37 +18,38 @@ sample (R;queue size R;nat) non-member (|> R;nat (R;filter (. not (&;enqueued? number;Eq<Nat> sample))))] - (all (assert "I can query the size of a queue (and empty queues have size 0)." - (if (=+ +0 size) - (&;empty? sample) - (=+ size (&;size sample)))) + ($_ seq + (assert "I can query the size of a queue (and empty queues have size 0)." + (if (=+ +0 size) + (&;empty? sample) + (=+ size (&;size sample)))) - (assert "Enqueueing and dequeing affects the size of queues." - (and (=+ (inc+ size) (&;size (&;enqueue non-member sample))) - (or (&;empty? sample) - (=+ (dec+ size) (&;size (&;dequeue sample)))) - (=+ size (&;size (&;dequeue (&;enqueue non-member sample)))))) + (assert "Enqueueing and dequeing affects the size of queues." + (and (=+ (inc+ size) (&;size (&;enqueue non-member sample))) + (or (&;empty? sample) + (=+ (dec+ size) (&;size (&;dequeue sample)))) + (=+ size (&;size (&;dequeue (&;enqueue non-member sample)))))) - (assert "Transforming to/from list can't change the queue." - (let [(^open "&/") (&;Eq<Queue> number;Eq<Nat>)] - (|> sample - &;to-list &;from-list - (&/= sample)))) + (assert "Transforming to/from list can't change the queue." + (let [(^open "&/") (&;Eq<Queue> number;Eq<Nat>)] + (|> sample + &;to-list &;from-list + (&/= sample)))) - (assert "I can always peek at a non-empty queue." - (case (&;peek sample) - #;None (&;empty? sample) - (#;Some _) true)) + (assert "I can always peek at a non-empty queue." + (case (&;peek sample) + #;None (&;empty? sample) + (#;Some _) true)) - (assert "I can query whether an element belongs to a queue." - (and (not (&;enqueued? number;Eq<Nat> sample non-member)) - (&;enqueued? number;Eq<Nat> (&;enqueue non-member sample) - non-member) - (case (&;peek sample) - #;None - (&;empty? sample) - - (#;Some first) - (and (&;enqueued? number;Eq<Nat> sample first) - (not (&;enqueued? number;Eq<Nat> (&;dequeue sample) first)))))) - )) + (assert "I can query whether an element belongs to a queue." + (and (not (&;enqueued? number;Eq<Nat> sample non-member)) + (&;enqueued? number;Eq<Nat> (&;enqueue non-member sample) + non-member) + (case (&;peek sample) + #;None + (&;empty? sample) + + (#;Some first) + (and (&;enqueued? number;Eq<Nat> sample first) + (not (&;enqueued? number;Eq<Nat> (&;dequeue sample) first)))))) + )) diff --git a/stdlib/test/test/lux/data/struct/set.lux b/stdlib/test/test/lux/data/struct/set.lux index 3725e7f93..7a4663509 100644 --- a/stdlib/test/test/lux/data/struct/set.lux +++ b/stdlib/test/test/lux/data/struct/set.lux @@ -27,41 +27,42 @@ non-member (|> gen-nat (R;filter (. not (&;member? setL)))) #let [(^open "&/") &;Eq<Set>]] - (all (assert "I can query the size of a set." - (and (=+ sizeL (&;size setL)) - (=+ sizeR (&;size setR)))) + ($_ seq + (assert "I can query the size of a set." + (and (=+ sizeL (&;size setL)) + (=+ sizeR (&;size setR)))) - (assert "Converting sets to/from lists can't change their values." - (|> setL - &;to-list (&;from-list number;Hash<Nat>) - (&/= setL))) + (assert "Converting sets to/from lists can't change their values." + (|> setL + &;to-list (&;from-list number;Hash<Nat>) + (&/= setL))) - (assert "Every set is a sub-set of the union of itself with another." - (let [setLR (&;union setL setR)] - (and (&;sub? setLR setL) - (&;sub? setLR setR)))) + (assert "Every set is a sub-set of the union of itself with another." + (let [setLR (&;union setL setR)] + (and (&;sub? setLR setL) + (&;sub? setLR setR)))) - (assert "Every set is a super-set of the intersection of itself with another." - (let [setLR (&;intersection setL setR)] - (and (&;super? setLR setL) - (&;super? setLR setR)))) + (assert "Every set is a super-set of the intersection of itself with another." + (let [setLR (&;intersection setL setR)] + (and (&;super? setLR setL) + (&;super? setLR setR)))) - (assert "Union with the empty set leaves a set unchanged." - (&/= setL - (&;union (&;new number;Hash<Nat>) - setL))) + (assert "Union with the empty set leaves a set unchanged." + (&/= setL + (&;union (&;new number;Hash<Nat>) + setL))) - (assert "Intersection with the empty set results in the empty set." - (let [empty-set (&;new number;Hash<Nat>)] - (&/= empty-set - (&;intersection empty-set setL)))) + (assert "Intersection with the empty set results in the empty set." + (let [empty-set (&;new number;Hash<Nat>)] + (&/= empty-set + (&;intersection empty-set setL)))) - (assert "After substracting a set A from another B, no member of A can be a member of B." - (let [sub (&;difference setR setL)] - (not (list;any? (&;member? setL) (&;to-list setR))))) + (assert "After substracting a set A from another B, no member of A can be a member of B." + (let [sub (&;difference setR setL)] + (not (list;any? (&;member? setL) (&;to-list setR))))) - (assert "Every member of a set must be identifiable." - (and (not (&;member? setL non-member)) - (&;member? (&;add non-member setL) non-member) - (not (&;member? (&;remove non-member (&;add non-member setL)) non-member)))) - )) + (assert "Every member of a set must be identifiable." + (and (not (&;member? setL non-member)) + (&;member? (&;add non-member setL) non-member) + (not (&;member? (&;remove non-member (&;add non-member setL)) non-member)))) + )) diff --git a/stdlib/test/test/lux/data/struct/stack.lux b/stdlib/test/test/lux/data/struct/stack.lux index dc3bb1e89..c33bc4012 100644 --- a/stdlib/test/test/lux/data/struct/stack.lux +++ b/stdlib/test/test/lux/data/struct/stack.lux @@ -23,25 +23,26 @@ [size gen-nat sample (R;stack size gen-nat) new-top gen-nat] - (all (assert "Can query the size of a stack." - (=+ size (&;size sample))) + ($_ seq + (assert "Can query the size of a stack." + (=+ size (&;size sample))) - (assert "Can peek inside non-empty stacks." - (case (&;peek sample) - #;None (&;empty? sample) - (#;Some _) (not (&;empty? sample)))) + (assert "Can peek inside non-empty stacks." + (case (&;peek sample) + #;None (&;empty? sample) + (#;Some _) (not (&;empty? sample)))) - (assert "Popping empty stacks doesn't change anything. + (assert "Popping empty stacks doesn't change anything. But, if they're non-empty, the top of the stack is removed." - (let [sample' (&;pop sample)] - (or (=+ (&;size sample) (inc+ (&;size sample'))) - (and (&;empty? sample) (&;empty? sample'))) - )) + (let [sample' (&;pop sample)] + (or (=+ (&;size sample) (inc+ (&;size sample'))) + (and (&;empty? sample) (&;empty? sample'))) + )) - (assert "Pushing onto a stack always increases it by 1, adding a new value at the top." - (and (== sample - (&;pop (&;push new-top sample))) - (=+ (inc+ (&;size sample)) (&;size (&;push new-top sample))) - (|> (&;push new-top sample) &;peek (default (undefined)) - (== new-top)))) - )) + (assert "Pushing onto a stack always increases it by 1, adding a new value at the top." + (and (== sample + (&;pop (&;push new-top sample))) + (=+ (inc+ (&;size sample)) (&;size (&;push new-top sample))) + (|> (&;push new-top sample) &;peek (default (undefined)) + (== new-top)))) + )) diff --git a/stdlib/test/test/lux/data/struct/tree.lux b/stdlib/test/test/lux/data/struct/tree.lux index 0595ca7b3..90b80943a 100644 --- a/stdlib/test/test/lux/data/struct/tree.lux +++ b/stdlib/test/test/lux/data/struct/tree.lux @@ -27,13 +27,14 @@ #let [branch (&;branch branchV (List/map &;leaf branchC))] #let [(^open "&/") (&;Eq<Tree> number;Eq<Nat>) (^open "List/") (list;Eq<List> number;Eq<Nat>)]] - (all (assert "Can compare trees for equality." - (and (&/= leaf leaf) - (&/= branch branch) - (not (&/= leaf branch)) - (not (&/= leaf (&;branch branchV (List/map &;leaf (list;reverse branchC))))))) + ($_ seq + (assert "Can compare trees for equality." + (and (&/= leaf leaf) + (&/= branch branch) + (not (&/= leaf branch)) + (not (&/= leaf (&;branch branchV (List/map &;leaf (list;reverse branchC))))))) - (assert "Can flatten a tree to get all the nodes as a flat tree." - (List/= (list& branchV branchC) - (&;flatten branch))) - )) + (assert "Can flatten a tree to get all the nodes as a flat tree." + (List/= (list& branchV branchC) + (&;flatten branch))) + )) diff --git a/stdlib/test/test/lux/data/struct/vector.lux b/stdlib/test/test/lux/data/struct/vector.lux index 87f8fa4cb..2ccfa2fc1 100644 --- a/stdlib/test/test/lux/data/struct/vector.lux +++ b/stdlib/test/test/lux/data/struct/vector.lux @@ -27,58 +27,59 @@ (^open "&/") &;Monad<Vector> (^open "&/") &;Fold<Vector> (^open "&/") &;Monoid<Vector>]] - (all (assert "Can query size of vector." - (if (&;empty? sample) - (and (=+ +0 size) - (=+ +0 (&;size sample))) - (=+ size (&;size sample)))) + ($_ seq + (assert "Can query size of vector." + (if (&;empty? sample) + (and (=+ +0 size) + (=+ +0 (&;size sample))) + (=+ size (&;size sample)))) - (assert "Can add and remove elements to vectors." - (and (=+ (inc+ size) - (&;size (&;add non-member sample))) - (=+ (dec+ size) - (&;size (&;pop sample))))) + (assert "Can add and remove elements to vectors." + (and (=+ (inc+ size) + (&;size (&;add non-member sample))) + (=+ (dec+ size) + (&;size (&;pop sample))))) - (assert "Can put and get elements into vectors." - (|> sample - (&;put idx non-member) - (&;at idx) - (default (undefined)) - (== non-member))) + (assert "Can put and get elements into vectors." + (|> sample + (&;put idx non-member) + (&;at idx) + (default (undefined)) + (== non-member))) - (assert "Can update elements of vectors." - (|> sample - (&;put idx non-member) - (&;update idx inc+) - (&;at idx) - (default (undefined)) - (=+ (inc+ non-member)))) + (assert "Can update elements of vectors." + (|> sample + (&;put idx non-member) + (&;update idx inc+) + (&;at idx) + (default (undefined)) + (=+ (inc+ non-member)))) - (assert "Can safely transform to/from lists." - (|> sample - &;to-list &;from-list - (&/= sample))) + (assert "Can safely transform to/from lists." + (|> sample + &;to-list &;from-list + (&/= sample))) - (assert "Can identify members of a vector." - (and (not (&;member? number;Eq<Nat> sample non-member)) - (&;member? number;Eq<Nat> (&;add non-member sample) non-member))) + (assert "Can identify members of a vector." + (and (not (&;member? number;Eq<Nat> sample non-member)) + (&;member? number;Eq<Nat> (&;add non-member sample) non-member))) - (assert "Can fold over elements of vector." - (=+ (List/fold ++ +0 (&;to-list sample)) - (&/fold ++ +0 sample))) - - (assert "Functor goes over every element." - (let [there (&/map inc+ sample) - back-again (&/map dec+ there)] - (and (not (&/= sample there)) - (&/= sample back-again)))) + (assert "Can fold over elements of vector." + (=+ (List/fold ++ +0 (&;to-list sample)) + (&/fold ++ +0 sample))) + + (assert "Functor goes over every element." + (let [there (&/map inc+ sample) + back-again (&/map dec+ there)] + (and (not (&/= sample there)) + (&/= sample back-again)))) - (assert "Applicative allows you to create singleton vectors, and apply vectors of functions to vectors of values." - (and (&/= (&;vector non-member) (&/wrap non-member)) - (&/= (&/map inc+ sample) - (&/apply (&/wrap inc+) sample)))) + (assert "Applicative allows you to create singleton vectors, and apply vectors of functions to vectors of values." + (and (&/= (&;vector non-member) (&/wrap non-member)) + (&/= (&/map inc+ sample) + (&/apply (&/wrap inc+) sample)))) - (assert "Vector concatenation is a monad." - (&/= (&/append sample other-sample) - (&/join (&;vector sample other-sample)))) - )) + (assert "Vector concatenation is a monad." + (&/= (&/append sample other-sample) + (&/join (&;vector sample other-sample)))) + )) diff --git a/stdlib/test/test/lux/data/struct/zipper.lux b/stdlib/test/test/lux/data/struct/zipper.lux index a3bede88d..62f167ffd 100644 --- a/stdlib/test/test/lux/data/struct/zipper.lux +++ b/stdlib/test/test/lux/data/struct/zipper.lux @@ -41,87 +41,88 @@ post-val R;nat #let [(^open "Tree/") (tree;Eq<Tree> number;Eq<Nat>) (^open "List/") (list;Eq<List> number;Eq<Nat>)]] - (all (assert "Trees can be converted to/from zippers." - (|> sample - &;from-tree &;to-tree - (Tree/= sample))) + ($_ seq + (assert "Trees can be converted to/from zippers." + (|> sample + &;from-tree &;to-tree + (Tree/= sample))) - (assert "Creating a zipper gives you a root node." - (|> sample &;from-tree &;root?)) - - (assert "Can move down inside branches. Can move up from lower nodes." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (let [child (|> zipper &;down)] - (and (not (Tree/= sample (&;to-tree child))) - (|> child &;parent (default (undefined)) (== zipper)) - (|> child &;up (== zipper)) - (|> child &;root (== zipper)))) - (and (&;leaf? zipper) - (|> zipper (&;prepend-child new-val) &;branch?))))) + (assert "Creating a zipper gives you a root node." + (|> sample &;from-tree &;root?)) + + (assert "Can move down inside branches. Can move up from lower nodes." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (let [child (|> zipper &;down)] + (and (not (Tree/= sample (&;to-tree child))) + (|> child &;parent (default (undefined)) (== zipper)) + (|> child &;up (== zipper)) + (|> child &;root (== zipper)))) + (and (&;leaf? zipper) + (|> zipper (&;prepend-child new-val) &;branch?))))) - (assert "Can prepend and append children." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (let [mid-val (|> zipper &;down &;value) - zipper (|> zipper - (&;prepend-child pre-val) - (&;append-child post-val))] - (and (|> zipper &;down &;value (== pre-val)) - (|> zipper &;down &;right &;value (== mid-val)) - (|> zipper &;down &;right &;right &;value (== post-val)) - (|> zipper &;down &;rightmost &;leftmost &;value (== pre-val)) - (|> zipper &;down &;right &;left &;value (== mid-val)) - (|> zipper &;down &;rightmost &;value (== post-val)))) - true))) + (assert "Can prepend and append children." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (let [mid-val (|> zipper &;down &;value) + zipper (|> zipper + (&;prepend-child pre-val) + (&;append-child post-val))] + (and (|> zipper &;down &;value (== pre-val)) + (|> zipper &;down &;right &;value (== mid-val)) + (|> zipper &;down &;right &;right &;value (== post-val)) + (|> zipper &;down &;rightmost &;leftmost &;value (== pre-val)) + (|> zipper &;down &;right &;left &;value (== mid-val)) + (|> zipper &;down &;rightmost &;value (== post-val)))) + true))) - (assert "Can insert children around a node (unless it's root)." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (let [mid-val (|> zipper &;down &;value) - zipper (|> zipper - &;down - (&;insert-left pre-val) - (default (undefined)) - (&;insert-right post-val) - (default (undefined)) - &;up)] - (and (|> zipper &;down &;value (== pre-val)) - (|> zipper &;down &;right &;value (== mid-val)) - (|> zipper &;down &;right &;right &;value (== post-val)) - (|> zipper &;down &;rightmost &;leftmost &;value (== pre-val)) - (|> zipper &;down &;right &;left &;value (== mid-val)) - (|> zipper &;down &;rightmost &;value (== post-val)))) - (and (|> zipper (&;insert-left pre-val) (case> (#;Some _) false - #;None true)) - (|> zipper (&;insert-right post-val) (case> (#;Some _) false - #;None true)))))) - - (assert "Can set and update the value of a node." - (|> sample &;from-tree (&;set new-val) &;value (=+ new-val))) + (assert "Can insert children around a node (unless it's root)." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (let [mid-val (|> zipper &;down &;value) + zipper (|> zipper + &;down + (&;insert-left pre-val) + (default (undefined)) + (&;insert-right post-val) + (default (undefined)) + &;up)] + (and (|> zipper &;down &;value (== pre-val)) + (|> zipper &;down &;right &;value (== mid-val)) + (|> zipper &;down &;right &;right &;value (== post-val)) + (|> zipper &;down &;rightmost &;leftmost &;value (== pre-val)) + (|> zipper &;down &;right &;left &;value (== mid-val)) + (|> zipper &;down &;rightmost &;value (== post-val)))) + (and (|> zipper (&;insert-left pre-val) (case> (#;Some _) false + #;None true)) + (|> zipper (&;insert-right post-val) (case> (#;Some _) false + #;None true)))))) + + (assert "Can set and update the value of a node." + (|> sample &;from-tree (&;set new-val) &;value (=+ new-val))) - (assert "Zipper traversal follows the outline of the tree depth-first." - (List/= (tree;flatten sample) - (loop [zipper (&;from-tree sample)] - (if (&;end? zipper) - (list) - (#;Cons (&;value zipper) - (recur (&;next zipper))))))) + (assert "Zipper traversal follows the outline of the tree depth-first." + (List/= (tree;flatten sample) + (loop [zipper (&;from-tree sample)] + (if (&;end? zipper) + (list) + (#;Cons (&;value zipper) + (recur (&;next zipper))))))) - (assert "Backwards zipper traversal yield reverse tree flatten." - (List/= (list;reverse (tree;flatten sample)) - (loop [zipper (to-end (&;from-tree sample))] - (if (&;root? zipper) - (list) - (#;Cons (&;value zipper) - (recur (&;prev zipper))))))) + (assert "Backwards zipper traversal yield reverse tree flatten." + (List/= (list;reverse (tree;flatten sample)) + (loop [zipper (to-end (&;from-tree sample))] + (if (&;root? zipper) + (list) + (#;Cons (&;value zipper) + (recur (&;prev zipper))))))) - (assert "Can remove nodes (except root nodes)." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (and (|> zipper &;down &;root? not) - (|> zipper &;down &;remove (case> #;None false - (#;Some node) (&;root? node)))) - (|> zipper &;remove (case> #;None true - (#;Some _) false))))) - )) + (assert "Can remove nodes (except root nodes)." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (and (|> zipper &;down &;root? not) + (|> zipper &;down &;remove (case> #;None false + (#;Some node) (&;root? node)))) + (|> zipper &;remove (case> #;None true + (#;Some _) false))))) + )) diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux index a23eeec00..049dff77c 100644 --- a/stdlib/test/test/lux/data/sum.lux +++ b/stdlib/test/test/lux/data/sum.lux @@ -9,24 +9,31 @@ (control monad) (data sum [text "Text/" Monoid<Text>] - [number]) - (codata function)) + [number] + (struct [list])) + (codata function) + pipe) lux/test) (test: "Sum operations" - (all (match (+0 1) (left 1)) - (match (+1 2) (right 2)) - (match (^ (list "0" "2")) - (lefts (: (List (| Text Text)) - (list (+0 "0") (+1 "1") (+0 "2"))))) - (match (^ (list "1")) - (rights (: (List (| Text Text)) - (list (+0 "0") (+1 "1") (+0 "2"))))) - (match (^ [(list "0" "2") (list "1")]) - (partition (: (List (| Text Text)) - (list (+0 "0") (+1 "1") (+0 "2"))))) - (match 10 - (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+0 "")))) - (match 20 - (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+1 "")))) - )) + (let [(^open "List/") (list;Eq<List> text;Eq<Text>)] + ($_ seq + (assert "Can inject values into Either." + (and (|> (left "Hello") (case> (+0 "Hello") true _ false)) + (|> (right "World") (case> (+1 "World") true _ false)))) + + (assert "Can discriminate eithers based on their cases." + (let [[_lefts _rights] (partition (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2"))))] + (and (List/= _lefts + (lefts (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2"))))) + + (List/= _rights + (rights (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2")))))))) + + (assert "Can apply a function to an Either value depending on the case." + (and (= 10 (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+0 "")))) + (= 20 (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+1 "")))))) + ))) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index 640ae3f4c..8b315c8b0 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -116,25 +116,29 @@ ))) (test: "Other text functions" - (all (match "abc" (&;lower-case "ABC")) - (match "ABC" (&;upper-case "abc")) - (match "ABC" (&;trim " \tABC\n\r")) - )) + (let [(^open "&/") &;Eq<Text>] + ($_ seq + (assert "Can transform texts in certain ways." + (and (&/= "abc" (&;lower-case "ABC")) + (&/= "ABC" (&;upper-case "abc")) + (&/= "ABC" (&;trim " \tABC\n\r")))) + ))) (test: "Structures" - (all (assert "" (:: &;Ord<Text> < "bcd" "abc")) - (assert "" (not (:: &;Ord<Text> < "abc" "abc"))) - (assert "" (not (:: &;Ord<Text> < "abc" "bcd"))) - (assert "" (:: &;Ord<Text> <= "bcd" "abc")) - (assert "" (:: &;Ord<Text> <= "abc" "abc")) - (assert "" (not (:: &;Ord<Text> <= "abc" "bcd"))) - (assert "" (:: &;Ord<Text> > "abc" "bcd")) - (assert "" (not (:: &;Ord<Text> > "abc" "abc"))) - (assert "" (not (:: &;Ord<Text> > "bcd" "abc"))) - (assert "" (:: &;Ord<Text> >= "abc" "bcd")) - (assert "" (:: &;Ord<Text> >= "abc" "abc")) - (assert "" (not (:: &;Ord<Text> >= "bcd" "abc"))) - )) + ($_ seq + (assert "" (:: &;Ord<Text> < "bcd" "abc")) + (assert "" (not (:: &;Ord<Text> < "abc" "abc"))) + (assert "" (not (:: &;Ord<Text> < "abc" "bcd"))) + (assert "" (:: &;Ord<Text> <= "bcd" "abc")) + (assert "" (:: &;Ord<Text> <= "abc" "abc")) + (assert "" (not (:: &;Ord<Text> <= "abc" "bcd"))) + (assert "" (:: &;Ord<Text> > "abc" "bcd")) + (assert "" (not (:: &;Ord<Text> > "abc" "abc"))) + (assert "" (not (:: &;Ord<Text> > "bcd" "abc"))) + (assert "" (:: &;Ord<Text> >= "abc" "bcd")) + (assert "" (:: &;Ord<Text> >= "abc" "abc")) + (assert "" (not (:: &;Ord<Text> >= "bcd" "abc"))) + )) (test: "Codec" [size bounded-size diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index cd15c8584..12516a9ca 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -8,15 +8,19 @@ (lux (codata [io]) (control monad) (data text/format + [text] [number]) (codata function)) lux/test) (test: "Formatters" - (all (match "true" (%b true)) - (match "123" (%i 123)) - (match "123.456" (%r 123.456)) - (match "#\"t\"" (%c #"t")) - (match "\"YOLO\"" (%t "YOLO")) - (match "User-id: 123 -- Active: true" (format "User-id: " (%i 123) " -- Active: " (%b true))) - )) + (let [(^open "&/") text;Eq<Text>] + ($_ seq + (assert "Can format common values simply." + (and (&/= "true" (%b true)) + (&/= "123" (%i 123)) + (&/= "123.456" (%r 123.456)) + (&/= "#\"t\"" (%c #"t")) + (&/= "\"YOLO\"" (%t "YOLO")) + (&/= "User-id: 123 -- Active: true" (format "User-id: " (%i 123) " -- Active: " (%b true))))) + ))) |