diff options
| -rw-r--r-- | stdlib/source/lux/control/thread.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/parser.lux | 331 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/thread.lux | 53 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/writer.lux | 10 |
5 files changed, 252 insertions, 161 deletions
diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux index 708f385a2..978d6a683 100644 --- a/stdlib/source/lux/control/thread.lux +++ b/stdlib/source/lux/control/thread.lux @@ -12,7 +12,7 @@ [platform [compiler ["." host]]] - [io (#+ IO)]]) + ["." io (#+ IO)]]) (type: #export (Thread ! a) (-> ! a)) @@ -47,6 +47,12 @@ a)) (thread [])) +(def: #export (io thread) + (All [a] + (-> (All [!] (Thread ! a)) + (IO a))) + (io.io (..run thread))) + (structure: #export functor (All [!] (Functor (Thread !))) @@ -83,10 +89,3 @@ [old (read box) _ (write (f old) box)] (wrap old))) - -(def: #export (io thread) - (All [a] - (-> (All [!] (Thread ! a)) - (IO a))) - (function (_ void) - (thread void))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index de2e00a31..97f8c8cf5 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -5,9 +5,11 @@ ["/." continuation] ["/." exception] ["/." interval] + ["/." parser] ["/." pipe] ["/." reader] ["/." state] + ["/." thread] ["/." writer]]) (def: #export test @@ -16,8 +18,10 @@ /continuation.test /exception.test /interval.test + /parser.test (<| (_.context "/pipe") /pipe.test) /reader.test /state.test + /thread.test /writer.test)) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index c9d568495..47740098d 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -1,31 +1,42 @@ (.module: [lux #* + ["_" test (#+ Test)] [control - ["M" monad (#+ do)] + [monad (#+ do)] [equivalence (#+ Equivalence)] - ["&" parser]] + {[0 #test] + [/ + [".T" functor (#+ Injection Comparison)] + [".T" apply] + [".T" monad]]}] [data - ["." error (#+ Error)]] + ["." error (#+ Error)] + [number + ["." nat]] + ["." text ("#/." equivalence) + format] + [collection + ["." list ("#/." functor)]]] [math ["r" random]] - ["." macro + [macro ["." code] - ["s" syntax (#+ syntax:)]]] - lux/test) + ["s" syntax (#+ Syntax syntax:)]]] + {1 + ["." / (#+ Parser)]}) -## [Utils] -(def: (should-fail input) - (All [a] (-> (Error a) Bit)) +(def: (should-fail expected input) + (All [a] (-> Text (Error a) Bit)) (case input - (#error.Failure _) - #1 + (#error.Failure actual) + (text/= expected actual) _ #0)) (def: (enforced? parser input) - (All [s] (-> (&.Parser s Any) s Bit)) - (case (&.run input parser) + (All [s] (-> (Parser s Any) s Bit)) + (case (/.run input parser) (#error.Success [_ []]) #1 @@ -33,8 +44,8 @@ #0)) (def: (found? parser input) - (All [s] (-> (&.Parser s Bit) s Bit)) - (case (&.run input parser) + (All [s] (-> (Parser s Bit) s Bit)) + (case (/.run input parser) (#error.Success [_ #1]) #1 @@ -50,128 +61,180 @@ _ #0)) -(syntax: (match pattern input) +(syntax: (match pattern then input) (wrap (list (` (case (~ input) (^ (#error.Success [(~' _) (~ pattern)])) - #1 + (~ then) (~' _) #0))))) -## [Tests] -(context: "Assertions" - (test "Can make assertions while parsing." - (and (match [] - (&.run (list (code.bit #1) (code.int +123)) - (&.assert "yolo" #1))) - (fails? (&.run (list (code.bit #1) (code.int +123)) - (&.assert "yolo" #0)))))) - -(context: "Combinators [Part 1]" - ($_ seq - (test "Can optionally succeed with some parser." - (and (match (#.Some 123) - (&.run (list (code.nat 123)) - (&.maybe s.nat))) - (match #.None - (&.run (list (code.int -123)) - (&.maybe s.nat))))) - - (test "Can apply a parser 0 or more times." - (and (match (list 123 456 789) - (&.run (list (code.nat 123) (code.nat 456) (code.nat 789)) - (&.some s.nat))) - (match (list) - (&.run (list (code.int -123)) - (&.some s.nat))))) - - (test "Can apply a parser 1 or more times." - (and (match (list 123 456 789) - (&.run (list (code.nat 123) (code.nat 456) (code.nat 789)) - (&.many s.nat))) - (match (list 123) - (&.run (list (code.nat 123)) - (&.many s.nat))) - (fails? (&.run (list (code.int -123)) - (&.many s.nat))))) - - (test "Can use either parser." - (let [positive (: (s.Syntax Int) - (do &.monad - [value s.int - _ (&.assert "" (i/> +0 value))] - (wrap value)))] - (and (match +123 - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.either positive s.int))) - (match -123 - (&.run (list (code.int -123) (code.int +456) (code.int +789)) - (&.either positive s.int))) - (fails? (&.run (list (code.bit #1) (code.int +456) (code.int +789)) - (&.either positive s.int)))))) - - (test "Can create the opposite/negation of any parser." - (and (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.not s.int))) - (match [] - (&.run (list (code.bit #1) (code.int +456) (code.int +789)) - (&.not s.int))))) - )) - -(context: "Combinators Part [2]" - ($_ seq - (test "Can fail at will." - (should-fail (&.run (list) - (&.fail "Well, it really SHOULD fail...")))) - - (test "Can apply a parser N times." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.exactly 3 s.int))) - (match (list +123 +456) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.exactly 2 s.int))) - (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.exactly 4 s.int))))) - - (test "Can apply a parser at-least N times." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-least 3 s.int))) - (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-least 2 s.int))) - (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-least 4 s.int))))) - - (test "Can apply a parser at-most N times." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-most 3 s.int))) - (match (list +123 +456) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-most 2 s.int))) - (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-most 4 s.int))))) - - (test "Can apply a parser between N and M times." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.between 3 10 s.int))) - (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.between 4 10 s.int))))) - - (test "Can parse while taking separators into account." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.text "YOLO") (code.int +456) (code.text "YOLO") (code.int +789)) - (&.sep-by (s.this (' "YOLO")) s.int))) - (match (list +123 +456) - (&.run (list (code.int +123) (code.text "YOLO") (code.int +456) (code.int +789)) - (&.sep-by (s.this (' "YOLO")) s.int))))) - - (test "Can obtain the whole of the remaining input." - (|> &.remaining - (&.run (list (code.int +123) (code.int +456) (code.int +789))) - (match (list [_ (#.Int +123)] [_ (#.Int +456)] [_ (#.Int +789)])))) - )) +(def: combinators-0 + Test + (do r.monad + [expected0 r.nat + variadic (:: @ map (|>> (n/max 1) (n/min 20)) r.nat) + expected+ (r.list variadic r.nat) + even0 (r.filter n/even? r.nat) + odd0 (r.filter n/odd? r.nat) + not0 r.bit] + ($_ _.and + (_.test "Can optionally succeed with some parser." + (and (|> (/.maybe s.nat) + (/.run (list (code.nat expected0))) + (match (#.Some actual) + (n/= expected0 actual))) + (|> (/.maybe s.nat) + (/.run (list (code.int (.int expected0)))) + (match #.None + #1)))) + (_.test "Can apply a parser 0 or more times." + (and (|> (/.some s.nat) + (/.run (list/map code.nat expected+)) + (match actual + (:: (list.equivalence nat.equivalence) = expected+ actual))) + (|> (/.some s.nat) + (/.run (list/map (|>> .int code.int) expected+)) + (match #.Nil + #1)))) + (_.test "Can apply a parser 1 or more times." + (and (|> (/.many s.nat) + (/.run (list/map code.nat expected+)) + (match actual + (:: (list.equivalence nat.equivalence) = expected+ actual))) + (|> (/.many s.nat) + (/.run (list (code.nat expected0))) + (match (list actual) + (n/= expected0 actual))) + (|> (/.many s.nat) + (/.run (list/map (|>> .int code.int) expected+)) + fails?))) + (_.test "Can use either parser." + (let [even (/.filter n/even? s.nat) + odd (/.filter n/odd? s.nat)] + (and (|> (/.either even odd) + (/.run (list (code.nat even0))) + (match actual (n/= even0 actual))) + (|> (/.either even odd) + (/.run (list (code.nat odd0))) + (match actual (n/= odd0 actual))) + (|> (/.either even odd) + (/.run (list (code.bit not0))) + fails?)))) + (_.test "Can create the opposite/negation of any parser." + (and (|> (/.not s.nat) + (/.run (list (code.nat expected0))) + fails?) + (|> (/.not s.nat) + (/.run (list (code.bit not0))) + (match [] #1)))) + ))) + +(def: combinators-1 + Test + (do r.monad + [failure (r.ascii 1) + variadic (:: @ map (|>> (n/max 1) (n/min 20)) r.nat) + times (:: @ map (n/% variadic) r.nat) + expected+ (r.list variadic r.nat) + separator (r.ascii 1)] + ($_ _.and + (_.test "Can fail at will." + (|> (/.fail failure) + (/.run (list)) + (should-fail failure))) + (_.test "Can apply a parser N times." + (and (|> (/.exactly times s.nat) + (/.run (list/map code.nat expected+)) + (match actual + (:: (list.equivalence nat.equivalence) = + (list.take times expected+) + actual))) + (|> (/.exactly (inc variadic) s.nat) + (/.run (list/map code.nat expected+)) + fails?))) + (_.test "Can apply a parser at-least N times." + (and (|> (/.at-least times s.nat) + (/.run (list/map code.nat expected+)) + (match actual + (:: (list.equivalence nat.equivalence) = + expected+ + actual))) + (|> (/.at-least (inc variadic) s.nat) + (/.run (list/map code.nat expected+)) + fails?))) + (_.test "Can apply a parser at-most N times." + (and (|> (/.at-most times s.nat) + (/.run (list/map code.nat expected+)) + (match actual + (:: (list.equivalence nat.equivalence) = + (list.take times expected+) + actual))) + (|> (/.at-most (inc variadic) s.nat) + (/.run (list/map code.nat expected+)) + (match actual + (:: (list.equivalence nat.equivalence) = + expected+ + actual))))) + (_.test "Can apply a parser between N and M times." + (and (|> (/.between times variadic s.nat) + (/.run (list/map code.nat expected+)) + (match actual + (:: (list.equivalence nat.equivalence) = + expected+ + actual))) + (|> (/.between times variadic s.nat) + (/.run (list/map code.nat (list.take times expected+))) + (match actual + (:: (list.equivalence nat.equivalence) = + (list.take times expected+) + actual))))) + (_.test "Can parse while taking separators into account." + (|> (/.sep-by (s.this (code.text separator)) s.nat) + (/.run (list.interpose (code.text separator) (list/map code.nat expected+))) + (match actual + (:: (list.equivalence nat.equivalence) = + expected+ + actual)))) + (_.test "Can obtain the whole of the remaining input." + (|> /.remaining + (/.run (list/map code.nat expected+)) + (match actual + (:: (list.equivalence code.equivalence) = + (list/map code.nat expected+) + actual)))) + ))) + +(def: (injection value) + (Injection (All [a i] (Parser i a))) + (:: /.monad wrap value)) + +(def: comparison + (Comparison (All [a i] (Parser i a))) + (function (_ == left right) + (case [(/.run [] left) (/.run [] right)] + [(#error.Success [_ left]) (#error.Success [_ right])] + (== left right) + + _ + false))) + +(def: #export test + Test + (do r.monad + [assertion (r.ascii 1)] + (<| (_.context (%name (name-of /.Parser))) + ($_ _.and + (_.test "Can make assertions while parsing." + (and (|> (/.assert assertion #1) + (/.run (list (code.bit #1) (code.int +123))) + (match [] #1)) + (|> (/.assert assertion #0) + (/.run (list (code.bit #1) (code.int +123))) + fails?))) + ..combinators-0 + ..combinators-1 + (functorT.laws ..injection ..comparison /.functor) + (applyT.laws ..injection ..comparison /.apply) + (monadT.laws ..injection ..comparison /.monad) + )))) diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index 8f31addbb..61b7524cc 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -1,21 +1,44 @@ (.module: [lux #* + ["_" test (#+ Test)] [control [monad (#+ do)] - ["/" thread]]]) + {[0 #test] + [/ + [".T" functor (#+ Injection Comparison)] + [".T" apply] + [".T" monad]]}] + [data + [text + format]] + [math + ["r" random]]] + {1 + ["." / (#+ Thread)]}) -(def: _test0_ - Nat - (/.run (do /.monad - [box (/.box 123) - old (/.update (n/* 2) box) - new (/.read box)] - (wrap (n/+ old new))))) +(def: (injection value) + (Injection (All [a !] (Thread ! a))) + (:: /.monad wrap value)) -(def: _test1_ - (All [!] (/.Thread ! Nat)) - (do /.monad - [box (/.box 123) - old (/.update (n/* 2) box) - new (/.read box)] - (wrap (n/+ old new)))) +(def: comparison + (Comparison (All [a !] (Thread ! a))) + (function (_ == left right) + (== (/.run left) (/.run right)))) + +(def: #export test + Test + (do r.monad + [original r.nat + factor r.nat] + (<| (_.context (%name (name-of /.Thread))) + ($_ _.and + (functorT.laws ..injection ..comparison /.functor) + (applyT.laws ..injection ..comparison /.apply) + (monadT.laws ..injection ..comparison /.monad) + (_.test "Can safely do mutation." + (n/= (n/* factor original) + (/.run (: (All [!] (Thread ! Nat)) + (do /.monad + [box (/.box original) + old (/.update (n/* factor) box)] + (/.read box)))))))))) diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index 12670c58e..87d2de77a 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -32,7 +32,9 @@ (def: #export test Test (do r.monad - [log (r.ascii 1)] + [log (r.ascii 1) + left r.nat + right r.nat] (<| (_.context (%name (name-of /.Writer))) ($_ _.and (_.test "Can write any value." @@ -47,9 +49,9 @@ (^open "io/.") io.monad] (_.test "Can add writer functionality to any monad." (|> (io.run (do (/.with-writer text.monoid io.monad) - [a (lift (io/wrap 123)) - b (wrap 456)] + [a (lift (io/wrap left)) + b (wrap right)] (wrap (n/+ a b)))) product.right - (n/= 579)))) + (n/= (n/+ left right))))) )))) |