diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/aedifex.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/cli.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/clean.lux | 118 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract/comonad/cofree.lux | 51 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/parser/code.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/collection.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/collection/dictionary/plist.lux | 91 |
8 files changed, 281 insertions, 6 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index ed32b969c..a4fd15bec 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -9,6 +9,7 @@ ["#." artifact] ["#." input] ["#." command #_ + ["#/." clean] ["#/." pom] ["#/." install]] ["#." local] @@ -27,6 +28,7 @@ ($_ _.and /artifact.test /input.test + /command/clean.test /command/pom.test /command/install.test /local.test diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux index dfbf0b7a9..0dde0402a 100644 --- a/stdlib/source/test/aedifex/cli.lux +++ b/stdlib/source/test/aedifex/cli.lux @@ -29,6 +29,8 @@ (def: command (Random /.Command) ($_ random.or + ## #Clean + (random@wrap []) ## #POM (random@wrap []) ## #Dependencies @@ -54,6 +56,7 @@ (def: (format value) (-> /.Command (List Text)) (case value + #/.Clean (list "clean") #/.POM (list "pom") #/.Dependencies (list "deps") #/.Install (list "install") diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux new file mode 100644 index 000000000..73207fa14 --- /dev/null +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -0,0 +1,118 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + [binary (#+ Binary)] + ["." product] + ["." text + ["%" format (#+ format)]] + [number + ["n" nat]] + [collection + ["." list ("#@." functor)] + ["." set]]] + [math + ["." random (#+ Random)]] + [world + ["." file (#+ Path File)]]] + [/// + ["@." profile] + [// + [lux + [data + ["_." binary]]]]] + {#program + ["." / + ["//#" /// #_ + ["#" profile] + ["#." action (#+ Action)]]]}) + +(def: node-name + (Random Text) + (random.ascii/alpha 10)) + +(def: (files prefix) + (-> Path (Random (List [Path Binary]))) + (do {! random.monad} + [count (:: ! map (n.% 10) random.nat) + names (random.set text.hash count ..node-name) + contents (random.list count (_binary.random 100))] + (wrap (list.zip/2 (list@map (|>> (format prefix)) (set.to-list names)) + contents)))) + +(def: (create-file! fs [path content]) + (-> (file.System Promise) [Path Binary] (Promise (Try Any))) + (do {! (try.with promise.monad)} + [file (: (Promise (Try (File Promise))) + (file.get-file promise.monad fs path))] + (!.use (:: file over-write) content))) + +(def: (create-directory! fs path files) + (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any))) + (do {! (try.with promise.monad)} + [_ (: (Promise (Try Path)) + (file.make-directories promise.monad fs path)) + _ (monad.map ! (..create-file! fs) files)] + (wrap []))) + +(def: (directory-exists? fs) + (-> (file.System Promise) Path (Promise (Try Bit))) + (|>> (file.directory-exists? promise.monad fs) (try.lift promise.monad))) + +(def: (file-exists? fs) + (-> (file.System Promise) Path (Promise (Try Bit))) + (|>> (file.file-exists? promise.monad fs) (try.lift promise.monad))) + +(def: (assets-exist? fs directory-path files) + (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Bit))) + (do {! (try.with promise.monad)} + [directory-exists? (..directory-exists? fs directory-path) + files-exist? (: (Action (List Bit)) + (|> files + (list@map product.left) + (monad.map ///action.monad (..file-exists? fs))))] + (wrap (and directory-exists? + (list.every? (|>>) files-exist?))))) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [context ..node-name + target ..node-name + sub ..node-name + #let [fs (file.mock (:: file.default separator)) + / (:: fs separator) + target-path (format context / target) + sub-path (format target-path / sub)] + direct-files (..files (format target-path /)) + sub-files (..files (format sub-path /)) + + dummy @profile.random] + (wrap (do promise.monad + [verdict (do {! (try.with promise.monad)} + [_ (..create-directory! fs target-path direct-files) + _ (..create-directory! fs sub-path sub-files) + context-exists!/pre (..directory-exists? fs context) + target-exists!/pre (..assets-exist? fs target-path direct-files) + sub-exists!/pre (..assets-exist? fs sub-path sub-files) + _ (/.do! fs (set@ #///.target (#.Some target-path) dummy)) + context-exists!/post (..directory-exists? fs context) + target-exists!/post (..assets-exist? fs target-path direct-files) + sub-exists!/post (..assets-exist? fs sub-path sub-files)] + (wrap (and (and context-exists!/pre + context-exists!/post) + (and target-exists!/pre + (not target-exists!/post)) + (and sub-exists!/pre + (not sub-exists!/post)))))] + (_.claim [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index d99d3c063..9fd3986b8 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -4,7 +4,8 @@ ["." / #_ ["#." apply] ["#." codec] - ["#." comonad] + ["#." comonad + ["#/." cofree]] ["#." enum] ["#." equivalence] ["#." fold] @@ -31,19 +32,26 @@ /monad/free.test )) +(def: comonad + Test + ($_ _.and + /comonad.test + /comonad/cofree.test + )) + (def: #export test Test ($_ _.and /apply.test /codec.test - /comonad.test /enum.test /equivalence.test /fold.test - ..functor /interval.test - ..monad /monoid.test /order.test /predicate.test + ..functor + ..monad + ..comonad )) diff --git a/stdlib/source/test/lux/abstract/comonad/cofree.lux b/stdlib/source/test/lux/abstract/comonad/cofree.lux new file mode 100644 index 000000000..6cf767e65 --- /dev/null +++ b/stdlib/source/test/lux/abstract/comonad/cofree.lux @@ -0,0 +1,51 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [functor (#+ Functor)] + [comonad (#+ CoMonad)] + {[0 #spec] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." comonad]]}] + [control + ["//" continuation]] + [data + [collection + ["." list] + ["." sequence (#+ Sequence) ("#@." comonad)]]] + [math + ["." random]]] + {1 + ["." /]}) + +(def: (injection value) + (Injection (/.CoFree Sequence)) + [value (sequence@map injection (sequence.repeat value))]) + +(def: (interpret [head tail]) + (All [a] (-> (/.CoFree Sequence a) (Sequence a))) + (|> tail + (sequence@map (:: (/.comonad sequence.functor) unwrap)) + [head] + //.pending)) + +(def: comparison + (Comparison (/.CoFree Sequence)) + (function (_ == left right) + (:: (list.equivalence ==) = + (sequence.take 100 (..interpret left)) + (sequence.take 100 (..interpret right))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.CoFree]) + ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison (: (Functor (/.CoFree Sequence)) + (/.functor sequence.functor)))) + (_.with-cover [/.comonad] + ($comonad.spec ..injection ..comparison (: (CoMonad (/.CoFree Sequence)) + (/.comonad sequence.functor)))) + ))) diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux index de2601c45..a4f25df4d 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -71,7 +71,7 @@ [/.nat /.nat! random.nat code.nat nat.equivalence] [/.int /.int! random.int code.int int.equivalence] [/.rev /.rev! random.rev code.rev rev.equivalence] - [/.frac /.frac! random.frac code.frac frac.equivalence] + [/.frac /.frac! random.safe-frac code.frac frac.equivalence] [/.text /.text! (random.unicode 1) code.text text.equivalence] [/.identifier /.identifier! ..random-name code.identifier name.equivalence] [/.tag /.tag! ..random-name code.tag name.equivalence] diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index 0d6cb1e64..82643dfde 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -9,7 +9,8 @@ ["#." sequence] ["#." stack] ["#." dictionary - ["#/." ordered]] + ["#/." ordered] + ["#/." plist]] ["#." queue ["#/." priority]] ["#." set @@ -22,6 +23,7 @@ ($_ _.and /dictionary.test /dictionary/ordered.test + /dictionary/plist.test )) (def: queue diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux new file mode 100644 index 000000000..cac27e0cf --- /dev/null +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -0,0 +1,91 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [data + ["." bit ("#@." equivalence)] + ["." maybe ("#@." monad)] + ["." text] + [number + ["n" nat]] + [collection + ["." set] + ["." list]]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(def: #export (random size gen-key gen-value) + (All [v] + (-> Nat (Random Text) (Random v) (Random (/.PList v)))) + (do random.monad + [keys (random.set text.hash size gen-key) + values (random.list size gen-value)] + (wrap (list.zip/2 (set.to-list keys) values)))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.PList]) + (do {! random.monad} + [#let [gen-key (random.ascii/alpha 10)] + size (:: ! map (n.% 100) random.nat) + sample (..random size gen-key random.nat) + + #let [keys (|> sample /.keys (set.from-list text.hash))] + extra-key (random.filter (|>> (set.member? keys) not) + gen-key) + extra-value random.nat + shift random.nat] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) + (..random size gen-key random.nat))) + + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit@= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.keys /.values] + (:: (/.equivalence n.equivalence) = + sample + (list.zip/2 (/.keys sample) + (/.values sample)))) + (_.cover [/.contains?] + (and (list.every? (function (_ key) + (/.contains? key sample)) + (/.keys sample)) + (not (/.contains? extra-key sample)))) + (_.cover [/.put] + (let [sample+ (/.put extra-key extra-value sample)] + (and (not (/.contains? extra-key sample)) + (/.contains? extra-key sample+) + (n.= (inc (/.size sample)) + (/.size sample+))))) + (_.cover [/.get] + (|> sample + (/.put extra-key extra-value) + (/.get extra-key) + (maybe@map (n.= extra-value)) + (maybe.default false))) + (_.cover [/.update] + (|> sample + (/.put extra-key extra-value) + (/.update extra-key (n.+ shift)) + (/.get extra-key) + (maybe@map (n.= (n.+ shift extra-value))) + (maybe.default false))) + (_.cover [/.remove] + (|> sample + (/.put extra-key extra-value) + (/.remove extra-key) + (:: (/.equivalence n.equivalence) = sample))) + )))) |