diff options
Diffstat (limited to 'stdlib/source')
34 files changed, 517 insertions, 318 deletions
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 3673e6cce..2ce752cfd 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -9,7 +9,8 @@ ["n" nat] ["." int] ["." rev ("#\." interval)] - ["f" frac]] + ["f" frac] + ["." i64]] [collection ["." list ("#\." functor)]]] ["." math] @@ -59,24 +60,27 @@ (-> Color RGB) (|>> :representation)) - (def: #export hash - (Hash Color) - (let [hash ($_ hash.product - n.hash - n.hash - n.hash)] - (structure - (def: &equivalence - (structure - (def: (= reference sample) - (\ hash = (:representation reference) (:representation sample))))) - - (def: hash - (|>> :representation (\ hash hash)))))) - - (def: #export equivalence + (structure: #export equivalence (Equivalence Color) - (\ ..hash &equivalence)) + + (def: (= reference sample) + (let [[rR gR bR] (:representation reference) + [rS gS bS] (:representation sample)] + (and (n.= rR rS) + (n.= gR gS) + (n.= bR bS))))) + + (structure: #export hash + (Hash Color) + + (def: &equivalence ..equivalence) + + (def: (hash value) + (let [[r g b] (:representation value)] + ($_ i64.or + (i64.left-shift 16 r) + (i64.left-shift 8 g) + b)))) (def: #export black (..from-rgb {#red 0 diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 160aab7e4..1d7b1c9f7 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -69,7 +69,7 @@ (def: #export (<in> value) (-> Nat (Try <type>)) - (if (|> value (n.% <limit>) (n.= value)) + (if (n.< <limit> value) (#try.Success (:abstraction value)) (exception.throw <exception> [value]))) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index f37a300a9..559782b1d 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -11,10 +11,10 @@ [data ["." product] ["." name ("#\." equivalence codec)] + ["." text ("#\." equivalence monoid)] [number ["n" nat] ["." int]] - ["." text ("#\." equivalence monoid)] [collection ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]]]) @@ -217,28 +217,48 @@ (def: xml-header Text - ($_ text\compose "<?xml version=" text.double-quote "1.0" text.double-quote " encoding=" text.double-quote "UTF-8" text.double-quote "?>")) + (let [quote (: (-> Text Text) + (function (_ value) + ($_ text\compose text.double-quote value text.double-quote)))] + ($_ text\compose + "<?xml" + " version=" (quote "1.0") + " encoding=" (quote "UTF-8") + "?>"))) (def: (write input) (-> XML Text) - ($_ text\compose xml-header - (loop [input input] + ($_ text\compose + ..xml-header text.new-line + (loop [prefix "" + input input] (case input (#Text value) (sanitize-value value) + + (^ (#Node xml-tag xml-attrs (list (#Text value)))) + (let [tag (..tag xml-tag) + attrs (if (dictionary.empty? xml-attrs) + "" + ($_ text\compose " " (..write-attrs xml-attrs)))] + ($_ text\compose + prefix "<" tag attrs ">" + (sanitize-value value) + "</" tag ">")) (#Node xml-tag xml-attrs xml-children) (let [tag (..tag xml-tag) attrs (if (dictionary.empty? xml-attrs) "" - ($_ text\compose " " (write-attrs xml-attrs)))] + ($_ text\compose " " (..write-attrs xml-attrs)))] (if (list.empty? xml-children) - ($_ text\compose "<" tag attrs "/>") - ($_ text\compose "<" tag attrs ">" + ($_ text\compose prefix "<" tag attrs "/>") + ($_ text\compose prefix "<" tag attrs ">" (|> xml-children - (list\map recur) + (list\map (|>> (recur (text\compose prefix text.tab)) (text\compose text.new-line))) (text.join-with "")) - "</" tag ">"))))))) + text.new-line prefix "</" tag ">"))))) + )) (structure: #export codec (Codec Text XML) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index 0e21157ba..397501cd2 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -1,6 +1,9 @@ (.module: [lux #* [host (#+ import:)] + ["@" target] + [control + ["." function]] [data ["." product] [number @@ -9,29 +12,31 @@ ["%" format (#+ format)]] [collection ["." row (#+ Row) ("#\." fold)]]] - [compiler - ["_" host]] [type abstract]] ["." //]) -(`` (for {(~~ (static _.old)) - (as-is (import: java/lang/CharSequence) +(with-expansions [<jvm> (as-is (import: java/lang/CharSequence) - (import: java/lang/Appendable - (append [java/lang/CharSequence] java/lang/Appendable)) + (import: java/lang/Appendable + ["#::." + (append [java/lang/CharSequence] java/lang/Appendable)]) - (import: java/lang/String - (new [int]) - (toString [] java/lang/String)) + (import: java/lang/String + ["#::." + (new [int]) + (toString [] java/lang/String)]) - (import: java/lang/StringBuilder - (new [int]) - (toString [] java/lang/String)))})) + (import: java/lang/StringBuilder + ["#::." + (new [int]) + (toString [] java/lang/String)]))] + (`` (for {@.old (as-is <jvm>) + @.jvm (as-is <jvm>)}))) (`` (abstract: #export Buffer - (for {(~~ (static _.old)) - [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]} + (for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] + @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]} ## default (Row Text)) @@ -39,45 +44,49 @@ (def: #export empty Buffer - (:abstraction (for {(~~ (static _.old)) - [0 id]} - ## default - row.empty))) + (:abstraction (with-expansions [<jvm> [0 function.identity]] + (for {@.old <jvm> + @.jvm <jvm>} + ## default + row.empty)))) (def: #export (append chunk buffer) (-> Text Buffer Buffer) - (for {(~~ (static _.old)) - (let [[capacity transform] (:representation buffer) - append! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder) - (function (_ chunk builder) - (exec (java/lang/Appendable::append (:coerce java/lang/CharSequence chunk) - builder) - builder)))] - (:abstraction [(n.+ (//.size chunk) capacity) - (|>> transform (append! chunk))]))} - ## default - (|> buffer :representation (row.add chunk) :abstraction))) + (with-expansions [<jvm> (let [[capacity transform] (:representation buffer) + append! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder) + (function (_ chunk builder) + (exec (java/lang/Appendable::append (:coerce java/lang/CharSequence chunk) + builder) + builder)))] + (:abstraction [(n.+ (//.size chunk) capacity) + (|>> transform (append! chunk))]))] + (for {@.old <jvm> + @.jvm <jvm>} + ## default + (|> buffer :representation (row.add chunk) :abstraction)))) - (def: #export (size buffer) + (def: #export size (-> Buffer Nat) - (for {(~~ (static _.old)) - (|> buffer :representation product.left)} - ## default - (row\fold (function (_ chunk total) - (n.+ (//.size chunk) total)) - 0 - (:representation buffer)))) + (with-expansions [<jvm> (|>> :representation product.left)] + (for {@.old <jvm> + @.jvm <jvm>} + ## default + (|>> :representation + (row\fold (function (_ chunk total) + (n.+ (//.size chunk) total)) + 0))))) (def: #export (text buffer) (-> Buffer Text) - (for {(~~ (static _.old)) - (let [[capacity transform] (:representation buffer)] - (|> (java/lang/StringBuilder::new (.int capacity)) - transform - java/lang/StringBuilder::toString))} - ## default - (row\fold (function (_ chunk total) - (format total chunk)) - "" - (:representation buffer)))) + (with-expansions [<jvm> (let [[capacity transform] (:representation buffer)] + (|> (java/lang/StringBuilder::new (.int capacity)) + transform + java/lang/StringBuilder::toString))] + (for {@.old <jvm> + @.jvm <jvm>} + ## default + (row\fold (function (_ chunk total) + (format total chunk)) + "" + (:representation buffer))))) )) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index b4a2ce0ca..3a4359f6f 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -1164,19 +1164,25 @@ (def: #export (make-directories monad system path) (All [!] (-> (Monad !) (System !) Path (! (Try Path)))) - (case (text.split-all-with (\ system separator) path) - #.Nil - (\ monad wrap (exception.throw ..cannot-create-directory [path])) - - (#.Cons head tail) - (loop [current head - next tail] - (do (try.with monad) - [_ (..get-directory monad system current)] - (case next - #.Nil - (wrap current) - - (#.Cons head tail) - (recur (format current (\ system separator) head) - tail)))))) + (let [rooted? (text.starts-with? (\ system separator) path) + segments (text.split-all-with (\ system separator) path)] + (case (if rooted? + (list.drop 1 segments) + segments) + #.Nil + (\ monad wrap (exception.throw ..cannot-create-directory [path])) + + (#.Cons head tail) + (loop [current (if rooted? + (format (\ system separator) head) + head) + next tail] + (do (try.with monad) + [_ (..get-directory monad system current)] + (case next + #.Nil + (wrap current) + + (#.Cons head tail) + (recur (format current (\ system separator) head) + tail))))))) diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index 486e5b7b6..eb8a05f9c 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -26,6 +26,8 @@ (: (-> Any (! Environment)) environment) (: (-> Any (! Path)) + home) + (: (-> Any (! Path)) directory) (: (-> Exit (! Nothing)) exit)) @@ -35,17 +37,21 @@ (structure (def: environment (|>> (\ program environment) promise.future)) + (def: home + (|>> (\ program home) promise.future)) (def: directory (|>> (\ program directory) promise.future)) (def: exit (|>> (\ program exit) promise.future)))) -(def: #export (mock environment directory) - (-> Environment Path (Program IO)) +(def: #export (mock environment home directory) + (-> Environment Path Path (Program IO)) (let [@dead? (atom.atom false)] (structure (def: environment (function.constant (io.io environment))) + (def: home + (function.constant (io.io home))) (def: directory (function.constant (io.io directory))) (def: (exit code) @@ -77,6 +83,7 @@ (import: java/lang/System ["#::." (#static getenv [] (java/util/Map java/lang/String java/lang/String)) + (#static getProperty [java/lang/String] #? java/lang/String) (#static exit [int] #io void)]) (def: (jvm\\consume f iterator) @@ -112,11 +119,13 @@ (for {@.old <jvm> @.jvm <jvm>}))) + (def: (home _) + (with-expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] + (for {@.old <jvm> + @.jvm <jvm>}))) + (def: (directory _) - (with-expansions [<jvm> (\ io.monad map - (|>> (dictionary.get "user.dir") - (maybe.default "")) - ..jvm\\environment)] + (with-expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] (for {@.old <jvm> @.jvm <jvm>}))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index aac616597..41d7f9b2f 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -65,14 +65,14 @@ set.to-list (list\map (|>> /repository.remote /repository.async)))) -(def: (with-dependencies console command profile) +(def: (with-dependencies program console command profile) (All [a] - (-> (Console Promise) + (-> (Program Promise) (Console Promise) (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command a)) (Command a))) (do /action.monad - [resolution (/command/deps.do! console (file.async file.default) (..repositories profile) profile)] - ((command console (program.async program.default) (file.async file.default) (shell.async shell.default) resolution) profile))) + [resolution (/command/deps.do! program console (file.async file.default) (..repositories profile) profile)] + ((command console program (file.async file.default) (shell.async shell.default) resolution) profile))) (exception: (cannot-find-repository {repository Text} {options (Dictionary Text Address)}) @@ -118,61 +118,62 @@ (\ program.default exit shell.error)) (#try.Success profile) - (case operation - #/cli.Version - (wrap []) - - #/cli.Clean - (..command - (/command/clean.do! console (file.async file.default) profile)) + (let [program (program.async program.default)] + (case operation + #/cli.Version + (wrap []) + + #/cli.Clean + (..command + (/command/clean.do! console (file.async file.default) profile)) - #/cli.POM - (..command - (/command/pom.do! console (file.async file.default) profile)) - - #/cli.Install - (..command - (/command/install.do! console (file.async file.default) profile)) + #/cli.POM + (..command + (/command/pom.do! console (file.async file.default) profile)) + + #/cli.Install + (..command + (/command/install.do! program console (file.async file.default) profile)) - (#/cli.Deploy repository identity) - (..command - (case [(get@ #/.identity profile) - (dictionary.get repository (get@ #/.deploy-repositories profile))] - [(#.Some artifact) (#.Some repository)] - (/command/deploy.do! console - (/repository.async (/repository.remote repository)) - (file.async file.default) - identity - artifact - profile) + (#/cli.Deploy repository identity) + (..command + (case [(get@ #/.identity profile) + (dictionary.get repository (get@ #/.deploy-repositories profile))] + [(#.Some artifact) (#.Some repository)] + (/command/deploy.do! console + (/repository.async (/repository.remote repository)) + (file.async file.default) + identity + artifact + profile) - [#.None _] - (promise\wrap (exception.throw /.no-identity [])) + [#.None _] + (promise\wrap (exception.throw /.no-identity [])) - [_ #.None] - (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])))) - - #/cli.Dependencies - (..command - (/command/deps.do! console (file.async file.default) (..repositories profile) profile)) + [_ #.None] + (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])))) + + #/cli.Dependencies + (..command + (/command/deps.do! program console (file.async file.default) (..repositories profile) profile)) - (#/cli.Compilation compilation) - (case compilation - #/cli.Build (..command - (..with-dependencies console /command/build.do! profile)) - #/cli.Test (..command - (..with-dependencies console /command/test.do! profile))) + (#/cli.Compilation compilation) + (case compilation + #/cli.Build (..command + (..with-dependencies program console /command/build.do! profile)) + #/cli.Test (..command + (..with-dependencies program console /command/test.do! profile))) - (#/cli.Auto auto) - (do ! - [?watcher watch.default] - (case ?watcher - (#try.Failure error) - (wrap (log! error)) - - (#try.Success watcher) - (..command - (case auto - #/cli.Build (..with-dependencies console (/command/auto.do! watcher /command/build.do!) profile) - #/cli.Test (..with-dependencies console (/command/auto.do! watcher /command/test.do!) profile)))))) + (#/cli.Auto auto) + (do ! + [?watcher watch.default] + (case ?watcher + (#try.Failure error) + (wrap (log! error)) + + (#try.Success watcher) + (..command + (case auto + #/cli.Build (..with-dependencies program console (/command/auto.do! watcher /command/build.do!) profile) + #/cli.Test (..with-dependencies program console (/command/auto.do! watcher /command/test.do!) profile))))))) )))))) diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux index 31403b839..d6a8a70ef 100644 --- a/stdlib/source/program/aedifex/cache.lux +++ b/stdlib/source/program/aedifex/cache.lux @@ -22,6 +22,7 @@ [format ["." xml]]] [world + [program (#+ Program)] ["." file (#+ Path File Directory)]]] ["." // #_ ["#" local] @@ -39,42 +40,44 @@ (file.get-file promise.monad system file))] (!.use (\ file over-write) [content]))) -(def: #export (write-one system [artifact type] package) - (-> (file.System Promise) Dependency Package (Promise (Try Artifact))) - (do (try.with promise.monad) - [directory (: (Promise (Try Path)) - (file.make-directories promise.monad system (//.path system artifact))) - #let [prefix (format directory (\ system separator) (//artifact.identity artifact))] - directory (: (Promise (Try (Directory Promise))) - (file.get-directory promise.monad system directory)) - _ (..write! system - (get@ #//package.library package) - (format prefix (//artifact/extension.extension type))) - _ (..write! system - (|> package - (get@ #//package.sha-1) - (\ //hash.sha-1-codec encode) - encoding.to-utf8) - (format prefix //artifact/extension.sha-1)) - _ (..write! system - (|> package - (get@ #//package.md5) - (\ //hash.md5-codec encode) - encoding.to-utf8) - (format prefix //artifact/extension.md5)) - _ (..write! system - (|> package (get@ #//package.pom) (\ xml.codec encode) encoding.to-utf8) - (format prefix //artifact/extension.pom))] - (wrap artifact))) +(def: #export (write-one program system [artifact type] package) + (-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact))) + (do promise.monad + [home (\ program home [])] + (do (try.with promise.monad) + [directory (: (Promise (Try Path)) + (file.make-directories promise.monad system (//.path system home artifact))) + #let [prefix (format directory (\ system separator) (//artifact.identity artifact))] + directory (: (Promise (Try (Directory Promise))) + (file.get-directory promise.monad system directory)) + _ (..write! system + (get@ #//package.library package) + (format prefix (//artifact/extension.extension type))) + _ (..write! system + (|> package + (get@ #//package.sha-1) + (\ //hash.sha-1-codec encode) + encoding.to-utf8) + (format prefix //artifact/extension.sha-1)) + _ (..write! system + (|> package + (get@ #//package.md5) + (\ //hash.md5-codec encode) + encoding.to-utf8) + (format prefix //artifact/extension.md5)) + _ (..write! system + (|> package (get@ #//package.pom) (\ xml.codec encode) encoding.to-utf8) + (format prefix //artifact/extension.pom))] + (wrap artifact)))) -(def: #export (write-all system resolution) - (-> (file.System Promise) Resolution (Promise (Try (Set Artifact)))) +(def: #export (write-all program system resolution) + (-> (Program Promise) (file.System Promise) Resolution (Promise (Try (Set Artifact)))) (do {! (try.with promise.monad)} [] (|> (dictionary.entries resolution) (list.filter (|>> product.right //package.local? not)) (monad.map ! (function (_ [dependency package]) - (..write-one system dependency package))) + (..write-one program system dependency package))) (\ ! map (set.from-list //artifact.hash))))) (def: (read! system path) @@ -92,11 +95,13 @@ (_\map (\ codec decode)) _\join))) -(def: #export (read-one system [artifact type]) - (-> (file.System Promise) Dependency (Promise (Try Package))) - (let [prefix (format (//.path system artifact) - (\ system separator) - (//artifact.identity artifact))] +(def: #export (read-one program system [artifact type]) + (-> (Program Promise) (file.System Promise) Dependency (Promise (Try Package))) + (do promise.monad + [home (\ program home []) + #let [prefix (format (//.path system home artifact) + (\ system separator) + (//artifact.identity artifact))]] (do (try.with promise.monad) [pom (..read! system (format prefix //artifact/extension.pom)) library (..read! system (format prefix (//artifact/extension.extension type))) @@ -113,8 +118,8 @@ #//package.sha-1 sha-1 #//package.md5 md5})))))) -(def: #export (read-all system dependencies resolution) - (-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution))) +(def: #export (read-all program system dependencies resolution) + (-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution))) (case dependencies #.Nil (\ (try.with promise.monad) wrap resolution) @@ -126,8 +131,8 @@ (wrap (#try.Success package)) #.None - (..read-one system head))] - (with-expansions [<next> (as-is (read-all system tail resolution))] + (..read-one program system head))] + (with-expansions [<next> (as-is (read-all program system tail resolution))] (case package (#try.Success package) (do (try.with promise.monad) @@ -136,7 +141,7 @@ (\ promise.monad wrap)) resolution (|> resolution (dictionary.put head package) - (read-all system (set.to-list sub-dependencies)))] + (read-all program system (set.to-list sub-dependencies)))] <next>) (#try.Failure error) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 8960d9c75..de8ceb991 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -101,11 +101,11 @@ _ (exception.throw ..no-available-compiler []))) -(def: (libraries fs) - (All [!] (-> (file.System !) Resolution (List Path))) +(def: (libraries fs home) + (All [!] (-> (file.System !) Path Resolution (List Path))) (|>> dictionary.keys (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux-library))) - (list\map (|>> (get@ #///dependency.artifact) (///local.path fs))))) + (list\map (|>> (get@ #///dependency.artifact) (///local.path fs home))))) (def: (singular name) (-> Text Text (List Text)) @@ -132,13 +132,14 @@ [(#.Some program-module) (#.Some target)] (do promise.monad [environment (\ program environment []) + home (\ program home []) working-directory (\ program directory [])] (do ///action.monad [[resolution compiler] (promise\wrap (..compiler resolution)) #let [[command output] (let [[compiler output] (case compiler - (#JVM artifact) [(///runtime.java (///local.path fs artifact)) + (#JVM artifact) [(///runtime.java (///local.path fs home artifact)) "program.jar"] - (#JS artifact) [(///runtime.node (///local.path fs artifact)) + (#JS artifact) [(///runtime.node (///local.path fs home artifact)) "program.js"])] [(format compiler " build") output]) / (\ fs separator) @@ -148,7 +149,7 @@ [environment working-directory command - (list.concat (list (..plural "--library" (..libraries fs resolution)) + (list.concat (list (..plural "--library" (..libraries fs home resolution)) (..plural "--source" (set.to-list (get@ #///.sources profile))) (..singular "--target" cache-directory) (..singular "--module" program-module)))]) diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index 67dc19e47..dbb277948 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -9,6 +9,7 @@ [collection ["." set (#+ Set)]]] [world + [program (#+ Program)] ["." file] ["." console (#+ Console)]]] ["." // #_ @@ -23,12 +24,12 @@ ["#." dependency #_ ["#/." resolution (#+ Resolution)]]]]) -(def: #export (do! console fs repositories profile) - (-> (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution)) +(def: #export (do! program console fs repositories profile) + (-> (Program Promise) (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution)) (do ///action.monad [#let [dependencies (set.to-list (get@ #///.dependencies profile))] - cache (///cache.read-all fs dependencies ///dependency/resolution.empty) + cache (///cache.read-all program fs dependencies ///dependency/resolution.empty) resolution (///dependency/resolution.all repositories dependencies cache) - cached (///cache.write-all fs resolution) + cached (///cache.write-all program fs resolution) _ (console.write-line //clean.success console)] (wrap resolution))) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 327a0c119..d11d96a0c 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -21,6 +21,7 @@ ["." tar] ["." xml]]] [world + [program (#+ Program)] ["." file (#+ Path File)] ["." console (#+ Console)]]] [program @@ -47,21 +48,23 @@ (def: #export failure "Failure: No 'identity' defined for the project.") -(def: #export (do! console system profile) - (-> (Console Promise) (file.System Promise) (Command Any)) +(def: #export (do! program console system profile) + (-> (Program Promise) (Console Promise) (file.System Promise) (Command Any)) (case (get@ #/.identity profile) (#.Some identity) - (do ///action.monad - [package (export.library system (set.to-list (get@ #/.sources profile))) - repository (: (Promise (Try Path)) - (file.make-directories promise.monad system (///local.path system identity))) - #let [artifact-name (format repository (\ system separator) (///artifact.identity identity))] - _ (..save! system (binary.run tar.writer package) - (format artifact-name ///artifact/extension.lux-library)) - pom (\ promise.monad wrap (///pom.write profile)) - _ (..save! system (|> pom (\ xml.codec encode) encoding.to-utf8) - (format artifact-name ///artifact/extension.pom))] - (console.write-line //clean.success console)) + (do promise.monad + [home (\ program home [])] + (do ///action.monad + [package (export.library system (set.to-list (get@ #/.sources profile))) + repository (: (Promise (Try Path)) + (file.make-directories promise.monad system (///local.path system home identity))) + #let [artifact-name (format repository (\ system separator) (///artifact.identity identity))] + _ (..save! system (binary.run tar.writer package) + (format artifact-name ///artifact/extension.lux-library)) + pom (\ promise.monad wrap (///pom.write profile)) + _ (..save! system (|> pom (\ xml.codec encode) encoding.to-utf8) + (format artifact-name ///artifact/extension.pom))] + (console.write-line //clean.success console))) _ (console.write-line ..failure console))) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index 34547027d..e1927e577 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -8,13 +8,13 @@ ["." // #_ ["#." artifact (#+ Artifact)]]) -(def: #export (repository system) - (All [a] (-> (file.System a) Path)) +(def: #export (repository system home) + (All [a] (-> (file.System a) Path Path)) (let [/ (\ system separator)] - (format "~" / ".m2" / "repository"))) + (format home / ".m2" / "repository"))) -(def: #export (path system artifact) - (All [a] (-> (file.System a) Artifact Path)) - (format (..repository system) +(def: #export (path system home artifact) + (All [a] (-> (file.System a) Path Artifact Path)) + (format (..repository system home) (\ system separator) (//artifact.path system artifact))) diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index bc2ced5a3..b649f333b 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -54,7 +54,10 @@ source-code (tar.content source-code)] (wrap (#tar.Normal [path (instant.from-millis +0) - tar.none + ($_ tar.and + tar.read-by-owner tar.write-by-owner + tar.read-by-group tar.write-by-group + tar.read-by-other) ..no-ownership source-code]))))) (\ try.monad map row.from-list) diff --git a/stdlib/source/spec/lux/abstract/hash.lux b/stdlib/source/spec/lux/abstract/hash.lux new file mode 100644 index 000000000..a87846d1c --- /dev/null +++ b/stdlib/source/spec/lux/abstract/hash.lux @@ -0,0 +1,22 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." bit ("#\." equivalence)] + [number + ["n" nat]]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(def: #export (spec (^open "\.") generator) + (All [a] (-> (/.Hash a) (Random a) Test)) + (do random.monad + [parameter generator + subject generator] + (_.cover [/.Hash] + (bit\= (\= parameter subject) + (n.= (\hash parameter) (\hash subject)))))) diff --git a/stdlib/source/spec/lux/world/program.lux b/stdlib/source/spec/lux/world/program.lux index 1d09908bf..f7f848ed3 100644 --- a/stdlib/source/spec/lux/world/program.lux +++ b/stdlib/source/spec/lux/world/program.lux @@ -23,9 +23,11 @@ [exit random.int] (wrap (do promise.monad [environment (\ subject environment []) + home (\ subject home []) directory (\ subject directory [])] (_.cover' [/.Program] (and (not (dictionary.empty? environment)) (list.every? (|>> text.empty? not) (dictionary.keys environment)) + (not (text.empty? home)) (not (text.empty? directory)))))))) diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index 7923eb8c5..0bb0aea68 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -6,7 +6,9 @@ [control ["." try] [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise)]] + [parser + ["." environment]]] [data [binary (#+ Binary)] ["." text] @@ -20,7 +22,8 @@ [math ["." random (#+ Random) ("#\." monad)]] [world - ["." file]]] + ["." file] + ["." program]]] [// ["@." profile] ["@." artifact] @@ -96,11 +99,14 @@ Test (do {! random.monad} [[dependency expected-package] ..package + home (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5) #let [fs (: (file.System Promise) - (file.mock (\ file.default separator)))]] + (file.mock (\ file.default separator))) + program (program.async (program.mock environment.empty home working-directory))]] (wrap (do promise.monad - [wrote! (/.write-one fs dependency expected-package) - read! (/.read-one fs dependency)] + [wrote! (/.write-one program fs dependency expected-package) + read! (/.read-one program fs dependency)] (_.cover' [/.write-one /.read-one] (<| (try.default false) (do try.monad @@ -114,11 +120,14 @@ Test (do {! random.monad} [expected ..resolution + home (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5) #let [fs (: (file.System Promise) - (file.mock (\ file.default separator)))]] + (file.mock (\ file.default separator))) + program (program.async (program.mock environment.empty home working-directory))]] (wrap (do promise.monad - [wrote! (/.write-all fs expected) - read! (/.read-all fs (dictionary.keys expected) //dependency/resolution.empty)] + [wrote! (/.write-all program fs expected) + read! (/.read-all program fs (dictionary.keys expected) //dependency/resolution.empty)] (_.cover' [/.write-all /.read-all] (<| (try.default false) (do try.monad diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 48b2a7eb3..c43d8642f 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -80,6 +80,7 @@ end-signal (random.ascii/alpha 5) program (random.ascii/alpha 5) target (random.ascii/alpha 5) + home (random.ascii/alpha 5) working-directory (random.ascii/alpha 5) expected-runs (\ ! map (|>> (n.% 10) (n.max 2)) random.nat) source (random.ascii/alpha 5) @@ -107,7 +108,7 @@ (do promise.monad [outcome ((/.do! watcher command) (@version.echo "") - (program.async (program.mock environment.empty working-directory)) + (program.async (program.mock environment.empty home working-directory)) fs (@build.good-shell []) resolution diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 74508ef3d..025d01c0b 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -101,6 +101,7 @@ shell (..good-shell [])] program (random.ascii/alpha 5) target (random.ascii/alpha 5) + home (random.ascii/alpha 5) working-directory (random.ascii/alpha 5) #let [empty-profile (: Profile (\ ///.monoid identity)) @@ -114,7 +115,7 @@ with-target)]] ($_ _.and (wrap (do promise.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working-directory)) fs shell ///dependency/resolution.empty (with-target empty-profile))] (_.cover' [/.no-specified-program] (case outcome @@ -124,7 +125,7 @@ (#try.Failure error) (exception.match? /.no-specified-program error))))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working-directory)) fs shell ///dependency/resolution.empty (with-program empty-profile))] (_.cover' [/.no-specified-target] (case outcome @@ -134,7 +135,7 @@ (#try.Failure error) (exception.match? /.no-specified-target error))))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty profile)] + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working-directory)) fs shell ///dependency/resolution.empty profile)] (_.cover' [/.Compiler /.no-available-compiler] (case outcome (#try.Success _) @@ -147,7 +148,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs shell resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working-directory)) fs shell resolution profile) start (!.use (\ console read-line) []) end (!.use (\ console read-line) [])] (wrap (and (text\= /.start start) @@ -161,7 +162,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs (..bad-shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working-directory)) fs (..bad-shell []) resolution profile) start (!.use (\ console read-line) []) end (!.use (\ console read-line) [])] (wrap (and (text\= /.start start) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 773069322..eafd1f968 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -9,7 +9,9 @@ [concurrency ["." promise (#+ Promise)]] [security - ["!" capability]]] + ["!" capability]] + [parser + ["." environment (#+ Environment)]]] [data ["." maybe] ["." binary] @@ -26,7 +28,8 @@ [math ["." random (#+ Random)]] [world - ["." file (#+ Path File)]]] + ["." file (#+ Path File)] + ["." program (#+ Program)]]] [program [compositor ["." export]]] @@ -66,17 +69,19 @@ (file.get-file promise.monad fs (format head (\ fs separator) head ".lux")))] (recur tail))))) -(def: (execute! repository fs identity artifact profile) - (-> (Repository Promise) (file.System Promise) +(def: (execute! program repository fs identity artifact profile) + (-> (Program Promise) (Repository Promise) (file.System Promise) Identity Artifact ///.Profile (Promise (Try Text))) - (do ///action.monad - [#let [console (@version.echo "")] - _ (..make-sources! fs (get@ #///.sources profile)) - _ (: (Promise (Try Path)) - (file.make-directories promise.monad fs (///local.repository fs))) - _ (/.do! console repository fs identity artifact profile)] - (!.use (\ console read-line) []))) + (do promise.monad + [home (\ program home [])] + (do ///action.monad + [#let [console (@version.echo "")] + _ (..make-sources! fs (get@ #///.sources profile)) + _ (: (Promise (Try Path)) + (file.make-directories promise.monad fs (///local.repository fs home))) + _ (/.do! console repository fs identity artifact profile)] + (!.use (\ console read-line) [])))) (def: #export test Test @@ -91,12 +96,15 @@ @profile.random) identity @repository.identity + home (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5) #let [repository (///repository.mock (@repository.simulation identity) @repository.empty) - fs (file.mock (\ file.default separator))]] + fs (file.mock (\ file.default separator)) + program (program.async (program.mock environment.empty home working-directory))]] (wrap (do {! promise.monad} [verdict (do {! ///action.monad} - [logging (..execute! repository fs identity artifact profile) + [logging (..execute! program repository fs identity artifact profile) expected-library (|> profile (get@ #///.sources) set.to-list diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 5b9dd87da..292185a28 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -9,7 +9,9 @@ [concurrency ["." promise]] [security - ["!" capability]]] + ["!" capability]] + [parser + ["." environment]]] [data ["." text ("#\." equivalence) ["%" format (#+ format)]] @@ -19,6 +21,7 @@ [math ["." random (#+ Random)]] [world + ["." program] ["." file]]] ["." // #_ ["@." version] @@ -47,7 +50,10 @@ Test (<| (_.covering /._) (do random.monad - [dependee-artifact $///artifact.random + [home (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5) + + dependee-artifact $///artifact.random depender-artifact (random.filter (predicate.complement (\ ///artifact.equivalence = dependee-artifact)) $///artifact.random) @@ -77,16 +83,17 @@ (set@ #///package.origin #///package.Remote) (set@ #///package.pom depender-pom)) - fs (file.mock (\ file.default separator))]] + fs (file.mock (\ file.default separator)) + program (program.async (program.mock environment.empty home working-directory))]] (wrap (do promise.monad [verdict (do ///action.monad [#let [console (@version.echo "")] pre (|> ///dependency/resolution.empty (dictionary.put dependee dependee-package) - (///cache.write-all fs)) + (///cache.write-all program fs)) post (|> (\ ///.monoid identity) (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee depender))) - (/.do! console fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) [])))) + (/.do! program console fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) [])))) logging! (\ ///action.monad map (text\= //clean.success) (!.use (\ console read-line) []))] diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 2dbddeaa3..9ffa65bab 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -9,7 +9,9 @@ [concurrency ["." promise (#+ Promise)]] [security - ["!" capability]]] + ["!" capability]] + [parser + ["." environment (#+ Environment)]]] [data ["." maybe] ["." binary] @@ -23,7 +25,8 @@ [math ["." random (#+ Random)]] [world - ["." file (#+ Path File)]]] + ["." file (#+ Path File)] + ["." program (#+ Program)]]] [// ["@." version] [// @@ -58,15 +61,17 @@ (file.get-file promise.monad fs (format head (\ fs separator) head ".lux")))] (recur tail))))) -(def: (execute! fs sample) - (-> (file.System Promise) ///.Profile (Promise (Try Text))) - (do ///action.monad - [#let [console (@version.echo "")] - _ (..make-sources! fs (get@ #///.sources sample)) - _ (: (Promise (Try Path)) - (file.make-directories promise.monad fs (///local.repository fs))) - _ (/.do! console fs sample)] - (!.use (\ console read-line) []))) +(def: (execute! program fs sample) + (-> (Program Promise) (file.System Promise) ///.Profile (Promise (Try Text))) + (do promise.monad + [home (\ program home [])] + (do ///action.monad + [#let [console (@version.echo "")] + _ (..make-sources! fs (get@ #///.sources sample)) + _ (: (Promise (Try Path)) + (file.make-directories promise.monad fs (///local.repository fs home))) + _ (/.do! program console fs sample)] + (!.use (\ console read-line) [])))) (def: #export test Test @@ -74,13 +79,16 @@ (do {! random.monad} [identity @artifact.random sample (\ ! map (set@ #///.identity (#.Some identity)) - @profile.random)] + @profile.random) + home (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5)] ($_ _.and (wrap (do {! promise.monad} - [#let [fs (file.mock (\ file.default separator))] + [#let [fs (file.mock (\ file.default separator)) + program (program.async (program.mock environment.empty home working-directory))] verdict (do ///action.monad - [logging (..execute! fs sample) - #let [artifact-path (format (///local.path fs identity) + [logging (..execute! program fs sample) + #let [artifact-path (format (///local.path fs home identity) (\ fs separator) (///artifact.identity identity)) library-path (format artifact-path ///artifact/extension.lux-library) @@ -98,8 +106,9 @@ (_.cover' [/.do!] (try.default false verdict)))) (wrap (do {! promise.monad} - [#let [fs (file.mock (\ file.default separator))] - logging (..execute! fs (set@ #///.identity #.None sample))] + [#let [fs (file.mock (\ file.default separator)) + program (program.async (program.mock environment.empty home working-directory))] + logging (..execute! program fs (set@ #///.identity #.None sample))] (_.cover' [/.failure] (|> logging (try\map (text\= /.failure)) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index f87e70e85..b63662bc0 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -44,6 +44,7 @@ (do {! random.monad} [program (random.ascii/alpha 5) target (random.ascii/alpha 5) + home (random.ascii/alpha 5) working-directory (random.ascii/alpha 5) #let [empty-profile (: Profile (\ ///.monoid identity)) @@ -61,7 +62,7 @@ console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs (@build.good-shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working-directory)) fs (@build.good-shell []) resolution profile) build-start (!.use (\ console read-line) []) build-end (!.use (\ console read-line) []) test-start (!.use (\ console read-line) []) @@ -95,7 +96,7 @@ shell.normal shell.error)])))))) [])] - _ (/.do! console (program.async (program.mock environment.empty working-directory)) fs bad-shell resolution profile) + _ (/.do! console (program.async (program.mock environment.empty home working-directory)) fs bad-shell resolution profile) build-start (!.use (\ console read-line) []) build-end (!.use (\ console read-line) []) test-start (!.use (\ console read-line) []) diff --git a/stdlib/source/test/aedifex/local.lux b/stdlib/source/test/aedifex/local.lux index 1d90ff905..b95bf2e19 100644 --- a/stdlib/source/test/aedifex/local.lux +++ b/stdlib/source/test/aedifex/local.lux @@ -24,12 +24,13 @@ (<| (_.covering /._) (do {! random.monad} [sample @artifact.random + home (random.ascii/alpha 5) #let [fs (: (file.System Promise) (file.mock (\ file.default separator)))]] ($_ _.and (_.cover [/.repository /.path] - (let [path (/.path fs sample)] - (and (text.starts-with? (/.repository fs) + (let [path (/.path fs home sample)] + (and (text.starts-with? (/.repository fs home) path) (text.ends-with? (//artifact.path fs sample) path)))) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index 9fd3986b8..b31c10617 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -8,6 +8,7 @@ ["#/." cofree]] ["#." enum] ["#." equivalence] + ["#." hash] ["#." fold] ["#." functor ["#/." contravariant]] @@ -46,6 +47,7 @@ /codec.test /enum.test /equivalence.test + /hash.test /fold.test /interval.test /monoid.test diff --git a/stdlib/source/test/lux/abstract/hash.lux b/stdlib/source/test/lux/abstract/hash.lux new file mode 100644 index 000000000..d829d489e --- /dev/null +++ b/stdlib/source/test/lux/abstract/hash.lux @@ -0,0 +1,37 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + [functor + ["$." contravariant]]]}] + [data + [number + ["n" nat] + ["i" int]]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(def: #export test + Test + (do random.monad + [left random.int + right random.nat] + (<| (_.covering /._) + ($_ _.and + (_.cover [/.sum] + (let [hash (/.sum i.hash n.hash)] + (and (n.= (\ i.hash hash left) + (\ hash hash (#.Left left))) + (n.= (\ n.hash hash right) + (\ hash hash (#.Right right)))))) + (_.cover [/.product] + (let [hash (/.product i.hash n.hash)] + (n.= (n.+ (\ i.hash hash left) + (\ n.hash hash right)) + (\ hash hash [left right])))) + )))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 5c47eab5e..0b750b9cc 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -158,7 +158,7 @@ (wrap (and (n.= 1 output-1) (n.= 2 output-2) (n.= 3 output-3))))] - (_.cover' [/.actor: /.message: /.tell!] + (_.cover' [/.Message /.actor: /.message: /.tell!] (case result (#try.Success outcome) outcome @@ -221,6 +221,6 @@ (wrap agent))) _ (/.await agent) actual (promise.future (atom.read sink))] - (_.cover' [/.observe] + (_.cover' [/.Stop /.observe /.await] (\ (list.equivalence n.equivalence) = expected (row.to-list actual)))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index bd980cd55..04dd1c220 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -49,19 +49,18 @@ (<| (_.covering /._) (do {! random.monad} [to-wait (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) - #let [extra-time (n.* 2 to-wait)] expected random.nat dummy random.nat #let [not-dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))] leftE not-dummy rightE not-dummy] ($_ _.and - (_.with-cover [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.with-cover [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.with-cover [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) (wrap (do /.monad [#let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] @@ -150,8 +149,8 @@ (and yep (not nope))))) (wrap (do /.monad - [?none (/.time-out to-wait (/.delay extra-time dummy)) - ?actual (/.time-out extra-time (/.delay to-wait expected))] + [?none (/.time-out 0 (/.delay to-wait dummy)) + ?actual (/.time-out to-wait (wrap expected))] (_.cover' [/.time-out] (case [?none ?actual] [#.None (#.Some actual)] diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 5a80af5a7..78cae485a 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -22,19 +22,7 @@ ["#/." json] ["#/." tar] ["#/." xml]] - [number - ["#." i8] - ["#." i16] - ["#." i32] - ["#." i64] - ["#." nat] - ["#." int] - ["#." rev] - ["#." frac] - ["#." ratio] - ["#." complex]] - ["#." text - ["#/." regex]] + ["#." text] ["#." collection]]) ## TODO: Get rid of this ASAP @@ -44,12 +32,6 @@ [_ (wrap [])] body))) -(def: text - ($_ _.and - /text.test - /text/regex.test - )) - (def: format ($_ _.and /format/binary.test @@ -75,7 +57,7 @@ /product.test) test2 ($_ _.and /sum.test - ..text + /text.test ..format /collection.test )] diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index 82d459d10..8fa84d273 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -8,6 +8,7 @@ {[0 #spec] [/ ["$." equivalence] + ["$." hash] ["$." monoid] ["$." codec]]}] [control @@ -23,6 +24,8 @@ ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence random.bit)) + (_.for [/.hash] + ($hash.spec /.hash random.bit)) (_.for [/.disjunction] ($monoid.spec /.equivalence /.disjunction random.bit)) (_.for [/.conjunction] diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 1e7896faf..76075ba0b 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -6,6 +6,7 @@ {[0 #spec] [/ ["$." equivalence] + ["$." hash] ["$." monoid]]}] [data [number @@ -22,7 +23,7 @@ {1 ["." / (#+ Color)]}) -(def: #export color +(def: #export random (Random Color) (|> ($_ random.and random.nat random.nat random.nat) (\ random.monad map /.from-rgb))) @@ -85,10 +86,10 @@ (def: transformation Test (do random.monad - [colorful (|> ..color + [colorful (|> ..random (random.filter (function (_ color) (|> (distance/3 color /.black) (f.>= +100.0)))) (random.filter (function (_ color) (|> (distance/3 color /.white) (f.>= +100.0))))) - mediocre (|> ..color + mediocre (|> ..random (random.filter (|>> saturation ((function (_ saturation) (and (f.>= +0.25 saturation) @@ -175,14 +176,16 @@ (<| (_.covering /._) (_.for [/.Color]) (do {! random.monad} - [expected ..color] + [expected ..random] ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..color)) + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) (_.for [/.addition] - ($monoid.spec /.equivalence /.addition ..color)) + ($monoid.spec /.equivalence /.addition ..random)) (_.for [/.subtraction] - ($monoid.spec /.equivalence /.addition ..color)) + ($monoid.spec /.equivalence /.addition ..random)) (..encoding expected) (_.cover [/.complement] diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index c28f89451..2807dac8d 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -85,14 +85,14 @@ (and (/.< left (/.* left right)) (/.< right (/.* left right))))) (do {! random.monad} - [#let [dividend (\ ! map (i64.and (hex "FF")) + [#let [dividend (\ ! map (i64.and (hex "FFFF")) random.rev) divisor (\ ! map (|>> (i64.and (hex "F")) (i64.or (hex "1")) (i64.rotate-right 8) .rev) random.nat)] - dividend dividend + dividend (random.filter (/.> .0) dividend) divisor/0 divisor divisor/1 (random.filter (|>> (/.= divisor/0) not) divisor) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 778559483..cd03b89fc 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -19,6 +19,9 @@ ["." set]]] [math ["." random]]] + ["." / #_ + ["#." buffer] + ["#." regex]] {1 ["." /]}) @@ -292,4 +295,7 @@ (_.cover [/.replace-all] (/\= sample2 (/.replace-all sep1 sep2 sample1)))) + + /buffer.test + /regex.test ))) diff --git a/stdlib/source/test/lux/data/text/buffer.lux b/stdlib/source/test/lux/data/text/buffer.lux new file mode 100644 index 000000000..a12d57fc5 --- /dev/null +++ b/stdlib/source/test/lux/data/text/buffer.lux @@ -0,0 +1,43 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." text ("#\." equivalence) + ["%" format (#+ format)]] + [number + ["n" nat]]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(def: part + (Random Text) + (do {! random.monad} + [size (\ ! map (|>> (n.% 10) inc) random.nat)] + (random.ascii/alpha size))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Buffer]) + (do random.monad + [left ..part + mid ..part + right ..part] + ($_ _.and + (_.cover [/.empty] + (n.= 0(/.size /.empty))) + (_.cover [/.size /.append] + (n.= (text.size left) + (/.size (/.append left /.empty)))) + (_.cover [/.text] + (text\= (format left mid right) + (|> /.empty + (/.append left) + (/.append mid) + (/.append right) + /.text))) + )))) diff --git a/stdlib/source/test/lux/world/program.lux b/stdlib/source/test/lux/world/program.lux index 531ba0095..91484bf50 100644 --- a/stdlib/source/test/lux/world/program.lux +++ b/stdlib/source/test/lux/world/program.lux @@ -23,7 +23,7 @@ (random.ascii/alpha 5) (random.ascii/alpha 5))) -(def: directory +(def: path (Random Path) (random.ascii/alpha 5)) @@ -32,8 +32,9 @@ (<| (_.covering /._) (do random.monad [environment ..environment - directory ..directory] + home ..path + directory ..path] ($_ _.and (_.for [/.mock /.async] - ($/.spec (/.async (/.mock environment directory)))) + ($/.spec (/.async (/.mock environment home directory)))) )))) |