diff options
Diffstat (limited to '')
25 files changed, 679 insertions, 625 deletions
diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index 13b7e6d8a..0e2454aab 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -601,7 +601,7 @@ [// [type (.use "[0]" equivalence)]]))) - ($.definition /.at + ($.definition /.of "Allows accessing the value of a implementation's member." ($.example (of codec encoded)) @@ -792,6 +792,8 @@ ($.example (same? +5 (+ +2 +3)))) + ($.alias /.alias?) + ... ($.definition /.^let ... "Allows you to simultaneously bind and de-structure a value." ... ($.example (def (hash (^let set [member_hash _])) diff --git a/stdlib/source/documentation/lux/data.lux b/stdlib/source/documentation/lux/data.lux index 93ecf8753..9f0f9d036 100644 --- a/stdlib/source/documentation/lux/data.lux +++ b/stdlib/source/documentation/lux/data.lux @@ -9,20 +9,114 @@ ["[1][0]" binary] ["[1][0]" bit] ["[1][0]" collection] - ["[1][0]" color] + ["[1][0]" color + ["[1]/[0]" named]] ["[1][0]" format] ["[1][0]" identity] ["[1][0]" product] ["[1][0]" sum] ["[1][0]" text]]) +... (def palette_documentation +... (syntax (_ [[_ name] <code>.symbol]) +... (in (list (code.text (format "A " (text.replaced "_" "-" name) " palette.")))))) + +... (`` (def .public documentation +... (List $.Documentation) +... (let [encoding (list ($.definition /.of_rgb) +... ($.definition /.rgb) + +... ($.definition /.HSL +... "Hue-Saturation-Lightness color format.") + +... ($.definition /.hsl) +... ($.definition /.of_hsl) + +... ($.definition /.hsb) +... ($.definition /.of_hsb) + +... ($.definition /.HSB +... "Hue-Saturation-Brightness color format.")) +... transformation (list ($.definition /.gray_scale) +... ($.definition /.darker) +... ($.definition /.brighter) +... ($.definition /.saturated) +... ($.definition /.un_saturated) + +... ($.definition /.complement +... "The opposite color." +... ($.example (complement color))) + +... ($.definition /.interpolated +... "" +... ($.example (interpolated ratio end start)))) +... alpha (list ($.definition /.Alpha +... "The degree of transparency of a pigment.") + +... ($.definition /.transparent +... "The maximum degree of transparency.") + +... ($.definition /.translucent +... "The medium degree of transparency.") + +... ($.definition /.opaque +... "The minimum degree of transparency.")) +... scheme (list ($.definition /.Spread) +... ($.definition /.Palette) + +... ($.definition /.analogous +... (palette_documentation /.analogous) +... ($.example (analogous spread variations color))) + +... ($.definition /.monochromatic +... (palette_documentation /.monochromatic) +... ($.example (monochromatic spread variations color))) + +... (,, (with_template [<name>] +... [(`` ($.definition <name> +... (format "A " +... (text.replaced "_" "-" (,, (template.text [<name>]))) +... " color scheme.")))] + +... [/.triad] +... [/.clash] +... [/.split_complement] +... [/.square] +... [/.tetradic] +... )))] +... (list.partial ($.module /._ +... "") + +... ($.definition /.Color +... "A color value, independent of color format.") + +... ($.definition /.equivalence) +... ($.definition /.hash) +... ($.definition /.black) +... ($.definition /.white) +... ($.definition /.addition) +... ($.definition /.subtraction) + +... ($.definition /.Pigment +... "A color with some degree of transparency.") + +... (all list#composite +... encoding +... transformation +... alpha +... scheme + +... /named.documentation +... ) +... )))) + (def .public documentation (List $.Documentation) (list.together (list /binary.documentation /bit.documentation /collection.documentation - /color.documentation + /color/named.documentation /format.documentation /identity.documentation /product.documentation diff --git a/stdlib/source/documentation/lux/data/color.lux b/stdlib/source/documentation/lux/data/color.lux deleted file mode 100644 index 768fb1ffb..000000000 --- a/stdlib/source/documentation/lux/data/color.lux +++ /dev/null @@ -1,112 +0,0 @@ -(.require - [library - [lux (.except) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" monoid)]]] - [meta - ["[0]" code (.only) - ["<[1]>" \\parser]] - [macro - [syntax (.only syntax)] - ["[0]" template]]]]] - [\\library - ["[0]" /]] - ["[0]" / - ["[1][0]" named]]) - -(def palette_documentation - (syntax (_ [[_ name] <code>.symbol]) - (in (list (code.text (format "A " (text.replaced "_" "-" name) " palette.")))))) - -(`` (def .public documentation - (List $.Documentation) - (let [encoding (list ($.definition /.of_rgb) - ($.definition /.rgb) - - ($.definition /.HSL - "Hue-Saturation-Lightness color format.") - - ($.definition /.hsl) - ($.definition /.of_hsl) - - ($.definition /.hsb) - ($.definition /.of_hsb) - - ($.definition /.HSB - "Hue-Saturation-Brightness color format.")) - transformation (list ($.definition /.gray_scale) - ($.definition /.darker) - ($.definition /.brighter) - ($.definition /.saturated) - ($.definition /.un_saturated) - - ($.definition /.complement - "The opposite color." - ($.example (complement color))) - - ($.definition /.interpolated - "" - ($.example (interpolated ratio end start)))) - alpha (list ($.definition /.Alpha - "The degree of transparency of a pigment.") - - ($.definition /.transparent - "The maximum degree of transparency.") - - ($.definition /.translucent - "The medium degree of transparency.") - - ($.definition /.opaque - "The minimum degree of transparency.")) - scheme (list ($.definition /.Spread) - ($.definition /.Palette) - - ($.definition /.analogous - (palette_documentation /.analogous) - ($.example (analogous spread variations color))) - - ($.definition /.monochromatic - (palette_documentation /.monochromatic) - ($.example (monochromatic spread variations color))) - - (,, (with_template [<name>] - [(`` ($.definition <name> - (format "A " - (text.replaced "_" "-" (,, (template.text [<name>]))) - " color scheme.")))] - - [/.triad] - [/.clash] - [/.split_complement] - [/.square] - [/.tetradic] - )))] - (list.partial ($.module /._ - "") - - ($.definition /.Color - "A color value, independent of color format.") - - ($.definition /.equivalence) - ($.definition /.hash) - ($.definition /.black) - ($.definition /.white) - ($.definition /.addition) - ($.definition /.subtraction) - - ($.definition /.Pigment - "A color with some degree of transparency.") - - (all list#composite - encoding - transformation - alpha - scheme - - /named.documentation - ) - )))) diff --git a/stdlib/source/documentation/lux/data/color/named.lux b/stdlib/source/documentation/lux/data/color/named.lux index 49eb0847d..fe90ee829 100644 --- a/stdlib/source/documentation/lux/data/color/named.lux +++ b/stdlib/source/documentation/lux/data/color/named.lux @@ -12,17 +12,17 @@ ["[0]" nat (.use "hex#[0]" hex)]]]]] [\\library ["[0]" / (.only) - ["/[1]" // (.only) + [// ["[0]" rgb]]]]) (def description (template (_ <name>) [($.definition <name> - (let [[red green blue] (//.rgb <name>) + (let [[red green blue] <name> [_ name] (symbol <name>)] - (format "R:" (hex#encoded (rgb.number red)) - " G:" (hex#encoded (rgb.number green)) - " B:" (hex#encoded (rgb.number blue)) + (format "R:" (hex#encoded red) + " G:" (hex#encoded green) + " B:" (hex#encoded blue) " | " (text.replaced "_" " " name))))])) (`` (def .public documentation diff --git a/stdlib/source/documentation/lux/math.lux b/stdlib/source/documentation/lux/math.lux index afc959c96..c2ae9b908 100644 --- a/stdlib/source/documentation/lux/math.lux +++ b/stdlib/source/documentation/lux/math.lux @@ -8,12 +8,13 @@ [collection ["[0]" list (.use "[1]#[0]" monoid)]]]]] ["[0]" / - ["[1][0]" infix] ["[1][0]" modulus] - ["[1][0]" modular] ["[1][0]" number] ["[1][0]" logic] - ["[1][0]" random]] + ["[1][0]" random] + [arithmetic + ["[1][0]" infix] + ["[1][0]" modular]]] [\\library ["[0]" /]]) diff --git a/stdlib/source/documentation/lux/math/infix.lux b/stdlib/source/documentation/lux/math/arithmetic/infix.lux index 5b3d00381..5b3d00381 100644 --- a/stdlib/source/documentation/lux/math/infix.lux +++ b/stdlib/source/documentation/lux/math/arithmetic/infix.lux diff --git a/stdlib/source/documentation/lux/math/modular.lux b/stdlib/source/documentation/lux/math/arithmetic/modular.lux index 64d76ae02..64d76ae02 100644 --- a/stdlib/source/documentation/lux/math/modular.lux +++ b/stdlib/source/documentation/lux/math/arithmetic/modular.lux diff --git a/stdlib/source/documentation/lux/meta.lux b/stdlib/source/documentation/lux/meta.lux index f2a72fb32..85ecc6f4b 100644 --- a/stdlib/source/documentation/lux/meta.lux +++ b/stdlib/source/documentation/lux/meta.lux @@ -19,7 +19,7 @@ ["[1][0]" extension] ["[1][0]" target] ["[1][0]/" compiler - ["[1][0]" phase] + ... ["[1][0]" phase] [language [lux ["[1][0]" analysis] @@ -30,7 +30,7 @@ (def /compiler (List $.Documentation) (list.together - (list /compiler/phase.documentation + (list ... /compiler/phase.documentation /compiler/analysis.documentation /compiler/declaration.documentation /compiler/translation.documentation diff --git a/stdlib/source/documentation/lux/meta/compiler/language/lux/translation.lux b/stdlib/source/documentation/lux/meta/compiler/language/lux/translation.lux index f37babfcd..0b614941e 100644 --- a/stdlib/source/documentation/lux/meta/compiler/language/lux/translation.lux +++ b/stdlib/source/documentation/lux/meta/compiler/language/lux/translation.lux @@ -49,10 +49,6 @@ ($.definition /.save!) ($.definition /.learn) ($.definition /.learn_custom) - ($.definition /.learn_analyser) - ($.definition /.learn_synthesizer) - ($.definition /.learn_translator) - ($.definition /.learn_declaration) ($.definition /.unknown_definition) ($.definition /.remember) ($.definition /.no_context) diff --git a/stdlib/source/documentation/lux/meta/extension.lux b/stdlib/source/documentation/lux/meta/extension.lux index 3c81d0205..8e1faf319 100644 --- a/stdlib/source/documentation/lux/meta/extension.lux +++ b/stdlib/source/documentation/lux/meta/extension.lux @@ -14,10 +14,9 @@ [macro ["[0]" template]] [compiler - ["[0]" phase] [language [lux - [phase + ["[0]" phase (.only) ["[0]" declaration]]]]]]]] [\\library ["[0]" /]]) @@ -40,7 +39,7 @@ ($.definition /.translation "" ($.example (translation ("my translation" self phase archive [pass_through <synthesis>.any]) - (phase archive pass_through)))) + (phase archive pass_through)))) ($.definition /.declaration "" diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index 882726779..c5d240074 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Definition Module Declaration #Definition #module comment) + [lux (.except Definition Module Declaration #Definition #module comment alias) ["[0]" debug] [abstract [monad (.only do)] @@ -533,6 +533,24 @@ (` (type_documentation (, g!module) (, g!type)))))))) ))))))) +(def alias_documentation + (syntax (_ [name ..qualified_symbol]) + (do meta.monad + [original (meta.alias name) + .let [link (let [[module short] original] + (%.format "#" module ":" short))]] + (in (list (` (all md.then + ... Name + (md.heading/4 (md.and (md.anchor (, (let [[module short] name] + (code.text (format module ":" short))))) + (md.text (, (code.text (%.code (|> name product.right code.local))))))) + (md.paragraph + (all md.and + (md.text (, (code.text "Alias for"))) + (md.link (md.text (, (code.text (%.symbol original)))) + (, (code.text link)))))) + )))))) + (def definition_documentation (syntax (_ [[name parameters] ..declaration description ..description @@ -606,6 +624,19 @@ ..#documentation (,* documentation)]}))] ((, g!_) [])))))))))) +(def .public alias + (syntax (_ [name ..qualified_symbol]) + (do meta.monad + [documentation (expansion.single (` (..alias_documentation (, (code.symbol name)))))] + (macro.with_symbols [g!_] + (let [[module short] name] + (in (list (` (.let [(, g!_) (.is (.-> .Any + ..Documentation) + (.function ((, g!_) (, g!_)) + {#Definition [..#global [(, (code.text module)) (, (code.text short))] + ..#documentation (,* documentation)]}))] + ((, g!_) [])))))))))) + (def (definition#< left right) (-> Definition Definition Bit) @@ -632,20 +663,30 @@ _ (format aggregate ..coverage_separator short))) "")) +(def (exported_non_default? [name [exported? global]]) + (-> [Text [Bit Global]] + Bit) + (when global + {.#Default _} + false + + _ + exported?)) + (`` (def .public module (syntax (_ [[name _] ..qualified_symbol description <code>.any]) - (do meta.monad - [coverage (meta.exports name) + (do [! meta.monad] + [coverage (|> (meta.globals name) + (of ! each (|>> (list.only exported_non_default?) + (list#each product.left)))) dependees (meta.imported_modules name)] (in (list (` (is Documentation {#Module [..#module (, (code.text name)) ..#description (, description) ..#dependees (|> (list (,* (list#each code.text dependees))) (set.of_list text.hash)) - ..#coverage (|> (, (code.text (|> coverage - (list#each product.left) - ..coverage_format))) + ..#coverage (|> (, (code.text (..coverage_format coverage))) (text.all_split_by (,, (static ..coverage_separator))) (set.of_list text.hash))]})))))))) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 261e555ba..6d0f9d390 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -510,7 +510,7 @@ (def (input_type input :it:) (-> Input Code Code) (let [:it: (if (the #try? input) - (` (.Either .Text (, :it:))) + (` (try.Try (, :it:))) :it:)] (if (the #io? input) (` (io.IO (, :it:))) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 25cc41183..4219acd70 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except try macro type local) + [lux (.except try macro type local alias) [abstract [functor (.only Functor)] [apply (.only Apply)] @@ -289,7 +289,7 @@ (list.sorted text#<) (text.interposed ..listing_separator))) -(with_template [<name> <yes> <no>] +(with_template [<name> <yes>] [(def .public (<name> name) (-> Symbol (Meta [Bit Global])) (do ..monad @@ -329,10 +329,7 @@ {.#Some (symbol#encoded [module_name def_name])} {.#None}) - {.#Alias _} - {.#None} - - {<no> _} + _ {.#None}))))))) list.together (list.sorted text#<) @@ -354,8 +351,9 @@ "") " All known modules: " all_known_modules text.new_line)})))))] - [definition .#Definition .#Default] - [default' .#Default .#Definition] + [definition .#Definition] + [default' .#Default] + [alias' .#Alias] ) (def .public (export name) @@ -409,6 +407,19 @@ (in it) (failure (all text#composite "Default is not an export: " (symbol#encoded name))))))))) +(def .public (alias name) + (-> Symbol + (Meta Symbol)) + (do [! ..monad] + [name (..normal name) + [exported? it] (..alias' name)] + (when it + {.#Alias it} + (in it) + + _ + (undefined)))) + (with_template [<name> <slot> <type>] [(def .public <name> (Meta <type>) diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux index 9b8f0934a..c9724b39b 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux @@ -26,19 +26,20 @@ (type .public Ancestry (Set descriptor.Module)) -(def fresh +(def .public fresh Ancestry (set.empty text.hash)) (type .public Graph (Dictionary descriptor.Module Ancestry)) -(def empty +(def .public empty Graph (dictionary.empty text.hash)) (def .public modules - (-> Graph (List descriptor.Module)) + (-> Graph + (List descriptor.Module)) dictionary.keys) (type .public Dependency @@ -47,13 +48,15 @@ #imports Ancestry])) (def .public graph - (-> (List Dependency) Graph) + (-> (List Dependency) + Graph) (list#mix (function (_ [module imports] graph) (dictionary.has module imports graph)) ..empty)) (def (ancestry archive) - (-> Archive Graph) + (-> Archive + Graph) (let [memo (is (Memo descriptor.Module Ancestry) (function (_ again module) (do [! state.monad] @@ -75,7 +78,8 @@ (archive.archived archive)))) (def (dependency? ancestry target source) - (-> Graph descriptor.Module descriptor.Module Bit) + (-> Graph descriptor.Module descriptor.Module + Bit) (let [target_ancestry (|> ancestry (dictionary.value target) (maybe.else ..fresh))] @@ -85,7 +89,9 @@ (List [descriptor.Module [module.ID (archive.Entry a)]])) (def .public (load_order key archive) - (All (_ a) (-> (Key a) Archive (Try (Order a)))) + (All (_ of) + (-> (Key of) Archive + (Try (Order of)))) (let [ancestry (..ancestry archive)] (|> ancestry dictionary.keys diff --git a/stdlib/source/library/lux/world/finance/market/price.lux b/stdlib/source/library/lux/world/finance/market/price.lux index c7b6e8e8c..9dbf1ab02 100644 --- a/stdlib/source/library/lux/world/finance/market/price.lux +++ b/stdlib/source/library/lux/world/finance/market/price.lux @@ -129,7 +129,7 @@ (%.format (%.int macro) (when micro +0 "" - _ (%.format "." (%.nat (.nat micro)))) + _ (%.format "." (%.nat (.nat (i.abs micro))))) " " (currency.alphabetic_code currency)))) ) diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux deleted file mode 100644 index 59b0148ec..000000000 --- a/stdlib/source/specification/lux/world/file.lux +++ /dev/null @@ -1,336 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - [io (.only IO)] - ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception] - [concurrency - ["[0]" async (.only Async)]] - [function - ["[0]" predicate]]] - [data - ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)] - [encoding - ["[0]" utf8 (.use "[1]#[0]" codec)]]] - ["[0]" binary (.only Binary) (.use "[1]#[0]" equivalence monoid) - ["$[1]" \\test]] - [collection - ["[0]" list]]] - [math - ["[0]" random] - [number - ["n" nat]]] - [world - [time - ["[0]" instant (.only Instant) (.use "[1]#[0]" equivalence)]]] - [test - ["_" property (.only Test)] - ["[0]" unit]]]] - [\\library - ["[0]" /]]) - -(def (for_path fs) - (-> (IO (/.System Async)) Test) - (<| (_.for [/.Path]) - (do [! random.monad] - [parent (random.numeric 2) - child (random.numeric 2)]) - in - (do async.monad - [fs (async.future fs)] - (all unit.and - (unit.coverage [/.rooted] - (let [path (/.rooted fs parent child)] - (and (text.starts_with? parent path) - (text.ends_with? child path)))) - (unit.coverage [/.parent] - (|> (/.rooted fs parent child) - (/.parent fs) - (maybe#each (text#= parent)) - (maybe.else false))) - (unit.coverage [/.name] - (|> (/.rooted fs parent child) - (/.name fs) - (text#= child))) - )))) - -(def (directory?&make_directory fs parent) - (-> (/.System Async) /.Path (Async Bit)) - (do async.monad - [directory_pre! (of fs directory? parent) - made? (of fs make_directory parent) - directory_post! (of fs directory? parent)] - (in (and (not directory_pre!) - (when made? - {try.#Success _} true - {try.#Failure _} false) - directory_post!)))) - -(def (file?&write fs content path) - (-> (/.System Async) Binary /.Path (Async Bit)) - (do async.monad - [file_pre! (of fs file? path) - made? (of fs write path content) - file_post! (of fs file? path)] - (in (and (not file_pre!) - (when made? - {try.#Success _} true - {try.#Failure _} false) - file_post!)))) - -(def (file_size&read&append fs expected_file_size content appendix path) - (-> (/.System Async) Nat Binary Binary /.Path (Async Bit)) - (do async.monad - [pre_file_size (of fs file_size path) - pre_content (of fs read path) - appended? (of fs append path appendix) - post_file_size (of fs file_size path) - post_content (of fs read path)] - (in (<| (try.else false) - (do [! try.monad] - [pre_file_size! - (of ! each (n.= expected_file_size) pre_file_size) - - pre_content! - (of ! each (binary#= content) pre_content) - - _ appended? - - post_file_size! - (of ! each (n.= (n.* 2 expected_file_size)) post_file_size) - - post_content! - (of ! each (binary#= (binary#composite content appendix)) post_content)] - (in (and pre_file_size! - pre_content! - post_file_size! - post_content!))))))) - -(def (modified?&last_modified fs expected_time path) - (-> (/.System Async) Instant /.Path (Async Bit)) - (do async.monad - [modified? (of fs modify path expected_time) - last_modified (of fs last_modified path)] - (in (<| (try.else false) - (do [! try.monad] - [_ modified?] - (of ! each (instant#= expected_time) last_modified)))))) - -(def (directory_files&sub_directories fs parent sub_dir child) - (-> (/.System Async) /.Path /.Path /.Path (Async Bit)) - (let [sub_dir (/.rooted fs parent sub_dir) - child (/.rooted fs parent child)] - (do async.monad - [made_sub? (of fs make_directory sub_dir) - directory_files (of fs directory_files parent) - sub_directories (of fs sub_directories parent) - .let [(open "list#[0]") (list.equivalence text.equivalence)]] - (in (<| (try.else false) - (do try.monad - [_ made_sub?] - (in (and (|> directory_files - (try#each (list#= (list child))) - (try.else false)) - (|> sub_directories - (try#each (list#= (list sub_dir))) - (try.else false)))))))))) - -(def (move&delete fs parent child alternate_child) - (-> (/.System Async) /.Path Text Text (Async Bit)) - (let [origin (/.rooted fs parent child) - destination (/.rooted fs parent alternate_child)] - (do [! async.monad] - [moved? (of fs move origin destination) - lost? (|> origin - (of fs file?) - (of ! each not)) - found? (of fs file? destination) - deleted? (of fs delete destination)] - (in (<| (try.else false) - (do try.monad - [_ moved? - _ deleted?] - (in (and lost? - found?)))))))) - -(def (for_system fs) - (-> (IO (/.System Async)) Test) - (<| (do [! random.monad] - [parent (random.numeric 2) - child (random.numeric 2) - sub_dir (random.only (|>> (text#= child) not) - (random.numeric 2)) - alternate_child (random.only (predicate.and - (|>> (text#= child) not) - (|>> (text#= sub_dir) not)) - (random.numeric 2)) - expected_file_size (of ! each (|>> (n.% 10) ++) random.nat) - content ($binary.random expected_file_size) - appendix ($binary.random expected_file_size) - expected_time random.instant]) - in - (do [! async.monad] - [fs (async.future fs) - .let [path (/.rooted fs parent child)] - - directory?&make_directory - (..directory?&make_directory fs parent) - - file?&write - (..file?&write fs content path) - - file_size&read&append - (..file_size&read&append fs expected_file_size content appendix path) - - modified?&last_modified - (..modified?&last_modified fs expected_time path) - - can_execute? - (|> path - (of fs can_execute?) - (of ! each (|>> (try.else true) not))) - - directory_files&sub_directories - (..directory_files&sub_directories fs parent sub_dir child) - - move&delete - (..move&delete fs parent child alternate_child)]) - (unit.coverage [/.System] - (and directory?&make_directory - file?&write - file_size&read&append - modified?&last_modified - can_execute? - directory_files&sub_directories - move&delete)))) - -(def (make_directories&cannot_make_directory fs) - (-> (IO (/.System Async)) Test) - (<| (do [! random.monad] - [dir/0 (random.numeric 2) - dir/1 (random.numeric 2) - dir/2 (random.numeric 2)]) - in - (do [! async.monad] - [fs (async.future fs) - .let [dir/1 (/.rooted fs dir/0 dir/1) - dir/2 (/.rooted fs dir/1 dir/2)] - pre_dir/0 (of fs directory? dir/0) - pre_dir/1 (of fs directory? dir/1) - pre_dir/2 (of fs directory? dir/2) - made? (/.make_directories ! fs dir/2) - post_dir/0 (of fs directory? dir/0) - post_dir/1 (of fs directory? dir/1) - post_dir/2 (of fs directory? dir/2) - - cannot_make_directory!/0 (/.make_directories ! fs "") - cannot_make_directory!/1 (/.make_directories ! fs (of fs separator))]) - (all unit.and - (unit.coverage [/.make_directories] - (and (not pre_dir/0) - (not pre_dir/1) - (not pre_dir/2) - (when made? - {try.#Success _} true - {try.#Failure _} false) - post_dir/0 - post_dir/1 - post_dir/2)) - (unit.coverage [/.cannot_make_directory] - (and (when cannot_make_directory!/0 - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_make_directory error)) - (when cannot_make_directory!/1 - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_make_directory error)))) - ))) - -(def (make_file&cannot_make_file fs) - (-> (IO (/.System Async)) Test) - (<| (do [! random.monad] - [file/0 (random.numeric 3)]) - in - (do [! async.monad] - [fs (async.future fs) - make_file!/0 (/.make_file ! fs (utf8#encoded file/0) file/0) - make_file!/1 (/.make_file ! fs (utf8#encoded file/0) file/0)]) - (all unit.and - (unit.coverage [/.make_file] - (when make_file!/0 - {try.#Success _} true - {try.#Failure error} false)) - (unit.coverage [/.cannot_make_file] - (when make_file!/1 - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_make_file error))) - ))) - -(def (for_utilities fs) - (-> (IO (/.System Async)) Test) - (all _.and - (..make_directories&cannot_make_directory fs) - (..make_file&cannot_make_file fs) - )) - -(def (exists? fs) - (-> (IO (/.System Async)) Test) - (<| (do [! random.monad] - [file (random.numeric 2) - dir (random.only (|>> (text#= file) not) - (random.numeric 2))]) - in - (do [! async.monad] - [fs (async.future fs) - - pre_file/0 (of fs file? file) - pre_file/1 (/.exists? ! fs file) - pre_dir/0 (of fs directory? dir) - pre_dir/1 (/.exists? ! fs dir) - - made_file? (/.make_file ! fs (utf8#encoded file) file) - made_dir? (of fs make_directory dir) - - post_file/0 (of fs file? file) - post_file/1 (/.exists? ! fs file) - post_dir/0 (of fs directory? dir) - post_dir/1 (/.exists? ! fs dir)]) - (unit.coverage [/.exists?] - (and (not pre_file/0) - (not pre_file/1) - (not pre_dir/0) - (not pre_dir/1) - - (when made_file? - {try.#Success _} true - {try.#Failure _} false) - (when made_dir? - {try.#Success _} true - {try.#Failure _} false) - - post_file/0 - post_file/1 - post_dir/0 - post_dir/1)))) - -(def .public (spec fs) - (-> (IO (/.System Async)) Test) - (all _.and - (..for_path fs) - (..for_utilities fs) - (..for_system fs) - (..exists? fs) - )) diff --git a/stdlib/source/specification/lux/world/shell.lux b/stdlib/source/specification/lux/world/shell.lux deleted file mode 100644 index f0248af56..000000000 --- a/stdlib/source/specification/lux/world/shell.lux +++ /dev/null @@ -1,98 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" try (.use "[1]#[0]" functor)] - [concurrency - ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]] - [data - ["[0]" product] - ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]]] - [math - ["[0]" random] - [number - ["n" nat] - ["i" int]]] - [test - ["_" property (.only Test)] - ["[0]" unit]]]] - [\\library - ["[0]" / (.only) - [// - [file (.only Path)] - ["[0]" environment - ["[1]" \\parser (.only Environment)]]]]]) - -(with_template [<name> <command> <type> <prep>] - [(def <name> - (-> <type> [Environment Path /.Command (List /.Argument)]) - (|>> <prep> list [environment.empty "~" <command>]))] - - [echo! "echo" Text (|>)] - [sleep! "sleep" Nat %.nat] - ) - -(def (can_wait! process) - (-> (/.Process Async) unit.Test) - (|> (of process await []) - (async#each (|>> (try#each (i.= /.normal)) - (try.else false) - (unit.coverage [/.Exit /.normal]))) - async#conjoint)) - -(def (can_read! expected process) - (-> Text (/.Process Async) (Async Bit)) - (|> (of process read []) - (async#each (|>> (try#each (text#= expected)) - (try.else false))))) - -(def (can_destroy! process) - (-> (/.Process Async) (Async Bit)) - (do async.monad - [?destroy (of process destroy []) - ?await (of process await [])] - (in (and (when ?destroy - {try.#Success _} - true - - {try.#Failure error} - false) - (when ?await - {try.#Success _} - false - - {try.#Failure error} - true))))) - -(with_expansions [<shell_coverage> (these [/.Command /.Argument])] - (def .public (spec shell) - (-> (/.Shell Async) Test) - (<| (_.for [/.Shell - /.execute - - /.Process - /.read /.fail /.write /.destroy /.await]) - (do [! random.monad] - [message (random.alphabetic 10) - seconds (of ! each (|>> (n.% 5) (n.+ 5)) random.nat)] - (in (do [! async.monad] - [?echo (of shell execute (..echo! message)) - ?sleep (of shell execute (..sleep! seconds))] - (when [?echo ?sleep] - [{try.#Success echo} {try.#Success sleep}] - (do ! - [can_read! (..can_read! message echo) - can_destroy! (..can_destroy! sleep)] - (all unit.and - (unit.coverage <shell_coverage> - (and can_read! - can_destroy!)) - (..can_wait! echo) - )) - - _ - (unit.coverage <shell_coverage> - false)))))))) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 1043b77c2..fe12454a0 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -56,10 +56,6 @@ (.,, (.these))))] ["[1][0]" compiler ... ["[1]/[0]" phase] - ... ["[1]/[0]" meta - ... ["[1]/[0]" import] - ... ["[1]/[0]" context] - ... ["[1]/[0]" cache]] ] ]))) @@ -1065,7 +1061,4 @@ /global.test /compiler.test - ... /compiler/meta/import.test - ... /compiler/meta/context.test - ... /compiler/meta/cache.test ))))) diff --git a/stdlib/source/test/lux/meta/compiler/meta.lux b/stdlib/source/test/lux/meta/compiler/meta.lux index e127adcbc..ebc2dbfc2 100644 --- a/stdlib/source/test/lux/meta/compiler/meta.lux +++ b/stdlib/source/test/lux/meta/compiler/meta.lux @@ -17,7 +17,10 @@ ["[1][0]" io] ["[1][0]" archive] ["[1][0]" cli] - ["[1][0]" export]]) + ["[1][0]" export] + ["[1][0]" import] + ["[1][0]" context] + ["[1][0]" cache]]) (def .public test Test @@ -33,4 +36,7 @@ /archive.test /cli.test /export.test + /import.test + /context.test + /cache.test ))) diff --git a/stdlib/source/test/lux/meta/compiler/meta/archive/module/descriptor.lux b/stdlib/source/test/lux/meta/compiler/meta/archive/module/descriptor.lux index 0d7fbae91..0ff48fdde 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/archive/module/descriptor.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/archive/module/descriptor.lux @@ -40,7 +40,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Descriptor]) + (_.for [/.Descriptor + /.#name /.#file /.#hash /.#state /.#references]) (do random.monad [expected (..random 5)]) (all _.and diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache.lux b/stdlib/source/test/lux/meta/compiler/meta/cache.lux index a2004598e..56a54d5dc 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache.lux @@ -21,6 +21,8 @@ ["[1][0]" module] ["[1][0]" artifact] ["[1][0]" purge] + ["[1][0]" dependency + ["[1]/[0]" module]] ["$/[1]" // ["[1][0]" context]]]) @@ -53,4 +55,5 @@ /module.test /artifact.test /purge.test + /dependency/module.test )))) diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache/dependency/module.lux b/stdlib/source/test/lux/meta/compiler/meta/cache/dependency/module.lux new file mode 100644 index 000000000..8c2633c95 --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/meta/cache/dependency/module.lux @@ -0,0 +1,61 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [data + ["[0]" text] + [collection + ["[0]" dictionary] + ["[0]" set (.use "[1]#[0]" equivalence)]]] + [math + ["[0]" random (.only Random)]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [module/0 (random.lower_cased 1) + module/1 (random.lower_cased 2) + module/2 (random.lower_cased 3)]) + (all _.and + (<| (_.for [/.Ancestry]) + (all _.and + (_.coverage [/.fresh] + (set.empty? /.fresh)) + )) + (<| (_.for [/.Graph]) + (all _.and + (_.coverage [/.empty] + (dictionary.empty? /.empty)) + (_.coverage [/.modules] + (let [expected (set.of_list text.hash (list module/0 module/1 module/2)) + actual (|> /.empty + (dictionary.has module/0 /.fresh) + (dictionary.has module/1 /.fresh) + (dictionary.has module/2 /.fresh) + /.modules + (set.of_list text.hash))] + (set#= expected actual))) + )) + (<| (_.for [/.Dependency]) + (all _.and + (_.coverage [/.graph] + (let [expected (set.of_list text.hash (list module/0 module/1 module/2)) + actual (|> (/.graph (list [module/0 /.fresh] + [module/1 /.fresh] + [module/2 /.fresh])) + /.modules + (set.of_list text.hash))] + (set#= expected actual))) + )) + (<| (_.for [/.Order]) + (all _.and + (_.coverage [/.load_order] + false) + )) + ))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index b7ffb5f6c..edc511f2b 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -5,35 +5,344 @@ ["[0]" monad (.only do)]] [control ["[0]" io (.only IO)] - ["[0]" try (.only Try)] + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)] ["[0]" exception] [concurrency ["[0]" async (.only Async)] - ["[0]" atom (.only Atom)]]] + ["[0]" atom (.only Atom)]] + [function + ["[0]" predicate]]] [data - ["[0]" binary (.only Binary) (.use "[1]#[0]" monoid)] - ["[0]" text (.use "[1]#[0]" equivalence)] + ["[0]" binary (.only Binary) (.use "[1]#[0]" equivalence monoid) + ["$[1]" \\test]] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)] + [encoding + ["[0]" utf8 (.use "[1]#[0]" codec)]]] [collection ["[0]" dictionary (.only Dictionary)] ["[0]" list]]] [math - ["[0]" random]] + ["[0]" random] + [number + ["n" nat]]] [meta [macro ["^" pattern]]] [world [time - ["[0]" instant (.only Instant)]]] + ["[0]" instant (.only Instant) (.use "[1]#[0]" equivalence)]]] [test - ["[0]" unit] - ["_" property (.only Test)]]]] + ["_" property (.only Test)] + ["[0]" unit]]]] ["[0]" / ["[1][0]" watch] ["[1][0]" extension]] [\\library - ["[0]" /]] - [\\specification - ["$[0]" /]]) + ["[0]" /]]) + +(def (for_path fs) + (-> (IO (/.System Async)) Test) + (<| (_.for [/.Path]) + (do [! random.monad] + [parent (random.numeric 2) + child (random.numeric 2)]) + in + (do async.monad + [fs (async.future fs)] + (all unit.and + (unit.coverage [/.rooted] + (let [path (/.rooted fs parent child)] + (and (text.starts_with? parent path) + (text.ends_with? child path)))) + (unit.coverage [/.parent] + (|> (/.rooted fs parent child) + (/.parent fs) + (maybe#each (text#= parent)) + (maybe.else false))) + (unit.coverage [/.name] + (|> (/.rooted fs parent child) + (/.name fs) + (text#= child))) + )))) + +(def (directory?&make_directory fs parent) + (-> (/.System Async) /.Path (Async Bit)) + (do async.monad + [directory_pre! (of fs directory? parent) + made? (of fs make_directory parent) + directory_post! (of fs directory? parent)] + (in (and (not directory_pre!) + (when made? + {try.#Success _} true + {try.#Failure _} false) + directory_post!)))) + +(def (file?&write fs content path) + (-> (/.System Async) Binary /.Path (Async Bit)) + (do async.monad + [file_pre! (of fs file? path) + made? (of fs write path content) + file_post! (of fs file? path)] + (in (and (not file_pre!) + (when made? + {try.#Success _} true + {try.#Failure _} false) + file_post!)))) + +(def (file_size&read&append fs expected_file_size content appendix path) + (-> (/.System Async) Nat Binary Binary /.Path (Async Bit)) + (do async.monad + [pre_file_size (of fs file_size path) + pre_content (of fs read path) + appended? (of fs append path appendix) + post_file_size (of fs file_size path) + post_content (of fs read path)] + (in (<| (try.else false) + (do [! try.monad] + [pre_file_size! + (of ! each (n.= expected_file_size) pre_file_size) + + pre_content! + (of ! each (binary#= content) pre_content) + + _ appended? + + post_file_size! + (of ! each (n.= (n.* 2 expected_file_size)) post_file_size) + + post_content! + (of ! each (binary#= (binary#composite content appendix)) post_content)] + (in (and pre_file_size! + pre_content! + post_file_size! + post_content!))))))) + +(def (modified?&last_modified fs expected_time path) + (-> (/.System Async) Instant /.Path (Async Bit)) + (do async.monad + [modified? (of fs modify path expected_time) + last_modified (of fs last_modified path)] + (in (<| (try.else false) + (do [! try.monad] + [_ modified?] + (of ! each (instant#= expected_time) last_modified)))))) + +(def (directory_files&sub_directories fs parent sub_dir child) + (-> (/.System Async) /.Path /.Path /.Path (Async Bit)) + (let [sub_dir (/.rooted fs parent sub_dir) + child (/.rooted fs parent child)] + (do async.monad + [made_sub? (of fs make_directory sub_dir) + directory_files (of fs directory_files parent) + sub_directories (of fs sub_directories parent) + .let [(open "list#[0]") (list.equivalence text.equivalence)]] + (in (<| (try.else false) + (do try.monad + [_ made_sub?] + (in (and (|> directory_files + (try#each (list#= (list child))) + (try.else false)) + (|> sub_directories + (try#each (list#= (list sub_dir))) + (try.else false)))))))))) + +(def (move&delete fs parent child alternate_child) + (-> (/.System Async) /.Path Text Text (Async Bit)) + (let [origin (/.rooted fs parent child) + destination (/.rooted fs parent alternate_child)] + (do [! async.monad] + [moved? (of fs move origin destination) + lost? (|> origin + (of fs file?) + (of ! each not)) + found? (of fs file? destination) + deleted? (of fs delete destination)] + (in (<| (try.else false) + (do try.monad + [_ moved? + _ deleted?] + (in (and lost? + found?)))))))) + +(def (for_system fs) + (-> (IO (/.System Async)) Test) + (<| (do [! random.monad] + [parent (random.numeric 2) + child (random.numeric 2) + sub_dir (random.only (|>> (text#= child) not) + (random.numeric 2)) + alternate_child (random.only (predicate.and + (|>> (text#= child) not) + (|>> (text#= sub_dir) not)) + (random.numeric 2)) + expected_file_size (of ! each (|>> (n.% 10) ++) random.nat) + content ($binary.random expected_file_size) + appendix ($binary.random expected_file_size) + expected_time random.instant]) + in + (do [! async.monad] + [fs (async.future fs) + .let [path (/.rooted fs parent child)] + + directory?&make_directory + (..directory?&make_directory fs parent) + + file?&write + (..file?&write fs content path) + + file_size&read&append + (..file_size&read&append fs expected_file_size content appendix path) + + modified?&last_modified + (..modified?&last_modified fs expected_time path) + + can_execute? + (|> path + (of fs can_execute?) + (of ! each (|>> (try.else true) not))) + + directory_files&sub_directories + (..directory_files&sub_directories fs parent sub_dir child) + + move&delete + (..move&delete fs parent child alternate_child)]) + (unit.coverage [/.System] + (and directory?&make_directory + file?&write + file_size&read&append + modified?&last_modified + can_execute? + directory_files&sub_directories + move&delete)))) + +(def (make_directories&cannot_make_directory fs) + (-> (IO (/.System Async)) Test) + (<| (do [! random.monad] + [dir/0 (random.numeric 2) + dir/1 (random.numeric 2) + dir/2 (random.numeric 2)]) + in + (do [! async.monad] + [fs (async.future fs) + .let [dir/1 (/.rooted fs dir/0 dir/1) + dir/2 (/.rooted fs dir/1 dir/2)] + pre_dir/0 (of fs directory? dir/0) + pre_dir/1 (of fs directory? dir/1) + pre_dir/2 (of fs directory? dir/2) + made? (/.make_directories ! fs dir/2) + post_dir/0 (of fs directory? dir/0) + post_dir/1 (of fs directory? dir/1) + post_dir/2 (of fs directory? dir/2) + + cannot_make_directory!/0 (/.make_directories ! fs "") + cannot_make_directory!/1 (/.make_directories ! fs (of fs separator))]) + (all unit.and + (unit.coverage [/.make_directories] + (and (not pre_dir/0) + (not pre_dir/1) + (not pre_dir/2) + (when made? + {try.#Success _} true + {try.#Failure _} false) + post_dir/0 + post_dir/1 + post_dir/2)) + (unit.coverage [/.cannot_make_directory] + (and (when cannot_make_directory!/0 + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_make_directory error)) + (when cannot_make_directory!/1 + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_make_directory error)))) + ))) + +(def (make_file&cannot_make_file fs) + (-> (IO (/.System Async)) Test) + (<| (do [! random.monad] + [file/0 (random.numeric 3)]) + in + (do [! async.monad] + [fs (async.future fs) + make_file!/0 (/.make_file ! fs (utf8#encoded file/0) file/0) + make_file!/1 (/.make_file ! fs (utf8#encoded file/0) file/0)]) + (all unit.and + (unit.coverage [/.make_file] + (when make_file!/0 + {try.#Success _} true + {try.#Failure error} false)) + (unit.coverage [/.cannot_make_file] + (when make_file!/1 + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_make_file error))) + ))) + +(def (for_utilities fs) + (-> (IO (/.System Async)) Test) + (all _.and + (..make_directories&cannot_make_directory fs) + (..make_file&cannot_make_file fs) + )) + +(def (exists? fs) + (-> (IO (/.System Async)) Test) + (<| (do [! random.monad] + [file (random.numeric 2) + dir (random.only (|>> (text#= file) not) + (random.numeric 2))]) + in + (do [! async.monad] + [fs (async.future fs) + + pre_file/0 (of fs file? file) + pre_file/1 (/.exists? ! fs file) + pre_dir/0 (of fs directory? dir) + pre_dir/1 (/.exists? ! fs dir) + + made_file? (/.make_file ! fs (utf8#encoded file) file) + made_dir? (of fs make_directory dir) + + post_file/0 (of fs file? file) + post_file/1 (/.exists? ! fs file) + post_dir/0 (of fs directory? dir) + post_dir/1 (/.exists? ! fs dir)]) + (unit.coverage [/.exists?] + (and (not pre_file/0) + (not pre_file/1) + (not pre_dir/0) + (not pre_dir/1) + + (when made_file? + {try.#Success _} true + {try.#Failure _} false) + (when made_dir? + {try.#Success _} true + {try.#Failure _} false) + + post_file/0 + post_file/1 + post_dir/0 + post_dir/1)))) + +(def .public (spec fs) + (-> (IO (/.System Async)) + Test) + (all _.and + (..for_path fs) + (..for_utilities fs) + (..for_system fs) + (..exists? fs) + )) (type Disk (Dictionary /.Path (Either [Instant Binary] (List Text)))) @@ -251,9 +560,9 @@ file (random.lower_cased 1)] (all _.and (_.for [/.mock] - ($/.spec (io.io (/.mock /)))) + (..spec (io.io (/.mock /)))) (_.for [/.async] - ($/.spec (io.io (/.async (..fs /))))) + (..spec (io.io (/.async (..fs /))))) (in (do async.monad [.let [fs (/.mock /)] diff --git a/stdlib/source/test/lux/world/finance/market/price.lux b/stdlib/source/test/lux/world/finance/market/price.lux index 6525ce793..224fe23bf 100644 --- a/stdlib/source/test/lux/world/finance/market/price.lux +++ b/stdlib/source/test/lux/world/finance/market/price.lux @@ -91,8 +91,13 @@ (do ! [it (..random currency.usd 1000,00)] (_.coverage [/.format] - (and (text.starts_with? (%.int (/.movement it)) - (text.replaced_once "." "" (/.format it))) - (text.ends_with? (currency.alphabetic_code (/.currency it)) - (/.format it))))) + (let [starts_with_quantity! + (text.starts_with? (%.int (/.movement it)) + (text.replaced_once "." "" (/.format it))) + + ends_with_currency! + (text.ends_with? (currency.alphabetic_code (/.currency it)) + (/.format it))] + (and starts_with_quantity! + ends_with_currency!)))) ))) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index 12788d7b2..b3ea3ca46 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -4,13 +4,15 @@ [abstract [monad (.only do)]] [control - ["[0]" try (.only Try)] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)] ["[0]" exception] ["[0]" io (.only IO)] [concurrency - ["[0]" async (.only Async)]]] + ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]] [data - ["[0]" text (.use "[1]#[0]" equivalence)] + ["[0]" product] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] [collection ["[0]" list]]] [math @@ -19,16 +21,86 @@ ["n" nat] ["i" int]]] [test - ["[0]" unit] - ["_" property (.only Test)]]]] + ["_" property (.only Test)] + ["[0]" unit]]]] [\\library ["[0]" / (.only) [// [file (.only Path)] ["[0]" environment - ["[1]" \\parser (.only Environment)]]]]] - [\\specification - ["$[0]" /]]) + ["[1]" \\parser (.only Environment)]]]]]) + +(with_template [<name> <command> <type> <prep>] + [(def <name> + (-> <type> [Environment Path /.Command (List /.Argument)]) + (|>> <prep> list [environment.empty "~" <command>]))] + + [echo! "echo" Text (|>)] + [sleep! "sleep" Nat %.nat] + ) + +(def (can_wait! process) + (-> (/.Process Async) unit.Test) + (|> (of process await []) + (async#each (|>> (try#each (i.= /.normal)) + (try.else false) + (unit.coverage [/.Exit /.normal]))) + async#conjoint)) + +(def (can_read! expected process) + (-> Text (/.Process Async) (Async Bit)) + (|> (of process read []) + (async#each (|>> (try#each (text#= expected)) + (try.else false))))) + +(def (can_destroy! process) + (-> (/.Process Async) (Async Bit)) + (do async.monad + [?destroy (of process destroy []) + ?await (of process await [])] + (in (and (when ?destroy + {try.#Success _} + true + + {try.#Failure error} + false) + (when ?await + {try.#Success _} + false + + {try.#Failure error} + true))))) + +(with_expansions [<shell_coverage> (these [/.Command /.Argument])] + (def .public (spec shell) + (-> (/.Shell Async) + Test) + (<| (_.for [/.Shell + /.execute + + /.Process + /.read /.fail /.write /.destroy /.await]) + (do [! random.monad] + [message (random.alphabetic 10) + seconds (of ! each (|>> (n.% 5) (n.+ 5)) random.nat)] + (in (do [! async.monad] + [?echo (of shell execute (..echo! message)) + ?sleep (of shell execute (..sleep! seconds))] + (when [?echo ?sleep] + [{try.#Success echo} {try.#Success sleep}] + (do ! + [can_read! (..can_read! message echo) + can_destroy! (..can_destroy! sleep)] + (all unit.and + (unit.coverage <shell_coverage> + (and can_read! + can_destroy!)) + (..can_wait! echo) + )) + + _ + (unit.coverage <shell_coverage> + false)))))))) (exception.def dead) @@ -90,8 +162,8 @@ /.on_read /.on_fail /.on_write /.on_destroy /.on_await /.async] - ($/.spec (/.async (/.mock (|>> ..mock {try.#Success}) - false)))) + (..spec (/.async (/.mock (|>> ..mock {try.#Success}) + false)))) (_.coverage [/.error] (not (i.= /.normal /.error))) (do random.monad |