diff options
author | Eduardo Julian | 2020-04-22 02:52:57 -0400 |
---|---|---|
committer | Eduardo Julian | 2020-04-22 02:52:57 -0400 |
commit | a419ec66895e07fbb54ecc59f92e154126a10ac5 (patch) | |
tree | 54c282bb5dcdd2bb554dcd30abd71aa6b4bc5810 /stdlib | |
parent | d636f97db32f0ca3aa1705c5290afc07314adc53 (diff) |
Now caching the documents generated after compiling each module.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/control/parser/binary.lux | 19 | ||||
-rw-r--r-- | stdlib/source/lux/control/try.lux | 8 | ||||
-rw-r--r-- | stdlib/source/lux/data/format/binary.lux | 17 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/default/cache.lux | 35 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/default/platform.lux | 33 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/language/lux.lux | 86 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/meta/archive/artifact.lux | 35 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux | 32 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/meta/archive/document.lux | 36 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/meta/archive/signature.lux | 17 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/meta/io/archive.lux | 26 | ||||
-rw-r--r-- | stdlib/source/test/lux/abstract/enum.lux | 45 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/try.lux | 89 |
13 files changed, 353 insertions, 125 deletions
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 0ee4112b1..dc1b95ac7 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -2,7 +2,8 @@ [lux (#- and or nat int rev list type) [type (#+ :share)] [abstract - [monad (#+ do)]] + [monad (#+ do)] + [hash (#+ Hash)]] [control ["." try (#+ Try)] ["." exception (#+ exception:)]] @@ -15,7 +16,9 @@ ["." encoding] ["%" format (#+ format)]] [collection - ["." row (#+ Row)]]]] + ["." list] + ["." row (#+ Row)] + ["." set (#+ Set)]]]] ["." // ("#@." monad)]) (type: #export Offset Nat) @@ -176,6 +179,18 @@ (..or ..any (//.and value recur))))) +(exception: #export set-elements-are-not-unique) + +(def: #export (set hash value) + (All [a] (-> (Hash a) (Parser a) (Parser (Set a)))) + (do //.monad + [raw (list value) + #let [output (set.from-list hash raw)] + _ (//.assert (exception.construct ..set-elements-are-not-unique []) + (n.= (list.size raw) + (set.size output)))] + (wrap output))) + (def: #export name (Parser Name) (//.and ..text ..text)) diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux index 7202f5c75..749b05a53 100644 --- a/stdlib/source/lux/control/try.lux +++ b/stdlib/source/lux/control/try.lux @@ -78,13 +78,13 @@ (All [M a] (-> (Monad M) (-> (M a) (M (Try a))))) (:: monad map (:: ..monad wrap))) -(structure: #export (equivalence (^open ",@.")) +(structure: #export (equivalence (^open "_@.")) (All [a] (-> (Equivalence a) (Equivalence (Try a)))) (def: (= reference sample) (case [reference sample] [(#Success reference) (#Success sample)] - (,@= reference sample) + (_@= reference sample) [(#Failure reference) (#Failure sample)] ("lux text =" reference sample) @@ -124,9 +124,9 @@ "if a (Try x) value turns out to be #Failure." "Note: the expression for the default value will not be computed if the base computation succeeds." (= "bar" - (default "foo" (#Success "bar"))) + (default "foo" (#..Success "bar"))) (= "foo" - (default "foo" (#Failure "KABOOM!"))))} + (default "foo" (#..Failure "KABOOM!"))))} (case tokens (^ (list else try)) (#Success [compiler (list (` (case (~ try) diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index 3e1282046..fd812a31a 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -7,11 +7,10 @@ [monad (#+ Monad do)] [equivalence (#+ Equivalence)]] [control + ["." function] ["." try (#+ Try)] ["<>" parser ("#@." monad) - ["/" binary (#+ Offset Size Parser)]] - ["." function] - ["ex" exception (#+ exception:)]] + ["/" binary (#+ Offset Size Parser)]]] [data ["." product] ["." binary (#+ Binary)] @@ -24,7 +23,8 @@ ["%" format (#+ format)]] [collection ["." list] - ["." row (#+ Row) ("#@." functor)]]]]) + ["." row (#+ Row) ("#@." functor)] + ["." set (#+ Set)]]]]) (def: mask (-> Size (I64 Any)) @@ -110,9 +110,8 @@ (def: #export (rec body) (All [a] (-> (-> (Writer a) (Writer a)) (Writer a))) - (function (_ value) - (let [writer (body (rec body))] - (writer value)))) + (function (recur value) + (body recur value))) (def: #export any (Writer Any) @@ -214,6 +213,10 @@ (|>> (..and value) (..or ..any)))) +(def: #export (set value) + (All [a] (-> (Writer a) (Writer (Set a)))) + (|>> set.to-list (..list value))) + (def: #export name (Writer Name) (..and ..text ..text)) diff --git a/stdlib/source/lux/tool/compiler/default/cache.lux b/stdlib/source/lux/tool/compiler/default/cache.lux deleted file mode 100644 index 1770b4a82..000000000 --- a/stdlib/source/lux/tool/compiler/default/cache.lux +++ /dev/null @@ -1,35 +0,0 @@ -(.module: - [lux #* - [data - [format - ["_" binary (#+ Format)]]]]) - -(def: definition - (Format Definition) - ($_ _.and _.type _.code _.any)) - -(def: alias - (Format [Text Text]) - (_.and _.text _.text)) - -## TODO: Remove #module-hash, #imports & #module-state ASAP. -## TODO: Not just from this parser, but from the lux.Module type. -(def: #export module - (Format Module) - ($_ _.and - ## #module-hash - (_.ignore 0) - ## #module-aliases - (_.list ..alias) - ## #definitions - (_.list (_.and _.text ..definition)) - ## #imports - (_.list _.text) - ## #tags - (_.ignore (list)) - ## #types - (_.ignore (list)) - ## #module-annotations - (_.maybe _.code) - ## #module-state - (_.ignore #.Cached))) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 0d31b1f2d..9a4c6f20c 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -16,7 +16,9 @@ ["%" format (#+ format)]] [collection ["." list] - ["." row ("#@." functor)]]] + ["." row ("#@." functor)]] + [format + ["_" binary (#+ Writer)]]] [world ["." file (#+ Path)]]] ["." // #_ @@ -25,6 +27,7 @@ ["#." phase] [language [lux + ["$" /] ["." syntax] ["#." analysis [macro (#+ Expander)]] @@ -37,7 +40,8 @@ ["." module]]]]] [meta ["." archive (#+ Archive) - [descriptor (#+ Module)]] + ["." descriptor (#+ Descriptor Module)] + ["." document (#+ Document)]] [io ["." context] ["ioW" archive]]]]] @@ -66,9 +70,14 @@ <State+> (as-is (///directive.State+ anchor expression directive)) <Bundle> (as-is (///generation.Bundle anchor expression directive))] - (def: (cache-module platform host target-dir module-file-name module-id extension output) + (def: writer + (Writer [Descriptor (Document .Module)]) + (_.and descriptor.writer + (document.writer $.writer))) + + (def: (cache-module platform host target-dir module-file-name module-id extension [[descriptor document] output]) (All <type-vars> - (-> <Platform> Host Path Path archive.ID Text Output + (-> <Platform> Host Path Path archive.ID Text [[Descriptor (Document Any)] Output] (Promise (Try Any)))) (let [system (get@ #&file-system platform) write-artifact! (: (-> [Text Binary] (Action Any)) @@ -79,12 +88,11 @@ _ (|> output row.to-list (monad.map ..monad write-artifact!) - (: (Action (List Any))))] - (wrap []) - ## (&io.write target-dir - ## (format module-name "/" cache.descriptor-name) - ## (encoding.to-utf8 (%.code (cache/description.write module-file-name module)))) - ))) + (: (Action (List Any)))) + document (:: promise.monad wrap + (document.check //init.key document))] + (ioW.cache system host target-dir module-id + (_.run ..writer [descriptor document]))))) ## TODO: Inline ASAP (def: initialize-buffer! @@ -220,7 +228,7 @@ (#.Left more) (continue! archive state more) - (#.Right [descriptor+document output]) + (#.Right payload) (do (try.with promise.monad) [_ (..cache-module platform host @@ -228,7 +236,8 @@ (get@ #///.file input) module-id extension - output)] + payload) + #let [[descriptor+document output] payload]] (case (archive.add module descriptor+document archive) (#try.Success archive) (wrap [archive state]) diff --git a/stdlib/source/lux/tool/compiler/language/lux.lux b/stdlib/source/lux/tool/compiler/language/lux.lux new file mode 100644 index 000000000..ed3b0ed9b --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux.lux @@ -0,0 +1,86 @@ +(.module: + [lux #* + [control + ["<>" parser + ["<b>" binary (#+ Parser)]]] + [data + [format + ["_" binary (#+ Writer)]]]]) + +## TODO: Remove #module-hash, #imports & #module-state ASAP. +## TODO: Not just from this parser, but from the lux.Module type. +(def: #export writer + (Writer .Module) + (let [definition (: (Writer Definition) + ($_ _.and _.bit _.type _.code _.any)) + name (: (Writer Name) + (_.and _.text _.text)) + alias name + global (: (Writer Global) + (_.or alias definition)) + tag (: (Writer [Nat (List Name) Bit Type]) + ($_ _.and + _.nat + (_.list name) + _.bit + _.type)) + type (: (Writer [(List Name) Bit Type]) + ($_ _.and + (_.list name) + _.bit + _.type))] + ($_ _.and + ## #module-hash + _.nat + ## #module-aliases + (_.list alias) + ## #definitions + (_.list (_.and _.text global)) + ## #imports + (_.list _.text) + ## #tags + (_.list (_.and _.text tag)) + ## #types + (_.list (_.and _.text type)) + ## #module-annotations + (_.maybe _.code) + ## #module-state + _.any))) + +(def: #export parser + (Parser .Module) + (let [definition (: (Parser Definition) + ($_ <>.and <b>.bit <b>.type <b>.code <b>.any)) + name (: (Parser Name) + (<>.and <b>.text <b>.text)) + alias name + global (: (Parser Global) + (<>.or alias definition)) + tag (: (Parser [Nat (List Name) Bit Type]) + ($_ <>.and + <b>.nat + (<b>.list name) + <b>.bit + <b>.type)) + type (: (Parser [(List Name) Bit Type]) + ($_ <>.and + (<b>.list name) + <b>.bit + <b>.type))] + ($_ <>.and + ## #module-hash + <b>.nat + ## #module-aliases + (<b>.list alias) + ## #definitions + (<b>.list (<>.and <b>.text global)) + ## #imports + (<b>.list <b>.text) + ## #tags + (<b>.list (<>.and <b>.text tag)) + ## #types + (<b>.list (<>.and <b>.text type)) + ## #module-annotations + (<b>.maybe <b>.code) + ## #module-state + (:: <>.monad wrap #.Cached)))) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux index 2d4559275..7f3e1654d 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux @@ -1,11 +1,19 @@ (.module: [lux #* + [abstract + [monad (#+ do)]] + [control + ["<>" parser + ["<b>" binary (#+ Parser)]]] [data + ["." product] ["." text] [collection - ["." list] + ["." list ("#@." functor fold)] ["." row (#+ Row)] - ["." dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)]] + [format + ["." binary (#+ Writer)]]] [type abstract]]) @@ -17,6 +25,7 @@ (abstract: #export Registry {} + {#artifacts (Row Artifact) #resolver (Dictionary Text ID)} @@ -63,4 +72,26 @@ (|> (:representation registry) (get@ #resolver) (dictionary.get name))) + + (def: #export writer + (Writer Registry) + (let [writer|artifacts (binary.list (binary.maybe binary.text))] + (|>> :representation + (get@ #artifacts) + row.to-list + (list@map (get@ #name)) + writer|artifacts))) + + (def: #export parser + (Parser Registry) + (|> (<b>.list (<b>.maybe <b>.text)) + (:: <>.monad map (list@fold (function (_ artifact registry) + (product.right + (case artifact + #.None + (..resource registry) + + (#.Some name) + (..definition name registry)))) + ..empty)))) ) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux index c6e1e7841..24562367a 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux @@ -1,12 +1,18 @@ (.module: [lux (#- Module) + [control + ["<>" parser + ["<b>" binary (#+ Parser)]]] [data + ["." text] [collection - [set (#+ Set)]]] + [set (#+ Set)]] + [format + ["." binary (#+ Writer)]]] [world [file (#+ Path)]]] [// - [artifact (#+ Registry)]]) + ["." artifact (#+ Registry)]]) (type: #export Module Text) @@ -17,3 +23,25 @@ #state Module-State #references (Set Module) #registry Registry}) + +(def: #export writer + (Writer Descriptor) + ($_ binary.and + binary.text + binary.text + binary.nat + binary.any + (binary.set binary.text) + artifact.writer + )) + +(def: #export parser + (Parser Descriptor) + ($_ <>.and + <b>.text + <b>.text + <b>.nat + (:: <>.monad wrap #.Cached) + (<b>.set text.hash <b>.text) + artifact.parser + )) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/lux/tool/compiler/meta/archive/document.lux index e6d5c0dfe..19b8576a1 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/document.lux @@ -1,11 +1,17 @@ (.module: [lux (#- Module) + [abstract + [monad (#+ do)]] [control ["." try (#+ Try)] - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)] + ["<>" parser + ["<b>" binary (#+ Parser)]]] [data [collection - ["." dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)]] + [format + ["." binary (#+ Writer)]]] [type (#+ :share) abstract]] [// @@ -14,8 +20,9 @@ [descriptor (#+ Module)]]) (exception: #export (invalid-signature {expected Signature} {actual Signature}) - (ex.report ["Expected" (signature.description expected)] - ["Actual" (signature.description actual)])) + (exception.report + ["Expected" (signature.description expected)] + ["Actual" (signature.description actual)])) (abstract: #export (Document d) {} @@ -34,15 +41,32 @@ key} {e document//content})) - (ex.throw invalid-signature [(key.signature key) - document//signature])))) + (exception.throw ..invalid-signature [(key.signature key) + document//signature])))) (def: #export (write key content) (All [d] (-> (Key d) d (Document d))) (:abstraction {#signature (key.signature key) #content content})) + (def: #export (check key document) + (All [d] (-> (Key d) (Document Any) (Try (Document d)))) + (do try.monad + [_ (..read key document)] + (wrap (:assume document)))) + (def: #export signature (-> (Document Any) Signature) (|>> :representation (get@ #signature))) + + (def: #export (writer content) + (All [d] (-> (Writer d) (Writer (Document d)))) + (let [writer (binary.and signature.writer + content)] + (|>> :representation writer))) + + (def: #export parser + (All [d] (-> (Parser d) (Parser (Document d)))) + (|>> (<>.and signature.parser) + (:: <>.monad map (|>> :abstraction)))) ) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux index 551c54579..3d795ff50 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux @@ -2,10 +2,15 @@ [lux #* [abstract ["." equivalence (#+ Equivalence)]] + [control + ["<>" parser + ["<b>" binary (#+ Parser)]]] [data ["." name] ["." text - ["%" format (#+ format)]]]] + ["%" format (#+ format)]] + [format + ["." binary (#+ Writer)]]]] [//// [version (#+ Version)]]) @@ -20,3 +25,13 @@ (def: #export (description signature) (-> Signature Text) (format (%.name (get@ #name signature)) " " (get@ #version signature))) + +(def: #export writer + (Writer Signature) + (binary.and (binary.and binary.text binary.text) + binary.text)) + +(def: #export parser + (Parser Signature) + (<>.and (<>.and <b>.text <b>.text) + <b>.text)) diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index e71641727..ee7af993b 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -38,7 +38,7 @@ (:: system separator) //.lux-context)) -(def: #export (document system host root module-id) +(def: (module system host root module-id) (-> (System Promise) Host Path archive.ID Path) (format (..lux-archive system host root) (:: system separator) @@ -46,7 +46,7 @@ (def: #export (artifact system host root module-id name extension) (-> (System Promise) Host Path archive.ID Text Text Path) - (format (document system host root module-id) + (format (..module system host root module-id) (:: system separator) name extension)) @@ -54,13 +54,13 @@ (def: #export (prepare system host root module-id) (-> (System Promise) Host Path archive.ID (Promise (Try Any))) (do promise.monad - [#let [document (..document system host root module-id)] - document-exists? (file.exists? promise.monad system document)] - (if document-exists? + [#let [module (..module system host root module-id)] + module-exists? (file.exists? promise.monad system module)] + (if module-exists? (wrap (#try.Success [])) (do @ [_ (file.get-directory @ system (..lux-archive system host root)) - outcome (!.use (:: system create-directory) document)] + outcome (!.use (:: system create-directory) module)] (case outcome (#try.Success output) (wrap (#try.Success [])) @@ -112,3 +112,17 @@ (#try.Failure error) (wrap (#try.Success archive.empty))))) + +(def: (module-descriptor system host root module-id) + (-> (System Promise) Host Path archive.ID Path) + (format (..module system host root module-id) + (:: system separator) + "module-descriptor")) + +(def: #export (cache system host root module-id content) + (-> (System Promise) Host Path archive.ID Binary (Promise (Try Any))) + (do (try.with promise.monad) + [artifact (: (Promise (Try (File Promise))) + (file.get-file promise.monad system + (..module-descriptor system host root module-id)))] + (!.use (:: artifact over-write) content))) diff --git a/stdlib/source/test/lux/abstract/enum.lux b/stdlib/source/test/lux/abstract/enum.lux index b67f846f5..b6a490358 100644 --- a/stdlib/source/test/lux/abstract/enum.lux +++ b/stdlib/source/test/lux/abstract/enum.lux @@ -1,7 +1,6 @@ (.module: [lux #* [data - ["%" text/format (#+ format)] ["." product] ["." maybe ("#@." functor)] [number @@ -26,35 +25,35 @@ [start end] [end start]) range (/.range n.enum start end)]] - (<| (_.context (%.name (name-of /.Enum))) + (<| (_.covering /._) ($_ _.and - (_.test (%.name (name-of /.range)) - (let [expected-size (|> end (n.- start) inc) - expected-start? (|> range list.head (maybe@map (n.= start)) (maybe.default false)) - expected-end? (|> range list.last (maybe@map (n.= end)) (maybe.default false)) - every-element-is-a-successor? (case range - (#.Cons head tail) - (|> (list@fold (function (_ next [verdict prev]) - [(and verdict - (n.= next (:: n.enum succ prev))) - next]) - [true head] - tail) - product.left) - - #.Nil - false)] - (and (n.= expected-size (list.size range)) - expected-start? - expected-end? - every-element-is-a-successor?))) + (_.cover [/.range] + (let [expected-size (|> end (n.- start) inc) + expected-start? (|> range list.head (maybe@map (n.= start)) (maybe.default false)) + expected-end? (|> range list.last (maybe@map (n.= end)) (maybe.default false)) + every-element-is-a-successor? (case range + (#.Cons head tail) + (|> (list@fold (function (_ next [verdict prev]) + [(and verdict + (n.= next (:: n.enum succ prev))) + next]) + [true head] + tail) + product.left) + + #.Nil + false)] + (and (n.= expected-size (list.size range)) + expected-start? + expected-end? + every-element-is-a-successor?))) ))))) (def: #export (spec (^open "/@.") gen-sample) (All [a] (-> (Enum a) (Random a) Test)) (do r.monad [sample gen-sample] - (<| (_.context (%.name (name-of /.Enum))) + (<| (_.with-cover [/.Enum]) ($_ _.and (_.test "Successor and predecessor are inverse functions." (and (/@= (|> sample /@succ /@pred) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 47e51b54b..08c19794d 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -13,11 +13,11 @@ pipe ["." io]] [data - ["%" text/format (#+ format)] + ["." text ("#@." equivalence)] [number ["n" nat]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Try)]}) @@ -32,33 +32,72 @@ (def: #export (try element) (All [a] (-> (Random a) (Random (Try a)))) - ($_ r.or - (r.unicode 1) + ($_ random.or + (random.unicode 1) element)) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.covering /._) + (_.with-cover [/.Try]) + (do random.monad + [expected random.nat + alternative (|> random.nat (random.filter (|>> (n.= expected) not))) + error (random.unicode 1) + #let [(^open "io@.") io.monad]]) ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (..try r.nat)) - ($functor.spec ..injection ..comparison /.functor) - ($apply.spec ..injection ..comparison /.apply) - ($monad.spec ..injection ..comparison /.monad) - (do r.monad - [left r.nat - right r.nat - #let [expected (n.+ left right) - (^open "io@.") io.monad]] - (_.test "Can add try functionality to any monad." - (let [lift (/.lift io.monad)] - (|> (do (/.with io.monad) - [a (lift (io@wrap left)) - b (wrap right)] - (wrap (n.+ a b))) - io.run - (case> (#/.Success actual) - (n.= expected actual) + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (..try random.nat))) + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - _ - false))))) + (_.cover [/.succeed] + (case (/.succeed expected) + (#/.Success actual) + (n.= expected actual) + + _ + false)) + (_.cover [/.fail] + (case (/.fail error) + (#/.Failure message) + (text@= error message) + + _ + false)) + (_.cover [/.assume] + (n.= expected + (/.assume (/.succeed expected)))) + (_.cover [/.maybe] + (case [(/.maybe (/.succeed expected)) + (/.maybe (/.fail error))] + [(#.Some actual) #.None] + (n.= expected actual) + + _ + false)) + (_.cover [/.default] + (and (n.= expected + (/.default alternative (/.succeed expected))) + (n.= alternative + (/.default alternative (: (Try Nat) + (/.fail error)))))) + + (_.cover [/.with /.lift] + (let [lift (/.lift io.monad)] + (|> (do (/.with io.monad) + [a (lift (io@wrap expected)) + b (wrap alternative)] + (wrap (n.+ a b))) + io.run + (case> (#/.Success result) + (n.= (n.+ expected alternative) + result) + + _ + false)))) ))) |