diff options
Diffstat (limited to 'stdlib/source')
21 files changed, 456 insertions, 141 deletions
diff --git a/stdlib/source/lux/data/collection/set/ordered.lux b/stdlib/source/lux/data/collection/set/ordered.lux index 8cafd922e..9884a5860 100644 --- a/stdlib/source/lux/data/collection/set/ordered.lux +++ b/stdlib/source/lux/data/collection/set/ordered.lux @@ -22,22 +22,18 @@ (All [a] (-> (Set a) a Bit)) (|> set :representation (/.contains? elem))) - (template [<name> <alias>] + (template [<type> <name> <alias>] [(def: #export <name> - (All [a] (-> (Set a) (Maybe a))) + (All [a] (-> (Set a) <type>)) (|>> :representation <alias>))] - [min /.min] - [max /.max] - ) + [(Maybe a) min /.min] + [(Maybe a) max /.max] - (template [<name> <alias>] - [(def: #export <name> - (-> (Set Any) Nat) - (|>> :representation <alias>))] + [Nat size /.size] + [Nat depth /.depth] - [size /.size] - [depth /.depth] + [Bit empty? /.empty?] ) (def: #export (add elem set) @@ -72,7 +68,9 @@ (list.filter (|>> (..member? param) not)) (..from-list (get@ #/.&order (:representation subject))))) - (structure: #export equivalence (All [a] (Equivalence (Set a))) + (structure: #export equivalence + (All [a] (Equivalence (Set a))) + (def: (= reference sample) (:: (list.equivalence (:: (:representation reference) &equivalence)) = (..to-list reference) (..to-list sample)))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 8adc4321b..6488be2be 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -3,22 +3,35 @@ [abstract ["." monad (#+ do)]] [control + ["." try] ["<>" parser - ["</>" code]]] + ["</>" code (#+ Parser)]]] [data ["." maybe] + ["." text ("#@." monoid)] [number ["." nat] ["." int] ["." rev] ["." frac]] - ["." text ("#@." monoid)] [collection ["." list ("#@." functor)]]] ["." meta (#+ with-gensyms)]] [// ["." code]]) +(def: (self-documenting binding parser) + (All [a] (-> Code (Parser a) (Parser a))) + (function (_ tokens) + (case (parser tokens) + (#try.Success [tokens output]) + (#try.Success [tokens output]) + + (#try.Failure error) + (#try.Failure ($_ text@compose + "Failed to parse: " (code.format binding) text.new-line + error))))) + (def: (join-pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs @@ -71,10 +84,19 @@ (function (_ arg) (case arg (^ [_ (#.Record (list [var parser]))]) - (wrap [var parser]) + (case var + [_ (#.Tag ["" "let"])] + (wrap [var parser]) + + _ + (wrap [var + (` ((~! ..self-documenting) (' (~ var)) + (~ parser)))])) [_ (#.Identifier var-name)] - (wrap [(code.identifier var-name) (` (~! </>.any))]) + (wrap [arg + (` ((~! ..self-documenting) (' (~ arg)) + (~! </>.any)))]) _ (meta.fail "Syntax pattern expects records or identifiers.")))) @@ -96,7 +118,7 @@ ((~! </>.run) (: ((~! </>.Parser) (Meta (List Code))) ((~! do) (~! <>.monad) - [(~+ (join-pairs vars+parsers))] + [(~+ (..join-pairs vars+parsers))] ((~' wrap) (~ body)))) (~ g!tokens))))))))) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index 9d73f9181..efc261189 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -8,7 +8,7 @@ [data ["." text]]] [// - [upload (#+ User Password)] + [repository (#+ User Password)] ["/" profile (#+ Name)]]) (type: #export Compilation diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 3041c53f1..aa48946bf 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -25,18 +25,19 @@ ["." export]]] ["." /// #_ ["/" profile (#+ Profile)] - ["//" upload (#+ User Password)] + ["//" upload] ["#." action (#+ Action)] ["#." command (#+ Command)] ["#." pom] ["#." hash] + ["#." repository (#+ User Password)] ["#." artifact ["#/." type]] ["#." dependency ["#/." resolution]]]) (exception: #export (cannot-find-repository {repository Text} - {options (Dictionary Text ///dependency.Repository)}) + {options (Dictionary Text ///repository.Address)}) (exception.report ["Repository" (%.text repository)] ["Options" (exception.enumerate (function (_ [name repo]) diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux index cdd0789ff..629618620 100644 --- a/stdlib/source/program/aedifex/dependency.lux +++ b/stdlib/source/program/aedifex/dependency.lux @@ -11,9 +11,6 @@ ["#." artifact (#+ Artifact) [type (#+ Type)]]]) -(type: #export Repository - URL) - (type: #export Dependency {#artifact Artifact #type Type}) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 10874cbfc..2c6a9b5e6 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -29,9 +29,10 @@ [world [net (#+ URL) ["." uri]]]] - ["." // (#+ Repository Dependency) + ["." // (#+ Dependency) ["/#" // #_ ["/" profile] + ["#." repository (#+ Address)] ["#." hash] ["#." pom] ["#." package (#+ Package)] @@ -109,7 +110,7 @@ (wrap actual))))) (def: #export (resolve repository dependency) - (-> Repository Dependency (IO (Try Package))) + (-> Address Dependency (IO (Try Package))) (let [[artifact type] dependency prefix (format repository uri.separator (///artifact.uri artifact))] (do (try.with io.monad) @@ -146,7 +147,7 @@ ["Type" (%.text type)]))) (def: (resolve-any repositories dependency) - (-> (List Repository) Dependency (IO (Try Package))) + (-> (List Address) Dependency (IO (Try Package))) (case repositories #.Nil (|> dependency @@ -164,7 +165,7 @@ (resolve-any alternatives dependency))))) (def: #export (resolve-all repositories dependencies resolution) - (-> (List Repository) (List Dependency) Resolution (IO (Try Resolution))) + (-> (List Address) (List Dependency) Resolution (IO (Try Resolution))) (case dependencies #.Nil (:: (try.with io.monad) wrap resolution) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 4fa6612c0..45e1e6a6a 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -21,6 +21,7 @@ ["/" profile] ["#." project (#+ Project)] ["#." dependency] + ["#." repository] ["#." artifact (#+ Artifact) ["#/." type]]]) @@ -136,7 +137,7 @@ ))) (def: repository - (Parser //dependency.Repository) + (Parser //repository.Address) ..url) (def: type @@ -164,7 +165,7 @@ <c>.text) (def: deploy-repository - (Parser (List [Text //dependency.Repository])) + (Parser (List [Text //repository.Address])) (<c>.record (<>.some (<>.and <c>.text ..repository)))) @@ -185,7 +186,7 @@ ^info (: (Parser (Maybe /.Info)) (<>.maybe (..singular input "info" ..info))) - ^repositories (: (Parser (Set //dependency.Repository)) + ^repositories (: (Parser (Set //repository.Address)) (|> (..plural input "repositories" ..repository) (:: ! map (set.from-list text.hash)) (<>.default (set.new text.hash)))) @@ -206,7 +207,7 @@ ^test (: (Parser (Maybe Module)) (<>.maybe (..singular input "test" ..module))) - ^deploy-repositories (: (Parser (Dictionary Text //dependency.Repository)) + ^deploy-repositories (: (Parser (Dictionary Text //repository.Address)) (<| (:: ! map (dictionary.from-list text.hash)) (<>.default (list)) (..singular input "deploy-repositories" ..deploy-repository)))]] diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index 259a3f769..a310b2c48 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -19,7 +19,8 @@ ["." dictionary]]]] ["." // #_ ["/" profile] - ["#." dependency (#+ Repository Dependency)] + ["#." repository (#+ Address)] + ["#." dependency (#+ Dependency)] ["#." artifact (#+ Artifact) ["#/." type]]]) @@ -65,7 +66,7 @@ (#_.Node ["" "license"] _.attrs))) (def: repository - (-> Repository XML) + (-> Address XML) (|>> (..property "url") list (#_.Node ["" "repository"] _.attrs))) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index 190ed3714..8b5ea26b6 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -22,7 +22,8 @@ [descriptor (#+ Module)]]]]]] [// ["." artifact (#+ Artifact)] - ["." dependency]]) + ["." dependency] + ["." repository]]) (type: #export Distribution #Repo @@ -140,13 +141,13 @@ {#parents (List Name) #identity (Maybe Artifact) #info (Maybe Info) - #repositories (Set dependency.Repository) + #repositories (Set repository.Address) #dependencies (Set dependency.Dependency) #sources (Set Source) #target (Maybe Target) #program (Maybe Module) #test (Maybe Module) - #deploy-repositories (Dictionary Text dependency.Repository)}) + #deploy-repositories (Dictionary Text repository.Address)}) (def: #export equivalence (Equivalence Profile) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux new file mode 100644 index 000000000..f92b1e5b9 --- /dev/null +++ b/stdlib/source/program/aedifex/repository.lux @@ -0,0 +1,85 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)] + ["." stm]]] + [data + [binary (#+ Binary)]] + [world + [net (#+ URL)]]] + ["." // #_ + ["#." artifact (#+ Artifact) + ["#/." extension (#+ Extension)]]]) + +(type: #export Address + URL) + +(type: #export User + Text) + +(type: #export Password + Text) + +(type: #export Identity + {#user User + #password Password}) + +(signature: #export (Repository !) + (: (-> Artifact Extension (! (Try Binary))) + download) + (: (-> Identity Artifact Extension Binary (! (Try Any))) + upload)) + +(def: #export (async repository) + (-> (Repository IO) (Repository Promise)) + (structure + (def: (download artifact extension) + (promise.future (:: repository download artifact extension))) + + (def: (upload identity artifact extension content) + (promise.future (:: repository upload identity artifact extension content))) + )) + +(signature: #export (Simulation s) + (: (-> Artifact Extension s + (Try [s Binary])) + on-download) + (: (-> Identity Artifact Extension Binary s + (Try s)) + on-upload)) + +(def: #export (mock simulation init) + (All [s] (-> (Simulation s) s (Repository Promise))) + (let [state (stm.var init)] + (structure + (def: (download artifact extension) + (stm.commit + (do {! stm.monad} + [|state| (stm.read state)] + (case (:: simulation on-download artifact extension |state|) + (#try.Success [|state| output]) + (do ! + [_ (stm.write |state| state)] + (wrap (#try.Success output))) + + (#try.Failure error) + (wrap (#try.Failure error)))))) + + (def: (upload identity artifact extension content) + (stm.commit + (do {! stm.monad} + [|state| (stm.read state)] + (case (:: simulation on-upload identity artifact extension content |state|) + (#try.Success |state|) + (do ! + [_ (stm.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error)))))) + ))) diff --git a/stdlib/source/program/aedifex/upload.lux b/stdlib/source/program/aedifex/upload.lux index f5834fa61..391413f03 100644 --- a/stdlib/source/program/aedifex/upload.lux +++ b/stdlib/source/program/aedifex/upload.lux @@ -18,7 +18,8 @@ [net (#+ URL) ["." uri]]]] ["." // #_ - ["#." dependency (#+ Repository Dependency)] + ["#." repository (#+ Address User Password)] + ["#." dependency (#+ Dependency)] ["#." artifact]]) (type: #export (Action a) @@ -28,14 +29,8 @@ (:coerce (Monad Action) (try.with io.monad))) -(type: #export User - Text) - -(type: #export Password - Text) - (def: (url repository dependency) - (-> Repository Dependency URL) + (-> Address Dependency URL) (format repository uri.separator (//artifact.uri (get@ #//dependency.artifact dependency)) @@ -80,7 +75,7 @@ (java/util/Base64::getEncoder)))) (def: #export (upload repository user password dependency content) - (-> Repository User Password Dependency Binary + (-> Address User Password Dependency Binary (Action Any)) (do {! ..monad} [connection (|> (..url repository dependency) diff --git a/stdlib/source/spec/aedifex/repository.lux b/stdlib/source/spec/aedifex/repository.lux new file mode 100644 index 000000000..613bbd407 --- /dev/null +++ b/stdlib/source/spec/aedifex/repository.lux @@ -0,0 +1,49 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." binary + {[0 #test] + ["_#" /]}]] + [math + ["." random]]] + {#program + ["." / + ["/#" // #_ + ["#." artifact (#+ Artifact) + ["#/." extension]]]]} + {#test + ["_." // #_ + ["#." artifact]]}) + +(def: #export (spec valid-identity valid-artifact invalid-identity invalid-artifact subject) + (-> /.Identity Artifact /.Identity Artifact (/.Repository Promise) Test) + (do random.monad + [expected (_binary.random 100)] + (wrap ($_ _.and' + (do promise.monad + [upload!/good (:: subject upload valid-identity valid-artifact //artifact/extension.lux-library expected) + download!/good (:: subject download valid-artifact //artifact/extension.lux-library) + + upload!/bad (:: subject upload invalid-identity invalid-artifact //artifact/extension.lux-library expected) + download!/bad (:: subject download invalid-artifact //artifact/extension.lux-library)] + (_.claim [/.Repository] + (and (case [upload!/good download!/good] + [(#try.Success _) (#try.Success actual)] + (:: binary.equivalence = expected actual) + + _ + false) + (case [upload!/bad download!/bad] + [(#try.Failure _) (#try.Failure _)] + true + + _ + false)))) + )))) diff --git a/stdlib/source/spec/lux/world/console.lux b/stdlib/source/spec/lux/world/console.lux index b9e1c0720..93d2c7417 100644 --- a/stdlib/source/spec/lux/world/console.lux +++ b/stdlib/source/spec/lux/world/console.lux @@ -4,6 +4,7 @@ [abstract [monad (#+ do)]] [control + [io (#+ IO)] ["." try] [security ["!" capability]] @@ -15,12 +16,13 @@ ["." /]}) (def: #export (spec console) - (-> (/.Console Promise) Test) + (-> (IO (/.Console Promise)) Test) (<| (_.with-cover [/.Console]) (do {! random.monad} [message (random.ascii/alpha 10)] (wrap (do promise.monad - [?read (!.use (:: console read) []) + [console (promise.future console) + ?read (!.use (:: console read) []) ?read-line (!.use (:: console read-line) []) ?write (!.use (:: console write) [message]) ?close/good (!.use (:: console close) []) @@ -30,7 +32,7 @@ (case [?read ?read-line] [(#try.Success _) (#try.Success _)] true - + _ false)) (_.claim [/.Can-Write] @@ -46,4 +48,5 @@ true _ - false)))))))) + false)) + )))))) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index a4fd15bec..c9994aafa 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -21,7 +21,8 @@ ["#." cli] ["#." hash] ["#." parser] - ["#." pom]]) + ["#." pom] + ["#." repository]]) (def: test Test @@ -41,6 +42,7 @@ /hash.test /parser.test /pom.test + /repository.test )) (program: args diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux index 0dde0402a..1edfb381f 100644 --- a/stdlib/source/test/aedifex/cli.lux +++ b/stdlib/source/test/aedifex/cli.lux @@ -18,8 +18,8 @@ {#program ["." / ["/#" // #_ - ["#" profile] - [upload (#+ User Password)]]]}) + [repository (#+ User Password)] + ["#" profile]]]}) (def: compilation (Random /.Compilation) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index e26240562..12fa349bb 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -29,7 +29,7 @@ ["#" profile] ["#." project (#+ Project)] ["#." artifact (#+ Artifact)] - ["#." dependency (#+ Repository Dependency)] + ["#." dependency (#+ Dependency)] ["#." format]]]}) (def: name diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index d0da1ff2a..10d921f94 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -28,7 +28,8 @@ {#program ["." / ["/#" // #_ - ["#." dependency (#+ Repository Dependency)] + [repository (#+ Address)] + ["#." dependency (#+ Dependency)] ["#." format]]]}) (def: distribution @@ -103,7 +104,7 @@ (random.ascii/alpha 1)) (def: repository - (Random Repository) + (Random Address) (random.ascii/alpha 1)) (def: source diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux new file mode 100644 index 000000000..4f96d9329 --- /dev/null +++ b/stdlib/source/test/aedifex/repository.lux @@ -0,0 +1,93 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + ["." hash (#+ Hash)] + ["." equivalence (#+ Equivalence)] + ["." monad (#+ do)]] + [control + ["." io] + ["." try] + ["." exception (#+ exception:)]] + [data + ["." binary (#+ Binary)] + ["." text + ["%" format (#+ format)]] + [collection + ["." dictionary (#+ Dictionary)]]] + [math + ["." random (#+ Random)]]] + [// + ["@." artifact]] + {#spec + ["$." /]} + {#program + ["." / (#+ Identity) + ["/#" // #_ + ["#." artifact (#+ Version Artifact) + ["#/." extension (#+ Extension)]]]]}) + +(def: identity + (Random Identity) + (random.and (random.ascii/alpha 10) + (random.ascii/alpha 10))) + +(def: identity-equivalence + (Equivalence Identity) + (equivalence.product text.equivalence + text.equivalence)) + +(def: artifact + (-> Version Artifact) + (|>> ["com.github.luxlang" "test-artifact"])) + +(def: item-hash + (Hash [Artifact Extension]) + (hash.product //artifact.hash + text.hash)) + +(exception: (not-found {artifact Artifact} + {extension Extension}) + (exception.report + ["Artifact" (//artifact.format artifact)] + ["Extension" (%.text extension)])) + +(exception: (invalid-identity {[user _] Identity}) + (exception.report + ["User" (%.text user)])) + +(type: Store + (Dictionary [Artifact Extension] Binary)) + +(def: empty + Store + (dictionary.new ..item-hash)) + +(structure: (simulation identity) + (-> Identity (/.Simulation Store)) + + (def: (on-download artifact extension state) + (case (dictionary.get [artifact extension] state) + (#.Some content) + (exception.return [state content]) + + #.None + (exception.throw ..not-found [artifact extension]))) + (def: (on-upload requester artifact extension content state) + (if (:: identity-equivalence = identity requester) + (exception.return (dictionary.put [artifact extension] content state)) + (exception.throw ..invalid-identity [requester])))) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [valid ..identity + invalid (random.filter (|>> (:: identity-equivalence = valid) not) + ..identity)] + ($_ _.and + (_.with-cover [/.mock /.Simulation] + ($/.spec valid (..artifact "1.2.3-YES") + invalid (..artifact "4.5.6-NO") + (/.mock (..simulation valid) ..empty))) + )))) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 335eb0226..7257a7f7b 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -9,105 +8,170 @@ [/ ["$." equivalence]]}] [data + ["." bit ("#@." equivalence)] [number ["n" nat]] [collection ["." list]]] [math - ["r" random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random) ("#@." monad)]]] {1 ["." / (#+ Set) ["." //]]}) -(def: gen-nat - (r.Random Nat) - (|> r.nat - (:: r.monad map (n.% 100)))) +(def: size + (random.Random Nat) + (:: random.monad map (n.% 100) random.nat)) -(def: #export (set &order gen-value size) - (All [a] (-> (Order a) (Random a) Nat (Random (Set a)))) +(def: #export (random size &order gen-value) + (All [a] (-> Nat (Order a) (Random a) (Random (Set a)))) (case size 0 - (r@wrap (/.new &order)) + (random@wrap (/.new &order)) _ - (do r.monad - [partial (set &order gen-value (dec size)) - value (r.filter (|>> (/.member? partial) not) - gen-value)] + (do random.monad + [partial (random (dec size) &order gen-value) + value (random.filter (|>> (/.member? partial) not) + gen-value)] (wrap (/.add value partial))))) (def: #export test Test - (<| (_.context (%.name (name-of /.Set))) - ($_ _.and - (do r.monad - [size gen-nat] - ($_ _.and - ($equivalence.spec /.equivalence (..set n.order r.nat size)) - )) - (do {! r.monad} - [sizeL gen-nat - sizeR gen-nat - listL (|> (r.set n.hash sizeL gen-nat) (:: ! map //.to-list)) - listR (|> (r.set n.hash sizeR gen-nat) (:: ! map //.to-list)) - #let [(^open "/@.") /.equivalence - setL (/.from-list n.order listL) - setR (/.from-list n.order listR) - sortedL (list.sort n.< listL) - minL (list.head sortedL) - maxL (list.last sortedL)]] - ($_ _.and - (_.test "I can query the size of a set." - (n.= sizeL (/.size setL))) - (_.test "Can query minimum value." - (case [(/.min setL) minL] - [#.None #.None] - true - - [(#.Some reference) (#.Some sample)] - (n.= reference sample) - - _ - false)) - (_.test "Can query maximum value." - (case [(/.max setL) maxL] - [#.None #.None] - true - - [(#.Some reference) (#.Some sample)] - (n.= reference sample) - - _ - false)) - (_.test "Converting sets to/from lists can't change their values." - (|> setL - /.to-list (/.from-list n.order) - (/@= setL))) - (_.test "Order is preserved." - (let [listL (/.to-list setL) - (^open "list@.") (list.equivalence n.equivalence)] - (list@= listL - (list.sort n.< listL)))) - (_.test "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)))) - (_.test "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)))) - (_.test "Union with the empty set leaves a set unchanged." - (/@= setL - (/.union (/.new n.order) - setL))) - (_.test "Intersection with the empty set results in the empty set." - (let [empty-set (/.new n.order)] - (/@= empty-set - (/.intersection empty-set setL)))) - (_.test "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? sub) (/.to-list setR))))) - (_.test "Every member of a set must be identifiable." - (list.every? (/.member? setL) (/.to-list setL))) + (<| (_.covering /._) + (_.with-cover [/.Set]) + (do {! random.monad} + [sizeL ..size + sizeR ..size + usetL (random.set n.hash sizeL random.nat) + non-memberL (random.filter (|>> (//.member? usetL) not) + random.nat) + #let [listL (//.to-list usetL)] + listR (|> (random.set n.hash sizeR random.nat) (:: ! map //.to-list)) + #let [(^open "/@.") /.equivalence + setL (/.from-list n.order listL) + setR (/.from-list n.order listR) + empty (/.new n.order)]] + (`` ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence (..random sizeL n.order random.nat))) + + (_.cover [/.size] + (n.= sizeL (/.size setL))) + (_.cover [/.empty?] + (bit@= (n.= 0 (/.size setL)) + (/.empty? setL))) + (_.cover [/.new] + (/.empty? (/.new n.order))) + (_.cover [/.to-list] + (:: (list.equivalence n.equivalence) = + (/.to-list (/.from-list n.order listL)) + (list.sort (:: n.order <) listL))) + (_.cover [/.from-list] + (|> setL + /.to-list (/.from-list n.order) + (/@= setL))) + (~~ (template [<coverage> <comparison>] + [(_.cover [<coverage>] + (case (<coverage> setL) + (#.Some value) + (|> setL /.to-list (list.every? (<comparison> value))) + + #.None + (/.empty? setL)))] + + [/.min n.>=] + [/.max n.<=] + )) + (_.cover [/.member?] + (let [members-are-identified! + (list.every? (/.member? setL) (/.to-list setL)) + + non-members-are-not-identified! + (not (/.member? setL non-memberL))] + (and members-are-identified! + non-members-are-not-identified!))) + (_.cover [/.add] + (let [setL+ (/.add non-memberL setL)] + (and (not (/.member? setL non-memberL)) + (/.member? setL+ non-memberL) + (n.= (inc (/.size setL)) + (/.size setL+))))) + (_.cover [/.remove] + (|> setL + (/.add non-memberL) + (/.remove non-memberL) + (:: /.equivalence = setL))) + (_.cover [/.sub?] + (let [self! + (/.sub? setL setL) + + empty! + (/.sub? setL empty)] + (and self! + empty!))) + (_.cover [/.super?] + (let [self! + (/.super? setL setL) + + empty! + (/.super? empty setL) + + symmetry! + (bit@= (/.super? setL setR) + (/.sub? setR setL))] + (and self! + empty! + symmetry!))) + (~~ (template [<coverage> <relation> <empty?>] + [(_.cover [<coverage>] + (let [self! + (:: /.equivalence = + setL + (<coverage> setL setL)) + + super! + (and (<relation> (<coverage> setL setR) setL) + (<relation> (<coverage> setL setR) setR)) + + empty! + (:: /.equivalence = + (if <empty?> empty setL) + (<coverage> setL empty)) + + idempotence! + (:: /.equivalence = + (<coverage> setL (<coverage> setL setR)) + (<coverage> setR (<coverage> setL setR)))] + (and self! + super! + empty! + idempotence!)))] + + [/.union /.sub? false] + [/.intersection /.super? true] + )) + (_.cover [/.difference] + (let [self! + (|> setL + (/.difference setL) + (:: /.equivalence = empty)) + + empty! + (|> setL + (/.difference empty) + (:: /.equivalence = setL)) + + difference! + (not (list.any? (/.member? (/.difference setL setR)) + (/.to-list setL))) + + idempotence! + (:: /.equivalence = + (/.difference setL setR) + (/.difference setL (/.difference setL setR)))] + (and self! + empty! + difference! + idempotence!))) ))))) diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux index f0ff06160..a3c2dae7f 100644 --- a/stdlib/source/test/lux/meta/annotation.lux +++ b/stdlib/source/test/lux/meta/annotation.lux @@ -74,7 +74,7 @@ [/.nat random.nat code.nat nat.equivalence] [/.int random.int code.int int.equivalence] [/.rev random.rev code.rev rev.equivalence] - [/.frac random.frac code.frac frac.equivalence] + [/.frac random.safe-frac code.frac frac.equivalence] [/.text (random.ascii/alpha 1) code.text text.equivalence] [/.identifier ..random-key code.identifier name.equivalence] [/.tag ..random-key code.tag name.equivalence] diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux index d17559cec..6e1ce67b3 100644 --- a/stdlib/source/test/lux/world/console.lux +++ b/stdlib/source/test/lux/world/console.lux @@ -4,6 +4,7 @@ [abstract [monad (#+ do)]] [control + ["." io] ["." try (#+ Try)] ["." exception (#+ exception:)]]] {1 @@ -40,4 +41,4 @@ Test (<| (_.covering /._) (_.with-cover [/.mock /.Simulation] - ($/.spec (/.mock ..simulation false))))) + ($/.spec (io.io (/.mock ..simulation false)))))) |