From a02b7bf8ff358ccfa35b03272d28537aeac723ae Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 28 Nov 2020 19:45:56 -0400 Subject: Added "private" macro to lux/debug. --- stdlib/source/test/aedifex.lux | 4 +- stdlib/source/test/aedifex/command/build.lux | 147 +++++++++++++++ stdlib/source/test/licentia.lux | 34 ++-- stdlib/source/test/lux/control/concatenative.lux | 2 +- stdlib/source/test/lux/data.lux | 2 +- stdlib/source/test/lux/data/collection/array.lux | 77 +++++--- stdlib/source/test/lux/data/format/json.lux | 222 ++++++++++++++++++----- stdlib/source/test/lux/host.js.lux | 16 +- stdlib/source/test/lux/locale.lux | 18 +- stdlib/source/test/lux/macro/code.lux | 52 +++--- stdlib/source/test/lux/macro/syntax/common.lux | 4 +- stdlib/source/test/lux/type.lux | 32 ++-- stdlib/source/test/lux/type/check.lux | 42 ++--- stdlib/source/test/lux/type/implicit.lux | 8 +- stdlib/source/test/lux/world/shell.lux | 51 +++--- 15 files changed, 505 insertions(+), 206 deletions(-) create mode 100644 stdlib/source/test/aedifex/command/build.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 4947dcf18..7540b4541 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -13,7 +13,8 @@ ["#/." pom] ["#/." install] ["#/." deploy] - ["#/." deps]] + ["#/." deps] + ["#/." build]] ["#." local] ["#." cache] ["#." dependency @@ -38,6 +39,7 @@ /command/install.test /command/deploy.test /command/deps.test + /command/build.test /local.test /cache.test /dependency.test diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux new file mode 100644 index 000000000..5285b7548 --- /dev/null +++ b/stdlib/source/test/aedifex/command/build.lux @@ -0,0 +1,147 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + ["." predicate]] + [control + ["." try] + ["." exception] + [concurrency + ["." promise]] + [parser + ["." environment]]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." dictionary] + ["." set]]] + [math + ["." random (#+ Random)]] + [world + ["." file] + ["." shell]]] + ["$." /// #_ + ["#." package] + ["#." artifact] + ["#." dependency #_ + ["#/." resolution]]] + {#program + ["." / + ["//#" /// #_ + ["#" profile (#+ Profile)] + ["#." action] + ["#." pom] + ["#." package] + ["#." cache] + ["#." repository] + ["#." artifact + ["#/." type]] + ["#." dependency + ["#/." resolution]]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [#let [fs (file.mock (:: file.default separator)) + shell (shell.mock + (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (#try.Success + (: (shell.Simulation []) + (structure + (def: (on-read state) + (#try.Failure "on-read")) + (def: (on-error state) + (#try.Failure "on-error")) + (def: (on-write input state) + (#try.Failure "on-write")) + (def: (on-destroy state) + (#try.Failure "on-destroy")) + (def: (on-await state) + (#try.Success [state shell.normal])))))) + [])] + program (random.ascii/alpha 5) + target (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5) + #let [empty-profile (: Profile + (:: ///.monoid identity)) + with-target (: (-> Profile Profile) + (set@ #///.target (#.Some target))) + with-program (: (-> Profile Profile) + (set@ #///.program (#.Some program))) + + profile (|> empty-profile + with-program + with-target) + + no-working-directory environment.empty + + environment (dictionary.put "user.dir" working-directory environment.empty)]] + ($_ _.and + (_.cover [/.working-directory] + (and (case (/.working-directory no-working-directory) + (#try.Success _) + false + + (#try.Failure error) + true) + (case (/.working-directory environment) + (#try.Success _) + true + + (#try.Failure error) + false))) + (wrap (do promise.monad + [outcome (/.do! environment fs shell ///dependency/resolution.empty + (with-target empty-profile))] + (_.claim [/.no-specified-program] + (case outcome + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.no-specified-program error))))) + (wrap (do promise.monad + [outcome (/.do! environment fs shell ///dependency/resolution.empty + (with-program empty-profile))] + (_.claim [/.no-specified-target] + (case outcome + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.no-specified-target error))))) + (wrap (do promise.monad + [outcome (/.do! environment fs shell ///dependency/resolution.empty profile)] + (_.claim [/.Compiler /.no-available-compiler] + (case outcome + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.no-available-compiler error))))) + (do ! + [lux-version (random.ascii/alpha 5) + [_ compiler-package] $///package.random + #let [jvm-compiler {#///dependency.artifact {#///artifact.group /.lux-group + #///artifact.name /.jvm-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library} + js-compiler {#///dependency.artifact {#///artifact.group /.lux-group + #///artifact.name /.js-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library}] + compiler-dependency (random.either (wrap jvm-compiler) + (wrap js-compiler))] + (wrap (do promise.monad + [verdict (do ///action.monad + [#let [resolution (|> ///dependency/resolution.empty + (dictionary.put compiler-dependency compiler-package))] + _ (/.do! environment fs shell resolution profile)] + (wrap true))] + (_.claim [/.do! + /.lux-group /.jvm-compiler-name /.js-compiler-name] + (try.default false verdict))))) + )))) diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux index f73d55ab4..506a61c61 100644 --- a/stdlib/source/test/licentia.lux +++ b/stdlib/source/test/licentia.lux @@ -5,13 +5,13 @@ [abstract/monad (#+ do)] [io (#+ io)] [data - ["." bit ("#;." equivalence)] - ["." maybe ("#;." functor)] + ["." bit ("#\." equivalence)] + ["." maybe ("#\." functor)] ["." text] [number - ["n" nat ("#@." interval)]] + ["n" nat ("#\." interval)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [math ["r" random (#+ Random)]]] {#program @@ -43,9 +43,9 @@ (def: period (Random (Period Nat)) (do {! r.monad} - [start (r.filter (|>> (n.= n@top) not) + [start (r.filter (|>> (n.= n\top) not) r.nat) - #let [wiggle-room (n.- start n@top)] + #let [wiggle-room (n.- start n\top)] end (:: ! map (|>> (n.% wiggle-room) (n.max 1)) r.nat)] @@ -173,10 +173,10 @@ (_.test "Litigation conditions are present." (present? liability.litigation)) (_.test "Liability acceptance conditions may be present." - (bit;= (get@ #license.can-accept? liability) + (bit\= (get@ #license.can-accept? liability) (present? liability.can-accept))) (_.test "Liability acceptance conditions may be present." - (bit;= (get@ #license.disclaim-high-risk? liability) + (bit\= (get@ #license.disclaim-high-risk? liability) (present? liability.disclaim-high-risk))) )) @@ -195,13 +195,13 @@ (Concern Commercial) ($_ _.and (_.test "Non-commercial clause is present." - (bit;= (not (get@ #license.can-sell? commercial)) + (bit\= (not (get@ #license.can-sell? commercial)) (present? commercial.cannot-sell))) (_.test "Contributor credit condition is present." - (bit;= (get@ #license.require-contributor-credit? commercial) + (bit\= (get@ #license.require-contributor-credit? commercial) (present? commercial.require-contributor-attribution))) (_.test "Anti-endorsement condition is present." - (bit;= (not (get@ #license.allow-contributor-endorsement? commercial)) + (bit\= (not (get@ #license.allow-contributor-endorsement? commercial)) (present? commercial.disallow-contributor-endorsement))) )) @@ -209,11 +209,11 @@ (Concern Extension) ($_ _.and (_.test "The license is viral." - (bit;= (get@ #license.same-license? extension) + (bit\= (get@ #license.same-license? extension) (and (list.every? present? extension.sharing-requirement) (list.every? present? extension.license-conflict-resolution)))) (_.test "Extensions must be distinguishable from the original work." - (bit;= (get@ #license.must-be-distinguishable? extension) + (bit\= (get@ #license.must-be-distinguishable? extension) (present? extension.distinctness-requirement))) (_.test "The community must be notified of new extensions." (case (get@ #license.notification-period extension) @@ -223,7 +223,7 @@ #.None true)) (_.test "Must describe modifications." - (bit;= (get@ #license.must-describe-modifications? extension) + (bit\= (get@ #license.must-describe-modifications? extension) (present? extension.description-requirement))) )) @@ -235,14 +235,14 @@ (_.test "The attribution phrase is present." (|> attribution (get@ #license.phrase) - (maybe;map present?) + (maybe\map present?) (maybe.default true))) (_.test "The attribution URL is present." (present? (get@ #license.url attribution))) (_.test "The attribution image is present." (|> attribution (get@ #license.image) - (maybe;map present?) + (maybe\map present?) (maybe.default true))) )) @@ -295,7 +295,7 @@ yes) every-entity-is-mentioned? (|> black-list (get@ #license.entities) - (list;map black-list.entity) + (list\map black-list.entity) (list.every? present?))] (and black-list-is-justified? every-entity-is-mentioned?))) diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index f346ff568..8d6ed4e87 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -131,7 +131,7 @@ (!numerical r.= random.rev (|>> (r.= .0) not) [[/.r/+ r.+] [/.r/- r.-] [/.r/* r.*] [/.r// r./] [/.r/% r.%]] [[/.r/= r.=] [/.r/< r.<] [/.r/<= r.<=] [/.r/> r.>] [/.r/>= r.>=]]) - (!numerical f.= random.frac (|>> (f.= +0.0) not) + (!numerical f.= random.safe-frac (|>> (f.= +0.0) not) [[/.f/+ f.+] [/.f/- f.-] [/.f/* f.*] [/.f// f./] [/.f/% f.%]] [[/.f/= f.=] [/.f/< f.<] [/.f/<= f.<=] [/.f/> f.>] [/.f/>= f.>=]]) )) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 74a295777..5a80af5a7 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -4,7 +4,7 @@ [abstract [monad (#+ do)]] [math - ["." random ("#@." monad)]]] + ["." random]]] ["." / #_ ["#." binary] ["#." bit] diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 7a5e686ac..5a94f13b7 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -12,6 +12,8 @@ [data ["." bit] ["." maybe] + ["." text ("#\." equivalence) + ["%" format (#+ format)]] [number ["n" nat]] [collection @@ -46,6 +48,45 @@ ($fold.spec ..injection /.equivalence /.fold)) ))) +(def: search + Test + (do {! random.monad} + [size ..bounded-size + base random.nat + shift random.nat + #let [expected (n.+ base shift)] + the-array (random.array size random.nat)] + ($_ _.and + (_.cover [/.find] + (:: (maybe.equivalence n.equivalence) = + (/.find n.even? the-array) + (list.find n.even? (/.to-list the-array)))) + (_.cover [/.find+] + (case [(/.find n.even? the-array) + (/.find+ (function (_ idx member) + (n.even? member)) + the-array)] + [(#.Some expected) (#.Some [idx actual])] + (case (/.read idx the-array) + (#.Some again) + (and (n.= expected actual) + (n.= actual again)) + + #.None + false) + + [#.None #.None] + true)) + (_.cover [/.every?] + (:: bit.equivalence = + (list.every? n.even? (/.to-list the-array)) + (/.every? n.even? the-array))) + (_.cover [/.any?] + (:: bit.equivalence = + (list.any? n.even? (/.to-list the-array)) + (/.any? n.even? the-array))) + ))) + (def: #export test Test (<| (_.covering /._) @@ -59,10 +100,18 @@ the-array (random.array size random.nat)] ($_ _.and ..structures + ..search (_.cover [/.new /.size] (n.= size (/.size (: (Array Nat) (/.new size))))) + (_.cover [/.type-name] + (case (:of (/.new size)) + (^ (#.UnivQ _ (#.Apply _ (#.Named _ (#.UnivQ _ (#.Primitive nominal-type (list (#.Parameter 1)))))))) + (text\= /.type-name nominal-type) + + _ + false)) (_.cover [/.read /.write!] (let [the-array (|> (/.new 2) (: (Array Nat)) @@ -171,32 +220,4 @@ (or (n.even? value) (is? default value))) (/.to-list' default the-array))))) - (_.cover [/.find] - (:: (maybe.equivalence n.equivalence) = - (/.find n.even? the-array) - (list.find n.even? (/.to-list the-array)))) - (_.cover [/.find+] - (case [(/.find n.even? the-array) - (/.find+ (function (_ idx member) - (n.even? member)) - the-array)] - [(#.Some expected) (#.Some [idx actual])] - (case (/.read idx the-array) - (#.Some again) - (and (n.= expected actual) - (n.= actual again)) - - #.None - false) - - [#.None #.None] - true)) - (_.cover [/.every?] - (:: bit.equivalence = - (list.every? n.even? (/.to-list the-array)) - (/.every? n.even? the-array))) - (_.cover [/.any?] - (:: bit.equivalence = - (list.any? n.even? (/.to-list the-array)) - (/.any? n.even? the-array))) )))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index c1341aae0..22834745d 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -1,67 +1,199 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] + ["." meta] [abstract - codec - [monad (#+ do Monad)] - [equivalence (#+ Equivalence)] + [monad (#+ do)] {[0 #spec] [/ ["$." equivalence] ["$." codec]]}] [control - pipe - ["p" parser]] + ["." try ("#\." functor)]] [data + ["." product] ["." bit] - ["." maybe] - ["." text] + ["." text + ["%" format (#+ format)]] [number ["n" nat] ["." frac]] [collection - [row (#+ row)] - ["d" dictionary] - ["." list]]] - [macro - [poly (#+ derived:)]] - [type - ["." unit]] + ["." row] + ["." dictionary] + ["." set] + ["." list ("#\." functor)]]] [math - ["r" random (#+ Random)]] - [time - ["ti" instant] - ["tda" date] - ## ["tdu" duration] - ]] - [test - [lux - [time - ["_." instant] - ## ["_." duration] - ["_." date]]]] + ["." random (#+ Random)]] + [macro + ["." syntax (#+ syntax:)] + ["." code]]] {1 - ["." / (#+ JSON)]}) + ["." / (#+ JSON) ("\." equivalence)]}) (def: #export json - (Random JSON) - (r.rec (function (_ recur) - (do {! r.monad} - [size (:: ! map (n.% 2) r.nat)] - ($_ r.or - (:: ! wrap []) - r.bit - r.safe-frac - (r.unicode size) - (r.row size recur) - (r.dictionary text.hash size (r.unicode size) recur) - ))))) + (Random /.JSON) + (random.rec + (function (_ recur) + (do {! random.monad} + [size (:: ! map (n.% 2) random.nat)] + ($_ random.or + (:: ! wrap []) + random.bit + random.safe-frac + (random.unicode size) + (random.row size recur) + (random.dictionary text.hash size (random.unicode size) recur) + ))))) + +(syntax: (boolean) + (do meta.monad + [value meta.count] + (wrap (list (code.bit (n.even? value)))))) + +(syntax: (number) + (do meta.monad + [value meta.count] + (wrap (list (code.frac (n.frac value)))))) + +(syntax: (string) + (do meta.monad + [value (meta.gensym "string")] + (wrap (list (code.text (%.code value)))))) (def: #export test Test - (<| (_.context (%.name (name-of /._))) - ($_ _.and - ($equivalence.spec /.equivalence ..json) - ($codec.spec /.equivalence /.codec ..json) - ))) + (<| (_.covering /._) + (_.with-cover [/.JSON]) + (`` ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..json)) + (_.with-cover [/.codec] + ($codec.spec /.equivalence /.codec ..json)) + + (do random.monad + [sample ..json] + (_.cover [/.Null /.null?] + (:: bit.equivalence = + (/.null? sample) + (case sample + #/.Null true + _ false)))) + (do random.monad + [expected ..json] + (_.cover [/.format] + (|> expected + /.format + (:: /.codec decode) + (try\map (\= expected)) + (try.default false)))) + (do random.monad + [keys (random.set text.hash 3 (random.ascii/alpha 1)) + values (random.set frac.hash 3 random.safe-frac) + #let [expected (list.zip/2 (set.to-list keys) + (list\map (|>> #/.Number) (set.to-list values))) + object (/.object expected)]] + ($_ _.and + (_.cover [/.object /.fields] + (case (/.fields object) + (#try.Success actual) + (:: (list.equivalence text.equivalence) = + (list\map product.left expected) + actual) + + (#try.Failure error) + false)) + (_.cover [/.get] + (list.every? (function (_ [key expected]) + (|> (/.get key object) + (try\map (\= expected)) + (try.default false))) + expected)) + )) + (do random.monad + [key (random.ascii/alpha 1) + unknown (random.filter (|>> (:: text.equivalence = key) not) + (random.ascii/alpha 1)) + expected random.safe-frac] + (_.cover [/.set] + (<| (try.default false) + (do try.monad + [object (/.set key (#/.Number expected) (/.object (list))) + #let [can-find-known-key! + (|> object + (/.get key) + (try\map (\= (#/.Number expected))) + (try.default false)) + + cannot-find-unknown-key! + (case (/.get unknown object) + (#try.Success _) + false + + (#try.Failure error) + true)]] + (wrap (and can-find-known-key! + cannot-find-unknown-key!)))))) + (~~ (template [ ] + [(do random.monad + [key (random.ascii/alpha 1) + value ] + (_.cover [ ] + (|> (/.object (list [key ( value)])) + ( key) + (try\map (:: = value)) + (try.default false))))] + + [/.Boolean /.get-boolean #/.Boolean random.bit bit.equivalence] + [/.Number /.get-number #/.Number random.safe-frac frac.equivalence] + [/.String /.get-string #/.String (random.ascii/alpha 1) text.equivalence] + [/.Array /.get-array #/.Array (random.row 3 ..json) (row.equivalence /.equivalence)] + [/.Object /.get-object #/.Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..json) (dictionary.equivalence /.equivalence)] + )) + (with-expansions [ (boolean) + (number) + (string) + (row.row #/.Null + (#/.Boolean ) + (#/.Number ) + (#/.String )) + (string) + (string) + (string) + (string) + (string) + (string) + (string)] + (_.cover [/.json] + (and (\= #/.Null (/.json #null)) + (~~ (template [ ] + [(\= ( ) (/.json ))] + + [#/.Boolean ] + [#/.Number ] + [#/.String ] + )) + (\= (#/.Array ) (/.json [#null ])) + (let [object (/.json { #null + + + + [#null ] + { }})] + (<| (try.default false) + (do try.monad + [value0 (/.get object) + value1 (/.get object) + value2 (/.get object) + value3 (/.get object) + value4 (/.get object) + value5 (/.get object) + value6 (/.get value5)] + (wrap (and (\= #/.Null value0) + (\= (#/.Boolean ) value1) + (\= (#/.Number ) value2) + (\= (#/.String ) value3) + (\= (#/.Array ) value4) + (\= (#/.Number ) value6)))))) + ))) + )))) diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux index 507cda9ff..6e42fc363 100644 --- a/stdlib/source/test/lux/host.js.lux +++ b/stdlib/source/test/lux/host.js.lux @@ -8,7 +8,7 @@ [control ["." try]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["." nat] ["." frac]]]] @@ -55,21 +55,21 @@ /.on-node-js? /.on-browser?)) (_.cover [/.type-of] - (and (text@= "boolean" (/.type-of boolean)) - (text@= "number" (/.type-of number)) - (text@= "string" (/.type-of string)) - (text@= "function" (/.type-of function)) - (text@= "object" (/.type-of object)))) + (and (text\= "boolean" (/.type-of boolean)) + (text\= "number" (/.type-of number)) + (text\= "string" (/.type-of string)) + (text\= "function" (/.type-of function)) + (text\= "object" (/.type-of object)))) (_.cover [/.try] (case (/.try (error! string)) (#try.Success _) false (#try.Failure error) - (text@= string error))) + (text\= string error))) (_.cover [/.import:] (let [encoding "utf8"] - (text@= string + (text\= string (cond /.on-nashorn? (let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))] (|> (java/lang/String::new [binary encoding]) diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux index 37a629596..3518dac9d 100644 --- a/stdlib/source/test/lux/locale.lux +++ b/stdlib/source/test/lux/locale.lux @@ -7,9 +7,9 @@ [/ ["$." equivalence]]}] [math - ["." random (#+ Random) ("#@." monad)]] + ["." random (#+ Random) ("#\." monad)]] [data - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["." encoding (#+ Encoding)]] [collection ["." list]]]] @@ -23,18 +23,18 @@ (def: random-language (Random Language) - (random.either (random@wrap language.afar) - (random@wrap language.zaza))) + (random.either (random\wrap language.afar) + (random\wrap language.zaza))) (def: random-territory (Random Territory) - (random.either (random@wrap territory.afghanistan) - (random@wrap territory.zimbabwe))) + (random.either (random\wrap territory.afghanistan) + (random\wrap territory.zimbabwe))) (def: random-encoding (Random Encoding) - (random.either (random@wrap encoding.ascii) - (random@wrap encoding.koi8-u))) + (random.either (random\wrap encoding.ascii) + (random\wrap encoding.koi8-u))) (def: random-locale (Random /.Locale) @@ -60,7 +60,7 @@ lt-locale (/.locale language (#.Some territory) #.None) le-locale (/.locale language #.None (#.Some encoding)) lte-locale (/.locale language (#.Some territory) (#.Some encoding))] - #let [language-check (and (text@= (language.code language) + #let [language-check (and (text\= (language.code language) (/.code l-locale)) (list.every? (|>> /.code (text.starts-with? (language.code language))) (list lt-locale le-locale lte-locale))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 52955680e..96f653a11 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -2,7 +2,7 @@ [lux #* ["_" test (#+ Test)] [math - ["." random (#+ Random) ("#@." monad)]] + ["." random (#+ Random) ("#\." monad)]] [abstract [monad (#+ do)] {[0 #spec] @@ -16,7 +16,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [meta ["." location]] [tool @@ -52,17 +52,17 @@ (random.rec (function (_ random) ($_ random.either - (random@map /.bit random.bit) - (random@map /.nat random.nat) - (random@map /.int random.int) - (random@map /.rev random.rev) - (random@map /.frac random.safe-frac) - (random@map /.text ..random-text) - (random@map /.identifier ..random-name) - (random@map /.tag ..random-name) - (random@map /.form (..random-sequence random)) - (random@map /.tuple (..random-sequence random)) - (random@map /.record (..random-record random)) + (random\map /.bit random.bit) + (random\map /.nat random.nat) + (random\map /.int random.int) + (random\map /.rev random.rev) + (random\map /.frac random.safe-frac) + (random\map /.text ..random-text) + (random\map /.identifier ..random-name) + (random\map /.tag ..random-name) + (random\map /.form (..random-sequence random)) + (random\map /.tuple (..random-sequence random)) + (random\map /.record (..random-record random)) )))) (def: (read source-code) @@ -87,29 +87,29 @@ (function (_ to-code) (do {! random.monad} [parts (..random-sequence replace-simulation)] - (wrap [(to-code (list@map product.left parts)) - (to-code (list@map product.right parts))]))))] + (wrap [(to-code (list\map product.left parts)) + (to-code (list\map product.right parts))]))))] ($_ random.either - (random@wrap [original substitute]) + (random\wrap [original substitute]) (do {! random.monad} [sample (random.filter (|>> (:: /.equivalence = original) not) ($_ random.either - (random@map /.bit random.bit) - (random@map /.nat random.nat) - (random@map /.int random.int) - (random@map /.rev random.rev) - (random@map /.frac random.safe-frac) - (random@map /.text ..random-text) - (random@map /.identifier ..random-name) - (random@map /.tag ..random-name)))] + (random\map /.bit random.bit) + (random\map /.nat random.nat) + (random\map /.int random.int) + (random\map /.rev random.rev) + (random\map /.frac random.safe-frac) + (random\map /.text ..random-text) + (random\map /.identifier ..random-name) + (random\map /.tag ..random-name)))] (wrap [sample sample])) (for-sequence /.form) (for-sequence /.tuple) (do {! random.monad} [parts (..random-sequence replace-simulation)] - (wrap [(/.record (let [parts' (list@map product.left parts)] + (wrap [(/.record (let [parts' (list\map product.left parts)] (list.zip/2 parts' parts'))) - (/.record (let [parts' (list@map product.right parts)] + (/.record (let [parts' (list\map product.right parts)] (list.zip/2 parts' parts')))])) ))))) diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index d50b94eaa..b470ca574 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -12,7 +12,7 @@ ["<>" parser ["" code]]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] ["." name] ["." text] [number @@ -62,7 +62,7 @@ /writer.export (.run /reader.export) (case> (#try.Success actual) - (bit@= expected actual) + (bit\= expected actual) (#try.Failure error) false)))) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index fca611825..c6a141be8 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -13,7 +13,7 @@ [collection ["." list]]]] {1 - ["." / ("#@." equivalence)]} + ["." / ("#\." equivalence)]} ["." / #_ ["#." check] ["#." dynamic] @@ -32,13 +32,13 @@ (def: #export type (r.Random Type) - (let [(^open "R@.") r.monad] + (let [(^open "R\.") r.monad] (r.rec (function (_ recur) (let [pairG (r.and recur recur) idG r.nat - quantifiedG (r.and (R@wrap (list)) recur)] + quantifiedG (r.and (R\wrap (list)) recur)] ($_ r.or - (r.and ..short (R@wrap (list))) + (r.and ..short (R\wrap (list))) pairG pairG pairG @@ -95,15 +95,15 @@ #1))) (list.repeat size) (M.seq !)) - #let [(^open "/@.") /.equivalence - (^open "list@.") (list.equivalence /.equivalence)]] + #let [(^open "/\.") /.equivalence + (^open "list\.") (list.equivalence /.equivalence)]] (`` ($_ _.and (~~ (template [ ] [(_.test (format "Can build and tear-down " " types.") (let [flat (|> members )] - (or (list@= members flat) - (and (list@= (list) members) - (list@= (list ) flat)))))] + (or (list\= members flat) + (and (list\= (list) members) + (list\= (list ) flat)))))] ["variant" /.variant /.flatten-variant Nothing] ["tuple" /.tuple /.flatten-tuple Any] @@ -120,13 +120,13 @@ _ #1)))) - #let [(^open "/@.") /.equivalence - (^open "list@.") (list.equivalence /.equivalence)]] + #let [(^open "/\.") /.equivalence + (^open "list\.") (list.equivalence /.equivalence)]] ($_ _.and (_.test "Can build and tear-down function types." (let [[inputs output] (|> (/.function members extra) /.flatten-function)] - (and (list@= members inputs) - (/@= extra output)))) + (and (list\= members inputs) + (/\= extra output)))) (_.test "Can build and tear-down application types." (let [[tfunc tparams] (|> extra (/.application members) /.flatten-application)] @@ -142,13 +142,13 @@ _ #1)))) - #let [(^open "/@.") /.equivalence]] + #let [(^open "/\.") /.equivalence]] (`` ($_ _.and (~~ (template [ ] [(_.test (format "Can build and tear-down " " types.") (let [[flat-size flat-body] (|> extra ( size) )] (and (n.= size flat-size) - (/@= extra flat-body))))] + (/\= extra flat-body))))] ["universally-quantified" /.univ-q /.flatten-univ-q] ["existentially-quantified" /.ex-q /.flatten-ex-q] @@ -157,7 +157,7 @@ (_.test (%.name (name-of /.:by-example)) (let [example (: (Maybe Nat) #.None)] - (/@= (.type (List Nat)) + (/\= (.type (List Nat)) (/.:by-example [a] {(Maybe a) example} (List a))))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 4846f5e7d..bbaaa5712 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -10,13 +10,13 @@ [data ["." product] ["." maybe] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." set]]] - ["." type ("#@." equivalence)]] + ["." type ("#\." equivalence)]] {1 ["." /]}) @@ -33,28 +33,28 @@ (-> Nat (r.Random Type)) (do r.monad [_ (wrap [])] - (let [(^open "R@.") r.monad + (let [(^open "R\.") r.monad pairG (r.and (type' num-vars) (type' num-vars)) - quantifiedG (r.and (R@wrap (list)) (type' (inc num-vars))) - random-pair (r.either (r.either (R@map (|>> #.Sum) pairG) - (R@map (|>> #.Product) pairG)) - (r.either (R@map (|>> #.Function) pairG) - (R@map (|>> #.Apply) pairG))) - random-id (let [random-id (r.either (R@map (|>> #.Var) r.nat) - (R@map (|>> #.Ex) r.nat))] + quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars))) + random-pair (r.either (r.either (R\map (|>> #.Sum) pairG) + (R\map (|>> #.Product) pairG)) + (r.either (R\map (|>> #.Function) pairG) + (R\map (|>> #.Apply) pairG))) + random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat) + (R\map (|>> #.Ex) r.nat))] (case num-vars 0 random-id - _ (r.either (R@map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat) + _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat) random-id))) - random-quantified (r.either (R@map (|>> #.UnivQ) quantifiedG) - (R@map (|>> #.ExQ) quantifiedG))] + random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG) + (R\map (|>> #.ExQ) quantifiedG))] ($_ r.either - (R@map (|>> #.Primitive) (r.and ..short (R@wrap (list)))) + (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list)))) random-pair random-id random-quantified - (R@map (|>> #.Named) (r.and ..name (type' num-vars))) + (R\map (|>> #.Named) (r.and ..name (type' num-vars))) )))) (def: type @@ -157,7 +157,7 @@ (do r.monad [#let [gen-short (r.ascii 10)] nameL gen-short - nameR (|> gen-short (r.filter (|>> (text@= nameL) not))) + nameR (|> gen-short (r.filter (|>> (text\= nameL) not))) paramL ..type paramR (r.filter (|>> (/.checks? paramL) not) ..type)] ($_ _.and @@ -207,7 +207,7 @@ (_.test "Can create rings of variables." (type-checks? (do /.monad [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections) - #let [ids (list@map product.left ids+types)] + #let [ids (list\map product.left ids+types)] headR (/.ring head-id) tailR (/.ring tail-id)] (/.assert "" @@ -222,7 +222,7 @@ (_.test "When a var in a ring is bound, all the ring is bound." (type-checks? (do {! /.monad} [[[head-id headT] ids+types tailT] (build-ring num-connections) - #let [ids (list@map product.left ids+types)] + #let [ids (list\map product.left ids+types)] _ (/.check headT boundT) head-bound (/.read head-id) tail-bound (monad.map ! /.read ids) @@ -230,8 +230,8 @@ tailR+ (monad.map ! /.ring ids)] (let [rings-were-erased? (and (set.empty? headR) (list.every? set.empty? tailR+)) - same-types? (list.every? (type@= boundT) (list& (maybe.default headT head-bound) - (list@map (function (_ [tail-id ?tailT]) + same-types? (list.every? (type\= boundT) (list& (maybe.default headT head-bound) + (list\map (function (_ [tail-id ?tailT]) (maybe.default (#.Var tail-id) ?tailT)) (list.zip/2 ids tail-bound))))] (/.assert "" diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 4cdb9009f..203aad478 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -8,7 +8,7 @@ [monad (#+ do)] ["." enum]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat]] [collection @@ -29,10 +29,10 @@ end (n.max left right)]] ($_ _.and (_.test "Can automatically select first-order structures." - (let [(^open "list@.") (list.equivalence n.equivalence)] - (and (bit@= (:: n.equivalence = left right) + (let [(^open "list\.") (list.equivalence n.equivalence)] + (and (bit\= (:: n.equivalence = left right) (/.::: = left right)) - (list@= (:: list.functor map inc (enum.range n.enum start end)) + (list\= (:: list.functor map inc (enum.range n.enum start end)) (/.::: map inc (enum.range n.enum start end)))))) (_.test "Can automatically select second-order structures." (/.::: = diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index 094b32420..dd37f63ba 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." debug] [abstract [monad (#+ do)]] [control @@ -25,19 +26,15 @@ {1 ["." / [// - [environment (#+ Environment)]]]} + [environment (#+ Environment)] + [file (#+ Path)]]]} {[1 #spec] ["$." /]}) -(macro: (|private| definition+ compiler) - (let [[module _] (name-of /._)] - (#.Right [compiler (list (` ("lux in-module" (~ [["" 0 0] (#.Text module)]) - (~+ definition+))))]))) - (exception: dead) -(def: (simulation [environment command arguments]) - (-> [Environment /.Command (List /.Argument)] +(def: (simulation [environment working-directory command arguments]) + (-> [Environment Path /.Command (List /.Argument)] (/.Simulation Bit)) (structure (def: (on-read dead?) @@ -71,30 +68,30 @@ (-> /.Command Text Text Text /.Exit (/.Shell IO)) (structure (def: execute - ((|private| /.can-execute) - (function (_ [environment command arguments]) + ((debug.private /.can-execute) + (function (_ [environment working-directory command arguments]) (io.io (#try.Success (: (/.Process IO) (structure (def: read - ((|private| /.can-read) + ((debug.private /.can-read) (function (_ _) (io.io (#try.Success command))))) (def: error - ((|private| /.can-read) + ((debug.private /.can-read) (function (_ _) (io.io (#try.Success oops))))) (def: write - ((|private| /.can-write) + ((debug.private /.can-write) (function (_ message) (io.io (#try.Failure message))))) (def: destroy - ((|private| /.can-destroy) + ((debug.private /.can-destroy) (function (_ _) (io.io (#try.Failure destruction))))) (def: await - ((|private| /.can-wait) + ((debug.private /.can-wait) (function (_ _) (io.io (#try.Success exit)))))))))))))) @@ -116,10 +113,10 @@ #let [shell (/.async (..io-shell command oops input destruction exit))]] (wrap (do {! promise.monad} [verdict (do (try.with !) - [process (!.use (:: shell execute) [environment.empty command (list)]) + [process (!.use (:: shell execute) [environment.empty "~" command (list)]) read (!.use (:: process read) []) error (!.use (:: process error) []) - write? (do ! + wrote! (do ! [write (!.use (:: process write) [input])] (wrap (#try.Success (case write (#try.Success _) @@ -127,19 +124,19 @@ (#try.Failure write) (text\= input write))))) - destroy? (do ! - [destroy (!.use (:: process destroy) [])] - (wrap (#try.Success (case destroy - (#try.Success _) - false - - (#try.Failure destroy) - (text\= destruction destroy))))) + destroyed! (do ! + [destroy (!.use (:: process destroy) [])] + (wrap (#try.Success (case destroy + (#try.Success _) + false + + (#try.Failure destroy) + (text\= destruction destroy))))) await (!.use (:: process await) [])] (wrap (and (text\= command read) (text\= oops error) - write? - destroy? + wrote! + destroyed! (i.= exit await))))] (_.claim [/.async /.Can-Write] (try.default false verdict))))) -- cgit v1.2.3