diff options
Diffstat (limited to 'stdlib')
21 files changed, 876 insertions, 498 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 3fafb38f5..9655f0afa 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -3045,7 +3045,7 @@ (` ((~ (local_symbol$ name)) (~+ args))))] (in_meta (list (` (..def: (~ export_policy) (~ usage) (~ type) - (implementation + (..implementation (~+ definitions))))))) {#None} diff --git a/stdlib/source/library/lux/control/maybe.lux b/stdlib/source/library/lux/control/maybe.lux index 205311737..a8d97f232 100644 --- a/stdlib/source/library/lux/control/maybe.lux +++ b/stdlib/source/library/lux/control/maybe.lux @@ -26,8 +26,8 @@ {.#None} my - {.#Some x} - {.#Some x}))) + _ + mx))) (implementation: .public functor (Functor Maybe) diff --git a/stdlib/source/library/lux/ffi/node_js.js.lux b/stdlib/source/library/lux/ffi/node_js.js.lux new file mode 100644 index 000000000..2828c1fea --- /dev/null +++ b/stdlib/source/library/lux/ffi/node_js.js.lux @@ -0,0 +1,25 @@ +(.using + [library + [lux "*" + ["[0]" ffi] + [control + ["[0]" function] + ["[0]" maybe ("[1]#[0]" monoid functor)]]]]) + +(template [<name> <path>] + [(def: <name> + (Maybe (-> Text Any)) + (ffi.constant (-> Text Any) <path>))] + + [normal_require [require]] + [global_require [global require]] + [process_load [global process mainModule constructor _load]] + ) + +(def: .public (require module) + (-> Text (Maybe Any)) + (maybe#each (function.on module) + ($_ maybe#composite + ..normal_require + ..global_require + ..process_load))) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 59d7ce5e0..e7c3bae01 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -47,7 +47,7 @@ [meta ["[0]" archive {"+" Archive} ["[0]" descriptor {"+" Module}] - ["[0]" artifact] + ["[0]" registry {"+" Registry}] ["[0]" document]]]] ]) @@ -117,7 +117,7 @@ (type: (Payload directive) [(///generation.Buffer directive) - artifact.Registry]) + Registry]) (def: (begin dependencies hash input) (-> (List Module) Nat ///.Input @@ -134,7 +134,7 @@ .let [source (///analysis.source (value@ ///.#module input) (value@ ///.#code input))] _ (///analysis.set_source_code source)] (in [source [///generation.empty_buffer - artifact.empty]]))))) + registry.empty]]))))) (def: (end module) (-> Module diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index d78c5d4f7..fd852c4ce 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -51,7 +51,8 @@ ["[0]" module]]]]] [meta ["[0]" archive {"+" Output Archive} - ["[0]" artifact {"+" Registry}] + [registry {"+" Registry}] + ["[0]" artifact] ["[0]" descriptor {"+" Descriptor Module}] ["[0]" document {"+" Document}]] [io {"+" Context} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index ac37f48aa..a65131c3a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -32,7 +32,8 @@ [meta ["[0]" archive {"+" Archive} ["[0]" descriptor {"+" Module}] - ["[0]" artifact]]]]]) + ["[0]" artifact] + ["[0]" registry {"+" Registry}]]]]]) (type: .public Context [archive.ID artifact.ID]) @@ -75,7 +76,7 @@ #anchor (Maybe anchor) #host (Host expression directive) #buffer (Maybe (Buffer directive)) - #registry artifact.Registry + #registry Registry #counter Nat #context (Maybe artifact.ID) #log (Sequence Text) @@ -102,7 +103,7 @@ #anchor {.#None} #host host #buffer {.#None} - #registry artifact.empty + #registry registry.empty #counter 0 #context {.#None} #log sequence.empty @@ -164,13 +165,13 @@ (def: .public get_registry (All (_ anchor expression directive) - (Operation anchor expression directive artifact.Registry)) + (Operation anchor expression directive Registry)) (function (_ (^@ stateE [bundle state])) {try.#Success [stateE (value@ #registry state)]})) (def: .public (set_registry value) (All (_ anchor expression directive) - (-> artifact.Registry (Operation anchor expression directive Any))) + (-> Registry (Operation anchor expression directive Any))) (function (_ [bundle state]) {try.#Success [[bundle (with@ #registry value state)] []]})) @@ -255,12 +256,12 @@ {try.#Success [[bundle (with@ #registry registry' state)] id]}))))] - [mandatory? [mandatory?] [Bit] learn artifact.definition] - [#1 [] [] learn_custom artifact.custom] - [#0 [] [] learn_analyser artifact.analyser] - [#0 [] [] learn_synthesizer artifact.synthesizer] - [#0 [] [] learn_generator artifact.generator] - [#0 [] [] learn_directive artifact.directive] + [mandatory? [mandatory?] [Bit] learn registry.definition] + [#1 [] [] learn_custom registry.custom] + [#0 [] [] learn_analyser registry.analyser] + [#0 [] [] learn_synthesizer registry.synthesizer] + [#0 [] [] learn_generator registry.generator] + [#0 [] [] learn_directive registry.directive] ) (exception: .public (unknown_definition [name Symbol @@ -282,9 +283,9 @@ (do try.monad [[descriptor document] (archive.find _module archive)] {try.#Success (value@ descriptor.#registry descriptor)}))] - (case (artifact.remember _name registry) + (case (registry.remember _name registry) {.#None} - (exception.except ..unknown_definition [name (artifact.definitions registry)]) + (exception.except ..unknown_definition [name (registry.definitions registry)]) {.#Some id} {try.#Success [stateE [module_id id]]}))))) @@ -328,7 +329,7 @@ (-> Archive (Set artifact.Dependency) (Operation anchor expression directive a) (Operation anchor expression directive [Context a]))) (function (_ (^@ stateE [bundle state])) - (let [[id registry'] (artifact.resource false dependencies (value@ #registry state))] + (let [[id registry'] (registry.resource false dependencies (value@ #registry state))] (do try.monad [[[bundle' state'] output] (body [bundle (|> state (with@ #registry registry') diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index b59f57dc5..e9f88652c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -59,7 +59,8 @@ [meta [io {"+" lux_context}] [archive {"+" Output Archive} - ["[0]" artifact {"+" Registry}]]]]]]]) + ["[0]" artifact] + ["[0]" registry {"+" Registry}]]]]]]]) (type: .public Byte_Code Binary) @@ -629,10 +630,10 @@ [runtime_payload ..generate_runtime ... _ ..generate_function ] - (in [(|> artifact.empty - (artifact.resource .true artifact.no_dependencies) + (in [(|> registry.empty + (registry.resource .true artifact.no_dependencies) product.right - ... (artifact.resource .true artifact.no_dependencies) + ... (registry.resource .true artifact.no_dependencies) ... product.right ) (sequence.sequence runtime_payload diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux index 6692af0d1..176ab28ed 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux @@ -19,7 +19,7 @@ [meta ["[0]" archive {"+" Archive} ["[0]" descriptor {"+" Module}] - ["[0]" artifact]]]]]) + ["[0]" registry {"+" Registry}]]]]]) (type: .public (Program expression directive) (-> Context expression directive)) @@ -45,7 +45,7 @@ (in [[module id] (value@ descriptor.#registry descriptor)])))))] (case (list.one (function (_ [[module module_id] registry]) (do maybe.monad - [program_id (artifact.remember ..name registry)] + [program_id (registry.remember ..name registry)] (in [module_id program_id]))) registries) {.#Some program_context} diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux index 8f636a0b2..3c6a9638b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -2,28 +2,16 @@ [library [lux "*" [abstract - [monad {"+" do}]] - [control - [pipe {"+" case>}] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<[0]>" binary {"+" Parser}]]] + [equivalence {"+" Equivalence}]] [data ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] + ["[0]" bit] + ["[0]" text ("[1]#[0]" equivalence)] [collection - ["[0]" list] - ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" set {"+" Set}]] - [format - ["[0]" binary {"+" Writer}]]] + ["[0]" set {"+" Set}]]] [math [number - ["[0]" nat]]] - [type - abstract]]]) + ["[0]" nat]]]]]) (type: .public ID Nat) @@ -38,10 +26,31 @@ {#Directive Text} {#Custom Text})) +(implementation: category_equivalence + (Equivalence Category) + + (def: (= left right) + (case [left right] + [{#Anonymous} {#Anonymous}] + true + + (^template [<tag>] + [[{<tag> left} {<tag> right}] + (text#= left right)]) + ([#Definition] + [#Analyser] + [#Synthesizer] + [#Generator] + [#Directive] + [#Custom]) + + _ + false))) + (type: .public Dependency [Nat ID]) -(def: dependency_hash +(def: .public dependency_hash (product.hash nat.hash nat.hash)) (def: .public no_dependencies @@ -55,147 +64,11 @@ #mandatory? Bit #dependencies (Set Dependency)])) -(abstract: .public Registry - (Record - [#artifacts (Sequence Artifact) - #resolver (Dictionary Text ID)]) - - (def: .public empty - Registry - (:abstraction [#artifacts sequence.empty - #resolver (dictionary.empty text.hash)])) - - (def: .public artifacts - (-> Registry (Sequence Artifact)) - (|>> :representation (value@ #artifacts))) - - (def: next - (-> Registry ID) - (|>> ..artifacts sequence.size)) - - (def: .public (resource mandatory? dependencies registry) - (-> Bit (Set Dependency) Registry [ID Registry]) - (let [id (..next registry)] - [id - (|> registry - :representation - (revised@ #artifacts (sequence.suffix [#id id - #category {#Anonymous} - #mandatory? mandatory? - #dependencies dependencies])) - :abstraction)])) - - (template [<tag> <create> <fetch>] - [(def: .public (<create> name mandatory? dependencies registry) - (-> Text Bit (Set Dependency) Registry [ID Registry]) - (let [id (..next registry)] - [id - (|> registry - :representation - (revised@ #artifacts (sequence.suffix [#id id - #category {<tag> name} - #mandatory? mandatory? - #dependencies dependencies])) - (revised@ #resolver (dictionary.has name id)) - :abstraction)])) - - (def: .public (<fetch> registry) - (-> Registry (List Text)) - (|> registry - :representation - (value@ #artifacts) - sequence.list - (list.all (|>> (value@ #category) - (case> {<tag> name} {.#Some name} - _ {.#None})))))] - - [#Definition definition definitions] - [#Analyser analyser analysers] - [#Synthesizer synthesizer synthesizers] - [#Generator generator generators] - [#Directive directive directives] - [#Custom custom customs] - ) - - (def: .public (remember name registry) - (-> Text Registry (Maybe ID)) - (|> (:representation registry) - (value@ #resolver) - (dictionary.value name))) - - (def: .public writer - (Writer Registry) - (let [category (: (Writer Category) - (function (_ value) - (case value - (^template [<nat> <tag> <writer>] - [{<tag> value} - ((binary.and binary.nat <writer>) [<nat> value])]) - ([0 #Anonymous binary.any] - [1 #Definition binary.text] - [2 #Analyser binary.text] - [3 #Synthesizer binary.text] - [4 #Generator binary.text] - [5 #Directive binary.text] - [6 #Custom binary.text])))) - mandatory? binary.bit - dependency (: (Writer Dependency) - (binary.and binary.nat binary.nat)) - dependencies (: (Writer (Set Dependency)) - (binary.set dependency)) - artifacts (: (Writer (Sequence [Category Bit (Set Dependency)])) - (binary.sequence/64 ($_ binary.and category mandatory? dependencies)))] - (|>> :representation - (value@ #artifacts) - (sequence#each (function (_ it) - [(value@ #category it) - (value@ #mandatory? it) - (value@ #dependencies it)])) - artifacts))) - - (exception: .public (invalid_category [tag Nat]) - (exception.report - ["Tag" (%.nat tag)])) - - (def: .public parser - (Parser Registry) - (let [category (: (Parser Category) - (do [! <>.monad] - [tag <binary>.nat] - (case tag - (^template [<nat> <tag> <parser>] - [<nat> - (# ! each (|>> {<tag>}) <parser>)]) - ([0 #Anonymous <binary>.any] - [1 #Definition <binary>.text] - [2 #Analyser <binary>.text] - [3 #Synthesizer <binary>.text] - [4 #Generator <binary>.text] - [5 #Directive <binary>.text] - [6 #Custom <binary>.text]) - - _ (<>.failure (exception.error ..invalid_category [tag]))))) - mandatory? <binary>.bit - dependency (: (Parser Dependency) - (<>.and <binary>.nat <binary>.nat)) - dependencies (: (Parser (Set Dependency)) - (<binary>.set ..dependency_hash dependency))] - (|> (<binary>.sequence/64 ($_ <>.and category mandatory? dependencies)) - (# <>.monad each (sequence#mix (function (_ [category mandatory? dependencies] registry) - (product.right - (case category - {#Anonymous} - (..resource mandatory? dependencies registry) - - (^template [<tag> <create>] - [{<tag> name} - (<create> name mandatory? dependencies registry)]) - ([#Definition ..definition] - [#Analyser ..analyser] - [#Synthesizer ..synthesizer] - [#Generator ..generator] - [#Directive ..directive] - [#Custom ..custom]) - ))) - ..empty))))) - ) +(def: .public equivalence + (Equivalence Artifact) + ($_ product.equivalence + nat.equivalence + ..category_equivalence + bit.equivalence + set.equivalence + )) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux index 7b0065dc4..0962b5b61 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux @@ -30,7 +30,8 @@ [meta ["[0]" archive {"+" Archive} ["[0]" artifact] - ["[0]" descriptor]]]]]]]) + ["[0]" descriptor] + ["[0]" registry {"+" Registry}]]]]]]]) (def: (path_references references) (-> (-> Synthesis (List Constant)) @@ -194,7 +195,7 @@ (list#each (function (_ [module [module_id [descriptor document output]]]) (|> descriptor (value@ descriptor.#registry) - artifact.artifacts + registry.artifacts sequence.list (list#each (function (_ artifact) [[module_id (value@ artifact.#id artifact)] diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux index 92327f924..11857d4be 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux @@ -1,19 +1,19 @@ (.using - [library - [lux {"-" Module} - [control - ["<>" parser - ["<b>" binary {"+" Parser}]]] - [data - ["[0]" text] - [collection - [set {"+" Set}]] - [format - ["[0]" binary {"+" Writer}]]] - [world - [file {"+" Path}]]]] - [// - ["[0]" artifact {"+" Registry}]]) + [library + [lux {"-" Module} + [control + ["<>" parser + ["<b>" binary {"+" Parser}]]] + [data + ["[0]" text] + [collection + [set {"+" Set}]] + [format + ["[0]" binary {"+" Writer}]]] + [world + [file {"+" Path}]]]] + [// + ["[0]" registry {"+" Registry}]]) (type: .public Module Text) @@ -35,7 +35,7 @@ binary.nat binary.any (binary.set binary.text) - artifact.writer + registry.writer )) (def: .public parser @@ -46,5 +46,5 @@ <b>.nat (# <>.monad in {.#Cached}) (<b>.set text.hash <b>.text) - artifact.parser + registry.parser )) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux new file mode 100644 index 000000000..3005c2e0d --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux @@ -0,0 +1,170 @@ +(.using + [library + [lux "*" + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" binary {"+" Parser}]]] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + [set {"+" Set}] + ["[0]" list] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)] + ["[0]" dictionary {"+" Dictionary}]] + [format + ["[0]" binary {"+" Writer}]]] + [type + abstract]]] + ["[0]" // "_" + ["[1]" artifact {"+" Dependency Category Artifact ID}]]) + +(abstract: .public Registry + (Record + [#artifacts (Sequence Artifact) + #resolver (Dictionary Text ID)]) + + (def: .public empty + Registry + (:abstraction [#artifacts sequence.empty + #resolver (dictionary.empty text.hash)])) + + (def: .public artifacts + (-> Registry (Sequence Artifact)) + (|>> :representation (value@ #artifacts))) + + (def: next + (-> Registry ID) + (|>> ..artifacts sequence.size)) + + (def: .public (resource mandatory? dependencies registry) + (-> Bit (Set Dependency) Registry [ID Registry]) + (let [id (..next registry)] + [id + (|> registry + :representation + (revised@ #artifacts (sequence.suffix [//.#id id + //.#category {//.#Anonymous} + //.#mandatory? mandatory? + //.#dependencies dependencies])) + :abstraction)])) + + (template [<tag> <create> <fetch>] + [(def: .public (<create> name mandatory? dependencies registry) + (-> Text Bit (Set Dependency) Registry [ID Registry]) + (let [id (..next registry)] + [id + (|> registry + :representation + (revised@ #artifacts (sequence.suffix [//.#id id + //.#category {<tag> name} + //.#mandatory? mandatory? + //.#dependencies dependencies])) + (revised@ #resolver (dictionary.has name id)) + :abstraction)])) + + (def: .public (<fetch> registry) + (-> Registry (List Text)) + (|> registry + :representation + (value@ #artifacts) + sequence.list + (list.all (|>> (value@ //.#category) + (case> {<tag> name} {.#Some name} + _ {.#None})))))] + + [//.#Definition definition definitions] + [//.#Analyser analyser analysers] + [//.#Synthesizer synthesizer synthesizers] + [//.#Generator generator generators] + [//.#Directive directive directives] + [//.#Custom custom customs] + ) + + (def: .public (remember name registry) + (-> Text Registry (Maybe ID)) + (|> (:representation registry) + (value@ #resolver) + (dictionary.value name))) + + (def: .public writer + (Writer Registry) + (let [category (: (Writer Category) + (function (_ value) + (case value + (^template [<nat> <tag> <writer>] + [{<tag> value} + ((binary.and binary.nat <writer>) [<nat> value])]) + ([0 //.#Anonymous binary.any] + [1 //.#Definition binary.text] + [2 //.#Analyser binary.text] + [3 //.#Synthesizer binary.text] + [4 //.#Generator binary.text] + [5 //.#Directive binary.text] + [6 //.#Custom binary.text])))) + mandatory? binary.bit + dependency (: (Writer Dependency) + (binary.and binary.nat binary.nat)) + dependencies (: (Writer (Set Dependency)) + (binary.set dependency)) + artifacts (: (Writer (Sequence [Category Bit (Set Dependency)])) + (binary.sequence/64 ($_ binary.and category mandatory? dependencies)))] + (|>> :representation + (value@ #artifacts) + (sequence#each (function (_ it) + [(value@ //.#category it) + (value@ //.#mandatory? it) + (value@ //.#dependencies it)])) + artifacts))) + + (exception: .public (invalid_category [tag Nat]) + (exception.report + ["Tag" (%.nat tag)])) + + (def: .public parser + (Parser Registry) + (let [category (: (Parser Category) + (do [! <>.monad] + [tag <binary>.nat] + (case tag + (^template [<nat> <tag> <parser>] + [<nat> + (# ! each (|>> {<tag>}) <parser>)]) + ([0 //.#Anonymous <binary>.any] + [1 //.#Definition <binary>.text] + [2 //.#Analyser <binary>.text] + [3 //.#Synthesizer <binary>.text] + [4 //.#Generator <binary>.text] + [5 //.#Directive <binary>.text] + [6 //.#Custom <binary>.text]) + + _ (<>.failure (exception.error ..invalid_category [tag]))))) + mandatory? <binary>.bit + dependency (: (Parser Dependency) + (<>.and <binary>.nat <binary>.nat)) + dependencies (: (Parser (Set Dependency)) + (<binary>.set //.dependency_hash dependency))] + (|> (<binary>.sequence/64 ($_ <>.and category mandatory? dependencies)) + (# <>.monad each (sequence#mix (function (_ [category mandatory? dependencies] registry) + (product.right + (case category + {//.#Anonymous} + (..resource mandatory? dependencies registry) + + (^template [<tag> <create>] + [{<tag> name} + (<create> name mandatory? dependencies registry)]) + ([//.#Definition ..definition] + [//.#Analyser ..analyser] + [//.#Synthesizer ..synthesizer] + [//.#Generator ..generator] + [//.#Directive ..directive] + [//.#Custom ..custom]) + ))) + ..empty))))) + ) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux index dd4b64aa4..7b8a98a61 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux @@ -22,7 +22,7 @@ ["[0]" descriptor {"+" Module Descriptor}] ["[0]" document {"+" Document}]]]) -(type: Ancestry +(type: .public Ancestry (Set Module)) (def: fresh @@ -40,7 +40,7 @@ (-> Graph (List Module)) dictionary.keys) -(type: Dependency +(type: .public Dependency (Record [#module Module #imports Ancestry])) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index 55c03a050..46d3d65cf 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -37,6 +37,7 @@ ["/[1]" // ["[0]" archive {"+" Output Archive} ["[0]" artifact {"+" Artifact}] + ["[0]" registry] ["[0]" descriptor {"+" Module Descriptor}] ["[0]" document {"+" Document}]] [cache @@ -356,7 +357,7 @@ Bundles])))) (do (try.with async.monad) [actual (cached_artifacts fs static module_id) - .let [expected (|> descriptor (value@ descriptor.#registry) artifact.artifacts)] + .let [expected (|> descriptor (value@ descriptor.#registry) registry.artifacts)] [document bundles output] (async#in (loaded_document (value@ static.#artifact_extension static) host_environment module_id expected actual document))] (in [[descriptor document output] bundles]))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index 5d6fe712e..b8319015f 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -16,7 +16,8 @@ ["[0]" dependency]] ["[0]" archive {"+" Archive} ["[0]" descriptor] - ["[0]" artifact]] + ["[0]" artifact] + ["[0]" registry]] [// [language [lux @@ -37,7 +38,7 @@ (list#each (function (_ [module [module_id [descriptor document]]]) (|> descriptor (value@ descriptor.#registry) - artifact.artifacts + registry.artifacts sequence.list (list#each (|>> (value@ artifact.#id))) [module_id])))) diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index 8a3372e61..c10521e74 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -6,6 +6,7 @@ [abstract [monad {"+" do}]] [control + ["[0]" maybe] ["[0]" try {"+" Try}] ["[0]" exception {"+" exception:}] ["[0]" io {"+" IO io}] @@ -93,39 +94,67 @@ (|>> (exception.except ..cannot_close) in)))))))))] (for [@.old (as_is <jvm>) @.jvm (as_is <jvm>) - @.js (as_is (ffi.import: Readable - ["[1]::[0]"]) + @.js (as_is (ffi.import: Buffer + ["[1]::[0]" + (toString [] ffi.String)]) + + (ffi.import: Readable_Stream + ["[1]::[0]" + (read [] "?" Buffer) + (unshift "as" unshift|String [ffi.String] ffi.Boolean) + (unshift "as" unshift|Buffer [Buffer] ffi.Boolean)]) - (ffi.import: Writable + (ffi.import: Writable_Stream ["[1]::[0]" (write [ffi.String ffi.Function] ffi.Boolean) (once [ffi.String ffi.Function] Any)]) (ffi.import: process ["[1]::[0]" - ("static" stdout Writable) - ("static" stdin Readable)]) + ("static" stdout Writable_Stream) + ("static" stdin Readable_Stream)]) - ... TODO: Implement fully. https://nodejs.org/api/readline.html (exception: .public cannot_read) - + + (template: (!read <type> <query>) + [(let [it (process::stdin)] + (case (Readable_Stream::read [] it) + {.#Some buffer} + (let [input (Buffer::toString [] buffer)] + (case (: (Maybe [<type> Text]) + <query>) + {.#Some [head tail]} + (exec + (Readable_Stream::unshift|String [tail] it) + (async#in {try.#Success head})) + + {.#None} + (exec + (Readable_Stream::unshift|Buffer [buffer] it) + (async#in (exception.except ..cannot_read []))))) + + {.#None} + (async#in (exception.except ..cannot_read []))))]) + (def: .public default (Maybe (Console Async)) (if ffi.on_node_js? {.#Some (implementation - (def: read - (|>> (exception.except ..cannot_read) async#in)) + (def: (read _) + (!read Char (do maybe.monad + [head (text.char 0 input) + [_ tail] (text.split_at 1 input)] + (in [head tail])))) - (def: read_line - (|>> (exception.except ..cannot_read) async#in)) + (def: (read_line _) + (!read Text (text.split_by text.\n input))) (def: (write it) (let [[read! write!] (: [(async.Async (Try [])) (async.Resolver (Try []))] (async.async []))] (exec - (Writable::write [it - (ffi.closure [] (io.run! (write! {try.#Success []})))] - (process::stdout)) + (Writable_Stream::write [it (ffi.closure [] (io.run! (write! {try.#Success []})))] + (process::stdout)) read!))) (def: close diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index de56b54a2..5fc2b5e2c 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -1,39 +1,42 @@ -(.using - [library - [lux "*" - ["@" target] - ["[0]" ffi] - [abstract - ["[0]" monad {"+" Monad do}]] - [control - [pipe {"+" case>}] - ["[0]" maybe ("[1]#[0]" functor)] - ["[0]" try {"+" Try} ("[1]#[0]" functor)] - ["[0]" exception {"+" exception:}] - ["[0]" io {"+" IO} ("[1]#[0]" functor)] - ["[0]" function] - [concurrency - ["[0]" async {"+" Async}] - ["[0]" stm {"+" Var STM}]]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" product] - ["[0]" binary {"+" Binary}] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" array {"+" Array}] - ["[0]" list ("[1]#[0]" functor)] - ["[0]" dictionary {"+" Dictionary}]]] - [macro - ["[0]" template]] - [math - [number - ["i" int] - ["f" frac]]] - [time - ["[0]" instant {"+" Instant}] - ["[0]" duration]]]]) +(.`` (.`` (.using + [library + [lux "*" + ["@" target] + [abstract + ["[0]" monad {"+" Monad do}]] + [control + [pipe {"+" case>}] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try {"+" Try} ("[1]#[0]" functor)] + ["[0]" exception {"+" exception:}] + ["[0]" io {"+" IO} ("[1]#[0]" functor)] + ["[0]" function] + [concurrency + ["[0]" async {"+" Async}] + ["[0]" stm {"+" Var STM}]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" product] + ["[0]" binary {"+" Binary}] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" array {"+" Array}] + ["[0]" list ("[1]#[0]" functor)] + ["[0]" dictionary {"+" Dictionary}]]] + ["[0]" ffi + (~~ (.for ["JavaScript" (~~ (.as_is ["[0]" node_js])) + "{old}" (~~ (.as_is ["node_js" //control/thread]))] + (~~ (.as_is))))] + [macro + ["[0]" template]] + [math + [number + ["i" int] + ["f" frac]]] + [time + ["[0]" instant {"+" Instant}] + ["[0]" duration]]]]))) (type: .public Path Text) @@ -370,171 +373,139 @@ ["[1]::[0]" (sep ffi.String)]) - (template [<name> <path>] - [(def: (<name> _) - (-> [] (Maybe (-> ffi.String Any))) - (ffi.constant (-> ffi.String Any) <path>))] - - [normal_require [require]] - [global_require [global require]] - [process_load [global process mainModule constructor _load]] - ) - - (def: (require module) - (-> ffi.String Any) - (case [(normal_require []) (global_require []) (process_load [])] - (^or [{.#Some require} _ _] - [_ {.#Some require} _] - [_ _ {.#Some require}]) - (require module) - - _ - (undefined))) - - (template [<name> <module> <type>] - [(def: (<name> _) - (-> [] <type>) - (:as <type> (..require <module>)))] - - [node_fs "fs" ..Fs] - [node_path "path" ..JsPath] - ) - - (def: js_separator - (if ffi.on_node_js? - (JsPath::sep (..node_path [])) - "/")) - - (`` (implementation: .public default - (System Async) - - (def: separator - ..js_separator) - - (~~ (template [<name> <method>] - [(def: (<name> path) - (do async.monad - [?stats (with_async write! (Try Stats) - (Fs::stat [path (..value_callback write!)] - (..node_fs [])))] - (in (case ?stats - {try.#Success stats} - (<method> [] stats) - - {try.#Failure _} - false))))] - - [file? Stats::isFile] - [directory? Stats::isDirectory] - )) - - (def: (make_directory path) - (do async.monad - [.let [node_fs (..node_fs [])] - outcome (with_async write! (Try Any) - (Fs::access [path - (|> node_fs Fs::constants FsConstants::F_OK) - (..any_callback write!)] - node_fs))] - (case outcome - {try.#Success _} - (in (exception.except ..cannot_make_directory [path])) - - {try.#Failure _} - (with_async write! (Try Any) - (Fs::mkdir [path (..any_callback write!)] node_fs))))) - - (~~ (template [<name> <method>] - [(def: (<name> path) - (do [! (try.with async.monad)] - [.let [node_fs (..node_fs [])] - subs (with_async write! (Try (Array ffi.String)) - (Fs::readdir [path (..value_callback write!)] node_fs))] - (|> subs - (array.list {.#None}) - (list#each (|>> (format path ..js_separator))) - (monad.each ! (function (_ sub) - (# ! each (|>> (<method> []) [sub]) - (with_async write! (Try Stats) - (Fs::stat [sub (..value_callback write!)] node_fs))))) - (# ! each (|>> (list.only product.right) - (list#each product.left))))))] - - [directory_files Stats::isFile] - [sub_directories Stats::isDirectory] - )) - - (def: (file_size path) - (do (try.with async.monad) - [stats (with_async write! (Try Stats) - (Fs::stat [path (..value_callback write!)] - (..node_fs [])))] - (in (|> stats - Stats::size - f.nat)))) - - (def: (last_modified path) - (do (try.with async.monad) - [stats (with_async write! (Try Stats) - (Fs::stat [path (..value_callback write!)] - (..node_fs [])))] - (in (|> stats - Stats::mtimeMs - f.int - duration.of_millis - instant.absolute)))) - - (def: (can_execute? path) - (let [node_fs (..node_fs [])] - (# async.monad each - (|>> (case> {try.#Success _} - true - - {try.#Failure _} - false) - {try.#Success}) - (with_async write! (Try Any) - (Fs::access [path - (|> node_fs Fs::constants FsConstants::X_OK) - (..any_callback write!)] - node_fs))))) - - (def: (read path) - (with_async write! (Try Binary) - (Fs::readFile [path (..value_callback write!)] - (..node_fs [])))) - - (def: (delete path) - (do (try.with async.monad) - [.let [node_fs (..node_fs [])] - stats (with_async write! (Try Stats) - (Fs::stat [path (..value_callback write!)] node_fs))] - (with_async write! (Try Any) - (if (Stats::isFile [] stats) - (Fs::unlink [path (..any_callback write!)] node_fs) - (Fs::rmdir [path (..any_callback write!)] node_fs))))) - - (def: (modify time_stamp path) - (with_async write! (Try Any) - (let [when (|> time_stamp instant.relative duration.millis i.frac)] - (Fs::utimes [path when when (..any_callback write!)] - (..node_fs []))))) - - (~~ (template [<name> <method>] - [(def: (<name> data path) - (with_async write! (Try Any) - (<method> [path (Buffer::from data) (..any_callback write!)] - (..node_fs []))))] - - [write Fs::writeFile] - [append Fs::appendFile] - )) - - (def: (move destination origin) - (with_async write! (Try Any) - (Fs::rename [origin destination (..any_callback write!)] - (..node_fs [])))) - ))) + (def: .public default + (Maybe (System Async)) + (do maybe.monad + [node_fs (node_js.require "fs") + node_path (node_js.require "path") + .let [node_fs (:as ..Fs node_fs) + js_separator (if ffi.on_node_js? + (JsPath::sep (:as ..JsPath node_path)) + "/")]] + (in (: (System Async) + (`` (implementation + (def: separator + js_separator) + + (~~ (template [<name> <method>] + [(def: (<name> path) + (do async.monad + [?stats (with_async write! (Try Stats) + (Fs::stat [path (..value_callback write!)] + node_fs))] + (in (case ?stats + {try.#Success stats} + (<method> [] stats) + + {try.#Failure _} + false))))] + + [file? Stats::isFile] + [directory? Stats::isDirectory] + )) + + (def: (make_directory path) + (do async.monad + [outcome (with_async write! (Try Any) + (Fs::access [path + (|> node_fs Fs::constants FsConstants::F_OK) + (..any_callback write!)] + node_fs))] + (case outcome + {try.#Success _} + (in (exception.except ..cannot_make_directory [path])) + + {try.#Failure _} + (with_async write! (Try Any) + (Fs::mkdir [path (..any_callback write!)] node_fs))))) + + (~~ (template [<name> <method>] + [(def: (<name> path) + (do [! (try.with async.monad)] + [subs (with_async write! (Try (Array ffi.String)) + (Fs::readdir [path (..value_callback write!)] node_fs))] + (|> subs + (array.list {.#None}) + (list#each (|>> (format path js_separator))) + (monad.each ! (function (_ sub) + (# ! each (|>> (<method> []) [sub]) + (with_async write! (Try Stats) + (Fs::stat [sub (..value_callback write!)] node_fs))))) + (# ! each (|>> (list.only product.right) + (list#each product.left))))))] + + [directory_files Stats::isFile] + [sub_directories Stats::isDirectory] + )) + + (def: (file_size path) + (do (try.with async.monad) + [stats (with_async write! (Try Stats) + (Fs::stat [path (..value_callback write!)] + node_fs))] + (in (|> stats + Stats::size + f.nat)))) + + (def: (last_modified path) + (do (try.with async.monad) + [stats (with_async write! (Try Stats) + (Fs::stat [path (..value_callback write!)] + node_fs))] + (in (|> stats + Stats::mtimeMs + f.int + duration.of_millis + instant.absolute)))) + + (def: (can_execute? path) + (# async.monad each + (|>> (case> {try.#Success _} + true + + {try.#Failure _} + false) + {try.#Success}) + (with_async write! (Try Any) + (Fs::access [path + (|> node_fs Fs::constants FsConstants::X_OK) + (..any_callback write!)] + node_fs)))) + + (def: (read path) + (with_async write! (Try Binary) + (Fs::readFile [path (..value_callback write!)] + node_fs))) + + (def: (delete path) + (do (try.with async.monad) + [stats (with_async write! (Try Stats) + (Fs::stat [path (..value_callback write!)] node_fs))] + (with_async write! (Try Any) + (if (Stats::isFile [] stats) + (Fs::unlink [path (..any_callback write!)] node_fs) + (Fs::rmdir [path (..any_callback write!)] node_fs))))) + + (def: (modify time_stamp path) + (with_async write! (Try Any) + (let [when (|> time_stamp instant.relative duration.millis i.frac)] + (Fs::utimes [path when when (..any_callback write!)] + node_fs)))) + + (~~ (template [<name> <method>] + [(def: (<name> data path) + (with_async write! (Try Any) + (<method> [path (Buffer::from data) (..any_callback write!)] + node_fs)))] + + [write Fs::writeFile] + [append Fs::appendFile] + )) + + (def: (move destination origin) + (with_async write! (Try Any) + (Fs::rename [origin destination (..any_callback write!)] + node_fs)))))))))) @.python (as_is (type: (Tuple/2 left right) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 99db7ef1a..6dc3eabd9 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -22,6 +22,7 @@ ]]] ["[1][0]" meta "_" ["[1]/[0]" archive "_" + ["[1]/[0]" artifact] ["[1]/[0]" signature] ["[1]/[0]" key] ["[1]/[0]" document]]] @@ -37,6 +38,7 @@ /analysis/simple.test /analysis/composite.test /analysis/pattern.test + /meta/archive/artifact.test /meta/archive/signature.test /meta/archive/key.test /meta/archive/document.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux new file mode 100644 index 000000000..b241b0c46 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux @@ -0,0 +1,48 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]] + [\\library + ["[0]" /]]) + +(def: random_category + (Random /.Category) + ($_ random.or + (random#in []) + (random.ascii/lower 1) + (random.ascii/lower 2) + (random.ascii/lower 3) + (random.ascii/lower 4) + (random.ascii/lower 5) + (random.ascii/lower 6) + )) + +(def: random_dependency + (Random /.Dependency) + ($_ random.and + random.nat + random.nat + )) + +(def: .public random + (Random /.Artifact) + ($_ random.and + random.nat + ..random_category + random.bit + (random.set /.dependency_hash 5 ..random_dependency) + )) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Artifact /.ID]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + ))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 39e8d13dd..ee313599f 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -1,19 +1,239 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" io]] - [math - ["[0]" random]]]] - ["[0]" / "_" - ["[1][0]" watch]] - [\\library - ["[0]" /]] - [\\specification - ["$[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" io {"+" IO}] + ["[0]" try {"+" Try}] + [concurrency + [async {"+" Async}] + ["[0]" atom {"+" Atom}]]] + [data + ["[0]" binary {"+" Binary} ("[1]#[0]" monoid)] + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" dictionary {"+" Dictionary}] + ["[0]" list]]] + [math + ["[0]" random]] + [time + ["[0]" instant {"+" Instant}]]]] + ["[0]" / "_" + ["[1][0]" watch]] + [\\library + ["[0]" /]] + [\\specification + ["$[0]" /]]) + +(type: Disk + (Dictionary /.Path (Either [Instant Binary] (List Text)))) + +(def: (file? disk @) + (-> (Atom Disk) (-> /.Path (IO Bit))) + (do io.monad + [disk (atom.read! disk)] + (in (case (dictionary.value @ disk) + {.#None} false + {.#Some {.#Left _}} true + {.#Some {.#Right _}} false)))) + +(def: (directory? disk @) + (-> (Atom Disk) (-> /.Path (IO Bit))) + (do io.monad + [disk (atom.read! disk)] + (in (case (dictionary.value @ disk) + {.#None} false + {.#Some {.#Left _}} false + {.#Some {.#Right _}} true)))) + +(def: (alert_parent! disk alert @) + (-> (Atom Disk) + (-> (List /.Path) (List /.Path)) + (-> /.Path (IO (Try Any)))) + (do [! io.monad] + [disk' (atom.read! disk)] + (case (dictionary.value @ disk') + {.#Some {.#Right siblings}} + (do ! + [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Right (alert siblings)} disk') disk)] + (in {try.#Success []})) + + _ + (in {try.#Failure ""})))) + +(def: (write fs disk it @) + (-> (/.System Async) (Atom Disk) (-> Binary /.Path (IO (Try Any)))) + (do [! io.monad] + [now instant.now + disk' (atom.read! disk)] + (case (dictionary.value @ disk') + (^or {.#None} + {.#Some {.#Left _}}) + (do ! + [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Left [now it]} disk') disk)] + (case (/.parent fs @) + {.#Some parent} + (alert_parent! disk (|>> (list& @)) parent) + + {.#None} + (in {try.#Success []}))) + + _ + (in {try.#Failure ""})))) + +(def: (read disk @) + (-> (Atom Disk) (-> /.Path (IO (Try Binary)))) + (do io.monad + [disk (atom.read! disk)] + (in (case (dictionary.value @ disk) + {.#Some {.#Left [_ it]}} + {try.#Success it} + + _ + {try.#Failure ""})))) + +(def: (delete fs disk @) + (-> (/.System Async) (Atom Disk) + (-> /.Path (IO (Try Any)))) + (do [! io.monad] + [disk' (atom.read! disk)] + (case (dictionary.value @ disk') + {.#Some {.#Right children}} + (if (list.empty? children) + (do ! + [_ (atom.compare_and_swap! disk' (dictionary.lacks @ disk') disk)] + (in {try.#Success []})) + (in {try.#Failure ""})) + + {.#Some {.#Left [_ data]}} + (do ! + [_ (atom.compare_and_swap! disk' (dictionary.lacks @ disk') disk)] + (case (/.parent fs @) + {.#Some parent} + (alert_parent! disk (list.only (|>> (text#= @) not)) parent) + + {.#None} + (in {try.#Success []}))) + + _ + (in {try.#Failure ""})))) + +(def: (fs /) + (-> Text (/.System IO)) + (let [disk (: (Atom Disk) + (atom.atom (dictionary.empty text.hash))) + mock (/.mock /)] + (implementation + (def: separator /) + + (def: file? (..file? disk)) + (def: directory? (..directory? disk)) + (def: write (..write mock disk)) + (def: read (..read disk)) + (def: delete (..delete mock disk)) + + (def: (file_size @) + (do [! io.monad] + [disk (atom.read! disk)] + (in (case (dictionary.value @ disk) + {.#Some {.#Left [_ it]}} + {try.#Success (binary.size it)} + + _ + {try.#Failure ""})))) + (def: (last_modified @) + (do [! io.monad] + [disk (atom.read! disk)] + (in (case (dictionary.value @ disk) + {.#Some {.#Left [it _]}} + {try.#Success it} + + _ + {try.#Failure ""})))) + (def: (can_execute? @) + (do [! io.monad] + [disk (atom.read! disk)] + (in (case (dictionary.value @ disk) + {.#Some {.#Left _}} + {try.#Success false} + + _ + {try.#Failure ""})))) + + (def: (make_directory @) + (do [! io.monad] + [disk' (atom.read! disk)] + (case (dictionary.value @ disk') + {.#None} + (do ! + [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Right (list)} disk') disk)] + (case (/.parent mock @) + {.#Some parent} + (alert_parent! disk (|>> (list& @)) parent) + + {.#None} + (in {try.#Success []}))) + + _ + (in {try.#Failure ""})))) + (def: (directory_files @) + (do [! io.monad] + [disk' (atom.read! disk)] + (case (dictionary.value @ disk') + {.#Some {.#Right children}} + (|> children + (monad.only ! (..file? disk)) + (# ! each (|>> {try.#Success}))) + + _ + (in {try.#Failure ""})))) + (def: (sub_directories @) + (do [! io.monad] + [disk' (atom.read! disk)] + (case (dictionary.value @ disk') + {.#Some {.#Right children}} + (|> children + (monad.only ! (..directory? disk)) + (# ! each (|>> {try.#Success}))) + + _ + (in {try.#Failure ""})))) + (def: (append it @) + (do [! io.monad] + [now instant.now + disk' (atom.read! disk)] + (case (dictionary.value @ disk') + {.#None} + (..write mock disk it @) + + {.#Some {.#Left [_ old]}} + (do ! + [_ (atom.compare_and_swap! disk' + (dictionary.has @ {.#Left [now (binary#composite old it)]} disk') + disk)] + (in {try.#Success []})) + + _ + (in {try.#Failure ""})))) + (def: (modify it @) + (do [! io.monad] + [disk' (atom.read! disk)] + (case (dictionary.value @ disk') + {.#Some {.#Left [_ data]}} + (do ! + [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Left [it data]} disk') disk)] + (in {try.#Success []})) + + _ + (in {try.#Failure ""})))) + (def: (move it @) + (do [! (try.with io.monad)] + [data (..read disk @) + write (..write mock disk data it)] + (..delete mock disk @))) + ))) (def: .public test Test @@ -23,6 +243,8 @@ ($_ _.and (_.for [/.mock] ($/.spec (io.io (/.mock /)))) + (_.for [/.async] + ($/.spec (io.io (/.async (..fs /))))) /watch.test )))) diff --git a/stdlib/source/test/lux/world/net/http/client.lux b/stdlib/source/test/lux/world/net/http/client.lux index 474d1ea08..fdc32834b 100644 --- a/stdlib/source/test/lux/world/net/http/client.lux +++ b/stdlib/source/test/lux/world/net/http/client.lux @@ -1,31 +1,55 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - [pipe {"+" do>}] - ["[0]" io {"+" IO}] - ["[0]" try] - ["[0]" function]] - [data - ["[0]" binary] - ["[0]" product] - ["[0]" text - ["%" format {"+" format}] - [encoding - ["[0]" utf8]]] - [collection - ["[0]" dictionary]]] - [math - ["[0]" random {"+" Random}] - [number - ["[0]" nat]]]]] - [\\library - ["[0]" / - ["/[1]" // - ["[1][0]" status]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" Monad do}]] + [control + [pipe {"+" do>}] + ["[0]" io {"+" IO}] + ["[0]" try {"+" Try}] + ["[0]" function] + [concurrency + ["[0]" async ("[1]#[0]" functor)]]] + [data + ["[0]" binary] + ["[0]" product] + ["[0]" text + ["%" format {"+" format}] + [encoding + ["[0]" utf8]]] + [collection + ["[0]" dictionary]]] + [math + ["[0]" random {"+" Random}] + [number + ["[0]" nat]]]]] + [\\library + ["[0]" / + ["/[1]" // + ["[1][0]" status]]]]) + +(def: (verification ! expected response) + (All (_ !) + (-> (Monad !) Nat (! (Try (//.Response !))) + (! Bit))) + (do ! + [response response] + (case response + {try.#Success response} + (|> response + product.right + (value@ //.#body) + (function.on {.#None}) + (# ! each (|>> (do> try.monad + [] + [product.right (# utf8.codec decoded)] + [(# nat.decimal decoded)] + [(nat.= expected) in]) + (try.else false)))) + + {try.#Failure error} + (in false)))) (def: .public test Test @@ -64,32 +88,40 @@ //.#body (function (_ ?wanted_bytes) (io.io {try.#Success [(binary.size data) data]}))]]})))))]] - (`` ($_ _.and - (~~ (template [<definition> <expected>] - [(_.cover [<definition>] - (|> (<definition> "" //.empty {.#None} mock) - (do> try.monad - [io.run!] - [product.right (value@ //.#body) (function.on {.#None}) io.run!] - [product.right (# utf8.codec decoded)] - [(# nat.decimal decoded)] - [(nat.= <expected>) in]) - (try.else false)))] + (with_expansions [<cases> (as_is [/.post on_post] + [/.get on_get] + [/.put on_put] + [/.patch on_patch] + [/.delete on_delete] + [/.head on_head] + [/.connect on_connect] + [/.options on_options] + [/.trace on_trace])] + (`` ($_ _.and + (~~ (template [<definition> <expected>] + [(_.cover [<definition>] + (|> (<definition> "" //.empty {.#None} mock) + (verification io.monad <expected>) + io.run!))] + + <cases> + )) + (_.cover [/.headers] + (nat.= (dictionary.size headers) + (|> headers + dictionary.entries + /.headers + dictionary.size))) + (in (do [! async.monad] + [.let [mock (/.async mock)] + (~~ (template [<definition> <expected>] + [<expected> (|> (<definition> "" //.empty {.#None} mock) + (verification ! <expected>))] + + <cases>))] + (_.cover' [/.async] + (and (~~ (template [<definition> <expected>] + [<expected>] - [/.post on_post] - [/.get on_get] - [/.put on_put] - [/.patch on_patch] - [/.delete on_delete] - [/.head on_head] - [/.connect on_connect] - [/.options on_options] - [/.trace on_trace] - )) - (_.cover [/.headers] - (nat.= (dictionary.size headers) - (|> headers - dictionary.entries - /.headers - dictionary.size))) - ))))) + <cases>)))))) + )))))) |