From 91c0619657bcf2ac520e7dd2912188f66bbe2157 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 2 Jul 2019 23:36:02 -0400 Subject: Re-name "lux/data/error" to "lux/control/try". --- stdlib/source/test/lux/abstract/codec.lux | 9 +-- stdlib/source/test/lux/control.lux | 2 + .../source/test/lux/control/concurrency/actor.lux | 12 ++-- stdlib/source/test/lux/control/parser.lux | 18 +++--- stdlib/source/test/lux/control/parser/cli.lux | 26 ++++----- stdlib/source/test/lux/control/parser/text.lux | 12 ++-- stdlib/source/test/lux/control/region.lux | 21 +++---- stdlib/source/test/lux/control/try.lux | 64 ++++++++++++++++++++++ stdlib/source/test/lux/data.lux | 2 - stdlib/source/test/lux/data/binary.lux | 23 ++++---- stdlib/source/test/lux/data/error.lux | 64 ---------------------- stdlib/source/test/lux/data/format/json.lux | 1 - stdlib/source/test/lux/data/format/xml.lux | 2 +- stdlib/source/test/lux/data/number/rev.lux | 1 - stdlib/source/test/lux/data/text/regex.lux | 12 ++-- stdlib/source/test/lux/macro/poly/json.lux | 1 - stdlib/source/test/lux/macro/syntax.lux | 4 +- stdlib/source/test/lux/math/modular.lux | 23 ++++---- stdlib/source/test/lux/target/jvm.lux | 20 ++++--- stdlib/source/test/lux/time/duration.lux | 2 - .../test/lux/tool/compiler/default/syntax.lux | 2 +- .../lux/tool/compiler/phase/analysis/function.lux | 8 +-- .../lux/tool/compiler/phase/analysis/primitive.lux | 21 ++++--- .../lux/tool/compiler/phase/analysis/reference.lux | 14 ++--- .../lux/tool/compiler/phase/analysis/structure.lux | 20 +++---- .../tool/compiler/phase/extension/analysis/lux.lux | 6 +- .../lux/tool/compiler/phase/synthesis/case.lux | 13 ++--- .../lux/tool/compiler/phase/synthesis/function.lux | 14 ++--- .../tool/compiler/phase/synthesis/primitive.lux | 7 +-- .../tool/compiler/phase/synthesis/structure.lux | 8 +-- stdlib/source/test/lux/type/dynamic.lux | 12 ++-- stdlib/source/test/lux/world/file.lux | 56 +++++++++---------- 32 files changed, 249 insertions(+), 251 deletions(-) create mode 100644 stdlib/source/test/lux/control/try.lux delete mode 100644 stdlib/source/test/lux/data/error.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux index 99afe290f..b6bbdd91e 100644 --- a/stdlib/source/test/lux/abstract/codec.lux +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -2,9 +2,10 @@ [lux #* ["_" test (#+ Test)] [abstract/monad (#+ do)] + [control + ["." try]] [data - ["%" text/format (#+ format)] - ["." error]] + ["%" text/format (#+ format)]] [math ["r" random (#+ Random)]]] {1 @@ -19,8 +20,8 @@ (<| (_.context (%.name (name-of /.Codec))) (_.test "Isomorphism." (case (|> expected /@encode /@decode) - (#error.Success actual) + (#try.Success actual) (/@= expected actual) - (#error.Failure error) + (#try.Failure _) false))))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 26fd02ab9..12c906664 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -3,6 +3,7 @@ ["_" test (#+ Test)]] ["." / #_ ["#." continuation] + ["#." try] ["#." exception] ["#." io] ["#." parser] @@ -52,6 +53,7 @@ Test ($_ _.and /continuation.test + /try.test /exception.test /io.test /parser.test diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 017ee60ef..cc7456292 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -3,10 +3,10 @@ ["_" test (#+ Test)] [abstract/monad (#+ do)] [control + ["." try] ["ex" exception] ["." io (#+ IO io)]] [data - ["." error] [text ["%" format (#+ format)]]] [math @@ -20,7 +20,7 @@ Nat ((handle message state self) - (do (error.with promise.monad) + (do (try.with promise.monad) [#let [_ (log! "BEFORE")] output (message state self) #let [_ (log! "AFTER")]] @@ -34,7 +34,7 @@ (message: #export Counter (count! {increment Nat} state self Nat) (let [state' (n/+ increment state)] - (promise;wrap (#error.Success [state' state'])))) + (promise;wrap (#try.Success [state' state'])))) (def: #export test Test @@ -64,7 +64,7 @@ (:: r.monad wrap (do promise.monad - [result (do (error.with promise.monad) + [result (do (try.with promise.monad) [#let [counter (io.run (new@Counter 0))] output-1 (count! 1 counter) output-2 (count! 1 counter) @@ -74,9 +74,9 @@ (n/= 3 output-3))))] (_.assert "Can send messages to actors." (case result - (#error.Success outcome) + (#try.Success outcome) outcome - (#error.Failure error) + (#try.Failure _) #0)))) )))) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index d9ea8865b..fc8de4828 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -10,10 +10,10 @@ ["$." apply] ["$." monad]]}] [control + ["." try (#+ Try)] [parser ["s" code]]] [data - ["." error (#+ Error)] [number ["." nat]] ["." text ("#;." equivalence) @@ -29,9 +29,9 @@ ["." / (#+ Parser)]}) (def: (should-fail expected input) - (All [a] (-> Text (Error a) Bit)) + (All [a] (-> Text (Try a) Bit)) (case input - (#error.Failure actual) + (#try.Failure actual) (text;= expected actual) _ @@ -40,7 +40,7 @@ (def: (enforced? parser input) (All [s] (-> (Parser s Any) s Bit)) (case (/.run parser input) - (#error.Success [_ []]) + (#try.Success [_ []]) #1 _ @@ -49,16 +49,16 @@ (def: (found? parser input) (All [s] (-> (Parser s Bit) s Bit)) (case (/.run parser input) - (#error.Success [_ #1]) + (#try.Success [_ #1]) #1 _ #0)) (def: (fails? input) - (All [a] (-> (Error a) Bit)) + (All [a] (-> (Try a) Bit)) (case input - (#error.Failure _) + (#try.Failure _) #1 _ @@ -66,7 +66,7 @@ (syntax: (match pattern then input) (wrap (list (` (case (~ input) - (^ (#error.Success [(~' _) (~ pattern)])) + (^ (#try.Success [(~' _) (~ pattern)])) (~ then) (~' _) @@ -216,7 +216,7 @@ (Comparison (All [a i] (Parser i a))) (function (_ == left right) (case [(/.run left []) (/.run right [])] - [(#error.Success [_ left]) (#error.Success [_ right])] + [(#try.Success [_ left]) (#try.Success [_ right])] (== left right) _ diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux index 5c87513d4..b304a2ab2 100644 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ b/stdlib/source/test/lux/control/parser/cli.lux @@ -7,9 +7,9 @@ ["r" math/random] [control pipe + ["." try] ["p" parser]] [data - ["." error] [number ["." nat ("#@." decimal)]] ["." text ("#@." equivalence)] @@ -33,44 +33,44 @@ ($_ _.and (_.test "Can read any argument." (|> (/.run /.any (list yes)) - (case> (#error.Failure _) + (case> (#try.Failure _) #0 - (#error.Success arg) + (#try.Success arg) (text@= arg yes)))) (_.test "Can test tokens." (and (|> (/.run (/.this yes) (list yes)) - (case> (#error.Failure _) + (case> (#try.Failure _) #0 - (#error.Success _) + (#try.Success _) #1)) (|> (/.run (/.this yes) (list no)) - (case> (#error.Failure _) + (case> (#try.Failure _) #1 - (#error.Success _) + (#try.Success _) #0)))) (_.test "Can use custom token parsers." (|> (/.run (/.parse nat@decode) (list yes)) - (case> (#error.Failure _) + (case> (#try.Failure _) #0 - (#error.Success parsed) + (#try.Success parsed) (text@= (nat@encode parsed) yes)))) (_.test "Can query if there are any more inputs." (and (|> (/.run /.end (list)) - (case> (#error.Success []) #1 _ #0)) + (case> (#try.Success []) #1 _ #0)) (|> (/.run (p.not /.end) (list yes)) - (case> (#error.Success []) #0 _ #1)))) + (case> (#try.Success []) #0 _ #1)))) (_.test "Can parse CLI input anywhere." (|> (/.run (|> (/.somewhere (/.this yes)) (p.before (p.some /.any))) (list.concat (list pre-ignore (list yes) post-ignore))) - (case> (#error.Failure _) + (case> (#try.Failure _) #0 - (#error.Success _) + (#try.Success _) #1))) )))) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index b263a20b6..8917e63fa 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -6,9 +6,9 @@ [abstract/monad (#+ do)] [control pipe + ["." try (#+ Try)] ["p" parser]] [data - ["." error (#+ Error)] ["." text ("#@." equivalence)] [collection ["." list]]] @@ -18,19 +18,19 @@ ["." /]}) (def: (should-fail input) - (All [a] (-> (Error a) Bit)) + (All [a] (-> (Try a) Bit)) (case input - (#error.Failure _) + (#try.Failure _) true _ false)) (def: (should-pass reference sample) - (-> Text (Error Text) Bit) + (-> Text (Try Text) Bit) (|> sample - (:: error.functor map (text@= reference)) - (error.default false))) + (:: try.functor map (text@= reference)) + (try.default false))) (def: #export test Test diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index 25ea20ab3..9ecf520c2 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -3,8 +3,9 @@ ["_" test (#+ Test)] [abstract ["." monad (#+ do)]] + [control + ["." try (#+ Try)]] [data - ["." error (#+ Error)] [text ["%" format (#+ format)]] [collection @@ -21,16 +22,16 @@ (template [ ] [(def: ( result) - (All [a] (-> (Error a) Bit)) + (All [a] (-> (Try a) Bit)) (case result - (#error.Success _) + (#try.Success _) - (#error.Failure _) + (#try.Failure _) ))] [success? #1 #0] - [error? #0 #1] + [failure? #0 #1] ) (def: #export test @@ -47,7 +48,7 @@ count-clean-up (function (_ value) (do @ [_ (thread.update inc clean-up-counter)] - (wrap (#error.Success []))))] + (wrap (#try.Success []))))] outcome (/.run @ (do (/.monad @) [_ (monad.map @ (/.acquire @@ count-clean-up) @@ -65,7 +66,7 @@ count-clean-up (function (_ value) (do @ [_ (thread.update inc clean-up-counter)] - (wrap (#error.Success []))))] + (wrap (#try.Success []))))] outcome (/.run @ (do (/.monad @) [_ (monad.map @ (/.acquire @@ count-clean-up) @@ -73,7 +74,7 @@ _ (/.throw @@ oops [])] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (error? outcome) + (wrap (and (failure? outcome) (n/= expected-clean-ups actual-clean-ups)))))) (_.test "Errors can propagate from the cleaners." @@ -84,7 +85,7 @@ count-clean-up (function (_ value) (do @ [_ (thread.update inc clean-up-counter)] - (wrap (: (Error Any) (ex.throw oops [])))))] + (wrap (: (Try Any) (ex.throw oops [])))))] outcome (/.run @ (do (/.monad @) [_ (monad.map @ (/.acquire @@ count-clean-up) @@ -92,7 +93,7 @@ (wrap []))) actual-clean-ups (thread.read clean-up-counter)] (wrap (and (or (n/= 0 expected-clean-ups) - (error? outcome)) + (failure? outcome)) (n/= expected-clean-ups actual-clean-ups)))))) (_.test "Can lift operations." diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux new file mode 100644 index 000000000..40015c5df --- /dev/null +++ b/stdlib/source/test/lux/control/try.lux @@ -0,0 +1,64 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do Monad)] + {[0 #test] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad] + ["$." equivalence]]}] + [control + pipe + ["." io]] + [data + ["%" text/format (#+ format)] + [number + ["." nat]]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Try)]}) + +(def: injection + (Injection Try) + (|>> #/.Success)) + +(def: comparison + (Comparison Try) + (function (_ ==) + (:: (/.equivalence ==) =))) + +(def: #export (try element) + (All [a] (-> (Random a) (Random (Try a)))) + ($_ r.or + (r.unicode 1) + element)) + +(def: #export test + Test + (<| (_.context (%.name (name-of /._))) + ($_ _.and + ($equivalence.spec (/.equivalence nat.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) + + _ + false))))) + ))) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 65d43e5e6..4b0f02903 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -5,7 +5,6 @@ ["#." binary] ["#." bit] ["#." color] - ["#." error] ["#." identity] ["#." lazy] ["#." maybe] @@ -57,7 +56,6 @@ /binary.test /bit.test /color.test - /error.test /identity.test /lazy.test /maybe.test diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 8fb17114e..4b1ff0c54 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -8,8 +8,9 @@ {[0 #test] [/ ["$." equivalence]]}] + [control + ["." try (#+ Try)]] [data - ["." error (#+ Error)] [number ["." i64] ["." nat]] @@ -19,12 +20,12 @@ ["." / (#+ Binary)]}) (def: (succeed result) - (-> (Error Bit) Bit) + (-> (Try Bit) Bit) (case result - (#error.Failure _) + (#try.Failure _) #0 - (#error.Success output) + (#try.Success output) output)) (def: #export (binary size) @@ -34,19 +35,19 @@ (if (n/< size idx) (do r.monad [byte r.nat] - (exec (error.assume (/.write/8 idx byte output)) + (exec (try.assume (/.write/8 idx byte output)) (recur (inc idx)))) (:: r.monad wrap output))))) (def: (bits-io bytes read write value) - (-> Nat (-> Nat Binary (Error Nat)) (-> Nat Nat Binary (Error Any)) Nat Bit) + (-> Nat (-> Nat Binary (Try Nat)) (-> Nat Nat Binary (Try Any)) Nat Bit) (let [binary (/.create bytes) cap (case bytes 8 (dec 0) _ (|> 1 (i64.left-shift (n/* 8 bytes)) dec)) capped-value (i64.and cap value)] (succeed - (do error.monad + (do try.monad [_ (write 0 value binary) output (read 0 binary)] (wrap (n/= capped-value output)))))) @@ -76,13 +77,13 @@ (bits-io 8 /.read/64 /.write/64 value)) (_.test "Can slice binaries." (let [slice-size (|> to (n/- from) inc) - random-slice (error.assume (/.slice from to random-binary)) + random-slice (try.assume (/.slice from to random-binary)) idxs (list.n/range 0 (dec slice-size)) reader (function (_ binary idx) (/.read/8 idx binary))] (and (n/= slice-size (/.size random-slice)) - (case [(monad.map error.monad (reader random-slice) idxs) - (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)] - [(#error.Success slice-vals) (#error.Success binary-vals)] + (case [(monad.map try.monad (reader random-slice) idxs) + (monad.map try.monad (|>> (n/+ from) (reader random-binary)) idxs)] + [(#try.Success slice-vals) (#try.Success binary-vals)] (:: (list.equivalence nat.equivalence) = slice-vals binary-vals) _ diff --git a/stdlib/source/test/lux/data/error.lux b/stdlib/source/test/lux/data/error.lux deleted file mode 100644 index 340b4b73b..000000000 --- a/stdlib/source/test/lux/data/error.lux +++ /dev/null @@ -1,64 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do Monad)] - {[0 #test] - [/ - ["$." functor (#+ Injection Comparison)] - ["$." apply] - ["$." monad] - ["$." equivalence]]}] - [control - pipe - ["." io]] - [data - ["%" text/format (#+ format)] - [number - ["." nat]]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Error)]}) - -(def: injection - (Injection Error) - (|>> #/.Success)) - -(def: comparison - (Comparison Error) - (function (_ ==) - (:: (/.equivalence ==) =))) - -(def: #export (error element) - (All [a] (-> (Random a) (Random (Error a)))) - ($_ r.or - (r.unicode 1) - element)) - -(def: #export test - Test - (<| (_.context (%.name (name-of /._))) - ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (..error 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 error 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) - - _ - false))))) - ))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 61cf67a6c..4ccd4e337 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -14,7 +14,6 @@ pipe ["p" parser]] [data - ["." error] ["." bit] ["." maybe] ["." text] diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 6ca73269a..a7236ede6 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -10,11 +10,11 @@ ["$." codec]]}] [control pipe + ["E" try] ["p" parser ["" xml]]] [data ["." name] - ["E" error] ["." maybe] ["." text ("#@." equivalence)] [collection diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 9b25ae6af..37df07567 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -14,7 +14,6 @@ ["$." monoid] ["$." codec]]}] [data - ["." error] [number ["." i64]]] [math diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 61e1df77a..7789cc9bf 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -5,12 +5,12 @@ [abstract/monad (#+ do)] [control pipe + ["." try] ["p" parser ["<.>" text (#+ Parser)] ["s" code]]] [data [number (#+ hex)] - ["." error] ["." text ("#@." equivalence)]] [math ["r" random]] @@ -23,7 +23,7 @@ (-> (Parser Text) Text Bit) (|> input (.run regex) - (case> (#error.Success parsed) + (case> (#try.Success parsed) (text@= parsed input) _ @@ -33,7 +33,7 @@ (-> Text (Parser Text) Text Bit) (|> input (.run regex) - (case> (#error.Success parsed) + (case> (#try.Success parsed) (text@= test parsed) _ @@ -43,7 +43,7 @@ (All [a] (-> (Parser a) Text Bit)) (|> input (.run regex) - (case> (#error.Failure _) + (case> (#try.Failure _) true _ @@ -53,10 +53,10 @@ (macro.with-gensyms [g!message g!_] (wrap (list (` (|> (~ input) (.run (~ regex)) - (case> (^ (#error.Success (~ pattern))) + (case> (^ (#try.Success (~ pattern))) true - (#error.Failure (~ g!message)) + (#try.Failure (~ g!message)) (exec (log! (format "{{{Failure}}} " (~ g!message))) false) diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 469c2c2f2..0921cce9e 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -16,7 +16,6 @@ ## TODO: Get rid of this import ASAP [json (#+)]]] [data - ["." error] ["." bit] ["." maybe] ["." text] diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index b09f45b1d..549967643 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -7,12 +7,12 @@ [abstract [equivalence (#+ Equivalence)]] [control + ["." try (#+ Try)] ["p" parser ["s" code (#+ Parser)]]] [data ["." bit] ["." name] - ["." error (#+ Error)] ["." text] [number ["." nat] @@ -52,7 +52,7 @@ #0)) (def: (fails? input) - (All [a] (-> (Error a) Bit)) + (All [a] (-> (Try a) Bit)) (case input (#.Left _) #1 diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index 45c1b4b65..a600acfab 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -4,10 +4,11 @@ ["_" test (#+ Test)] ["r" math/random] [abstract/monad (#+ do)] + [control + ["." try]] [data ["." product] - ["." bit ("#@." equivalence)] - ["." error]] + ["." bit ("#@." equivalence)]] ["." type ("#@." equivalence)]] {1 ["." /]}) @@ -63,11 +64,11 @@ (do r.monad [_normalM modulusR _alternativeM (|> modulusR (r.filter (|>> (i/= _normalM) not))) - #let [normalM (|> _normalM /.from-int error.assume) - alternativeM (|> _alternativeM /.from-int error.assume)] + #let [normalM (|> _normalM /.from-int try.assume) + alternativeM (|> _alternativeM /.from-int try.assume)] [_param param] (modR normalM) [_subject subject] (modR normalM) - #let [copyM (|> normalM /.to-int /.from-int error.assume)]] + #let [copyM (|> normalM /.to-int /.from-int try.assume)]] ($_ _.and (_.test "Every modulus has a unique type, even if the numeric value is the same as another." (and (type@= (:of normalM) @@ -110,26 +111,26 @@ (_.test "Can encode/decode to text." (let [(^open "mod/.") (/.codec normalM)] (case (|> subject mod/encode mod/decode) - (#error.Success output) + (#try.Success output) (/.m/= subject output) - (#error.Failure error) + (#try.Failure error) false))) (_.test "Can equalize 2 moduli if they are equal." (case (/.equalize (/.mod normalM _subject) (/.mod copyM _param)) - (#error.Success paramC) + (#try.Success paramC) (/.m/= param paramC) - (#error.Failure error) + (#try.Failure error) false)) (_.test "Cannot equalize 2 moduli if they are the different." (case (/.equalize (/.mod normalM _subject) (/.mod alternativeM _param)) - (#error.Success paramA) + (#try.Success paramA) false - (#error.Failure error) + (#try.Failure error) true)) (_.test "All numbers are congruent to themselves." (/.congruent? normalM _subject _subject)) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 873d32e09..f044b74d0 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -3,6 +3,7 @@ [abstract/monad (#+ do)] [control ["." io (#+ IO)] + ["." try (#+ Try)] [parser ["<2>" binary]] [concurrency @@ -11,7 +12,6 @@ ["!" capability]]] [data [binary (#+ Binary)] - ["." error (#+ Error)] ["." text ["%" format (#+ format)]] [format @@ -26,6 +26,8 @@ ["_" test (#+ Test)]] {1 ["." / #_ + ["#." program] + ["#." loader (#+ Library)] ["#." version] ["#." descriptor (#+ Descriptor Value)] @@ -40,15 +42,15 @@ ## (-> Text Binary (IO Text)) ## (let [file-path (format name ".class")] ## (do io.monad -## [outcome (do (error.with @) -## [file (: (IO (Error (File IO))) +## [outcome (do (try.with @) +## [file (: (IO (Try (File IO))) ## (file.get-file io.monad file.system file-path))] ## (!.use (:: file over-write) bytecode))] ## (wrap (case outcome -## (#error.Success definition) +## (#try.Success definition) ## (format "Wrote: " (%.text file-path)) -## (#error.Failure error) +## (#try.Failure error) ## error))))) (def: descriptor @@ -102,17 +104,17 @@ ($_ _.and (_.test "Can read a generated class." (case (<2>.run /class.parser bytecode) - (#error.Success output) + (#try.Success output) (:: /class.equivalence = input output) - (#error.Failure error) + (#try.Failure _) false)) (_.test "Can generate a class." (case (/loader.define full-name bytecode loader) - (#error.Success definition) + (#try.Success definition) true - (#error.Failure error) + (#try.Failure _) false)) ))) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index 851267c59..8ec82dc70 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -10,8 +10,6 @@ ["$." order] ["$." monoid] ["$." codec]]}] - [data - ["E" error]] [math ["r" random (#+ Random)]]] {1 diff --git a/stdlib/source/test/lux/tool/compiler/default/syntax.lux b/stdlib/source/test/lux/tool/compiler/default/syntax.lux index a9744dfb6..1b9e5c7a4 100644 --- a/stdlib/source/test/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/default/syntax.lux @@ -7,10 +7,10 @@ ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] [control + ["." try] [parser ["l" text]]] [data - ["." error] ["." text] [collection ["." list] diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux index 08346c47b..7d5046571 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux @@ -7,9 +7,9 @@ ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] [control - pipe] + pipe + ["." try]] [data - ["." error] ["." maybe] ["." product] ["." text ("#@." equivalence)] @@ -36,11 +36,11 @@ (|> analysis (//type.with-type expectedT) (///.run _primitive.state) - (case> (#error.Success applyA) + (case> (#try.Success applyA) (let [[funcA argsA] (////analysis.application applyA)] (n/= num-args (list.size argsA))) - (#error.Failure error) + (#try.Failure _) false))) (def: abstraction diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux index 1a7aec26f..57c3152d9 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux @@ -9,9 +9,8 @@ ["_" test (#+ Test)] [control pipe + ["." try (#+ Try)] ["." exception (#+ exception:)]] - [data - ["." error (#+ Error)]] ["." type ("#@." equivalence)] [macro ["." code]]] @@ -32,12 +31,12 @@ (def: #export (expander macro inputs state) Expander - (#error.Failure "NOPE")) + (#try.Failure "NOPE")) (def: #export (eval count type expression) Eval (function (_ state) - (#error.Failure "NO!"))) + (#try.Failure "NO!"))) (def: #export phase ////analysis.Phase @@ -69,24 +68,24 @@ ["Inferred" (%.type inferred)])) (def: (infer expected-type analysis) - (-> Type (Operation Analysis) (Error Analysis)) + (-> Type (Operation Analysis) (Try Analysis)) (|> analysis //type.with-inference (///.run ..state) - (case> (#error.Success [inferred-type output]) + (case> (#try.Success [inferred-type output]) (if (is? expected-type inferred-type) - (#error.Success output) + (#try.Success output) (exception.throw wrong-inference [expected-type inferred-type])) - (#error.Failure error) - (#error.Failure error)))) + (#try.Failure error) + (#try.Failure error)))) (def: #export test (<| (_.context (name.module (name-of /._))) (`` ($_ _.and (_.test (%.name (name-of #////analysis.Unit)) (|> (infer Any (..phase (' []))) - (case> (^ (#error.Success (#////analysis.Primitive (#////analysis.Unit output)))) + (case> (^ (#try.Success (#////analysis.Primitive (#////analysis.Unit output)))) (is? [] output) _ @@ -96,7 +95,7 @@ [sample ] (_.test (%.name (name-of )) (|> (infer (..phase ( sample))) - (case> (#error.Success (#////analysis.Primitive ( output))) + (case> (#try.Success (#////analysis.Primitive ( output))) (is? sample output) _ diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux index 427e0dc2c..777fe152f 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux @@ -6,9 +6,9 @@ ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] [control - pipe] + pipe + ["." try (#+ Try)]] [data - ["." error (#+ Error)] ["." text ("#@." equivalence)]] ["." type ("#@." equivalence)] [macro @@ -26,15 +26,15 @@ ["#." reference] ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]}) -(type: Check (-> (Error Any) Bit)) +(type: Check (-> (Try Any) Bit)) (template [ ] [(def: Check - (|>> (case> (#error.Success _) + (|>> (case> (#try.Success _) - (#error.Failure error) + (#try.Failure _) )))] [success? true false] @@ -72,7 +72,7 @@ (//type.with-inference (_primitive.phase (code.local-identifier var-name))))) (///.run _primitive.state) - (case> (^ (#error.Success [inferredT (#////analysis.Reference (////reference.local var))])) + (case> (^ (#try.Success [inferredT (#////analysis.Reference (////reference.local var))])) (and (type@= expectedT inferredT) (n/= 0 var)) @@ -86,7 +86,7 @@ (_primitive.phase (code.identifier def-name)))) (//module.with-module 0 def-module) (///.run _primitive.state) - (case> (^ (#error.Success [_ inferredT (#////analysis.Reference (////reference.constant constant-name))])) + (case> (^ (#try.Success [_ inferredT (#////analysis.Reference (////reference.constant constant-name))])) (and (type@= expectedT inferredT) (name@= def-name constant-name)) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux index 156965a55..08344f23e 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux @@ -7,10 +7,10 @@ ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] [control - pipe] + pipe + ["." try]] [data ["." bit ("#@." equivalence)] - ["." error] ["." product] ["." maybe] ["." text] @@ -36,7 +36,7 @@ [(def: #export (All [a] (-> (Operation a) Bit)) (|>> (///.run _primitive.state) - (case> (#error.Success _) + (case> (#try.Success _) _ @@ -64,7 +64,7 @@ (|> analysis (//type.with-type type) (///.run _primitive.state) - (case> (^ (#error.Success (////analysis.variant variant))) + (case> (^ (#try.Success (////analysis.variant variant))) (check-sum' tag size variant) _ @@ -82,7 +82,7 @@ (with-tags module tags variantT) (//type.with-type expectedT) (///.run _primitive.state) - (case> (^ (#error.Success [_ (////analysis.variant variant)])) + (case> (^ (#try.Success [_ (////analysis.variant variant)])) (check-sum' tag (list.size tags) variant) _ @@ -104,7 +104,7 @@ (with-tags module tags recordT) (//type.with-type expectedT) (///.run _primitive.state) - (case> (#error.Success [_ productA]) + (case> (#try.Success [_ productA]) (correct-size? size productA) _ @@ -138,7 +138,7 @@ (//type.with-type varT (/.sum _primitive.phase choice valueC))) (///.run _primitive.state) - (case> (^ (#error.Success (////analysis.variant variant))) + (case> (^ (#try.Success (////analysis.variant variant))) (check-sum' choice size variant) _ @@ -180,7 +180,7 @@ (|> (//type.with-type tupleT (/.product _primitive.phase (list@map product.right primitives))) (///.run _primitive.state) - (case> (#error.Success tupleA) + (case> (#try.Success tupleA) (correct-size? size tupleA) _ @@ -189,7 +189,7 @@ (|> (//type.with-inference (/.product _primitive.phase (list@map product.right primitives))) (///.run _primitive.state) - (case> (#error.Success [_type tupleA]) + (case> (#try.Success [_type tupleA]) (and (check.checks? tupleT _type) (correct-size? size tupleA)) @@ -207,7 +207,7 @@ (//type.with-type varT (/.product _primitive.phase (list@map product.right primitives)))) (///.run _primitive.state) - (case> (#error.Success tupleA) + (case> (#try.Success tupleA) (correct-size? size tupleA) _ diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux index 1b89d30d4..c659d9db0 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux @@ -9,10 +9,10 @@ [control pipe [io (#+ IO)] + ["." try] [concurrency ["." atom]]] [data - ["." error] ["." product]] ["." type ("#@." equivalence)] [macro @@ -34,10 +34,10 @@ (////type.with-type output-type (_primitive.phase (` ((~ (code.text procedure)) (~+ params)))))) (////.run _primitive.state) - (case> (#error.Success _) + (case> (#try.Success _) - (#error.Failure error) + (#try.Failure _) )))] [check-success+ true false] diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux index b5a03fd9f..d2d310fa1 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux @@ -6,9 +6,8 @@ ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] [control - pipe] - [data - ["." error ("#@." functor)]]] + pipe + ["." try ("#@." functor)]]] ["." // #_ ["#." primitive]] {1 @@ -36,8 +35,8 @@ (|> maskA //.phase (///.run [///bundle.empty ////synthesis.init]) - (error@map (//primitive.corresponds? maskedA)) - (error.default false))))) + (try@map (//primitive.corresponds? maskedA)) + (try.default false))))) (def: let-expr Test @@ -54,7 +53,7 @@ (|> letA //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (^ (#error.Success (////synthesis.branch/let [inputS registerS outputS]))) + (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS]))) (and (n/= registerA registerS) (//primitive.corresponds? inputA inputS) (//primitive.corresponds? outputA outputS)) @@ -82,7 +81,7 @@ (|> ifA //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (^ (#error.Success (////synthesis.branch/if [inputS thenS elseS]))) + (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS]))) (and (//primitive.corresponds? inputA inputS) (//primitive.corresponds? thenA thenS) (//primitive.corresponds? elseA elseS)) diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux index 3ca60e77b..368b692e9 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux @@ -6,11 +6,11 @@ ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] [control - pipe] + pipe + ["." try]] [data ["." product] ["." maybe] - ["." error] [number ["." nat]] [collection @@ -118,7 +118,7 @@ (|> function//constant //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (^ (#error.Success (////synthesis.function/abstraction [environment arity output]))) + (case> (^ (#try.Success (////synthesis.function/abstraction [environment arity output]))) (and (n/= arity//constant arity) (//primitive.corresponds? prediction//constant output)) @@ -128,7 +128,7 @@ (|> function//environment //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (^ (#error.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))]))) + (case> (^ (#try.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))]))) (and (n/= arity//environment arity) (variable@= prediction//environment output)) @@ -138,7 +138,7 @@ (|> function//local //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (^ (#error.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))]))) + (case> (^ (#try.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))]))) (and (n/= arity//local arity) (variable@= prediction//local output)) @@ -157,7 +157,7 @@ (|> (////analysis.apply [funcA argsA]) //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (^ (#error.Success (////synthesis.function/apply [funcS argsS]))) + (case> (^ (#try.Success (////synthesis.function/apply [funcS argsS]))) (and (//primitive.corresponds? funcA funcS) (list.every? (product.uncurry //primitive.corresponds?) (list.zip2 argsA argsS))) @@ -168,7 +168,7 @@ (|> (////analysis.apply [funcA (list)]) //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (#error.Success funcS) + (case> (#try.Success funcS) (//primitive.corresponds? funcA funcS) _ diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux index f54ace3d5..d9d24ea21 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux @@ -7,9 +7,8 @@ ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] [control - pipe] - [data - ["." error]]] + pipe + ["." try]]] {1 ["." / #_ ["/#" // @@ -66,7 +65,7 @@ (|> (#////analysis.Primitive ( expected)) //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (#error.Success (#////synthesis.Primitive ( actual))) + (case> (#try.Success (#////synthesis.Primitive ( actual))) (is? expected actual) _ diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux index 0ea42a2a9..76405c771 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux @@ -7,11 +7,11 @@ ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] [control - pipe] + pipe + ["." try]] [data ["." bit ("#@." equivalence)] ["." product] - ["." error] [collection ["." list]]]] ["." // #_ @@ -40,7 +40,7 @@ (|> (////analysis.variant [lefts right? memberA]) //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (^ (#error.Success (////synthesis.variant [leftsS right?S valueS]))) + (case> (^ (#try.Success (////synthesis.variant [leftsS right?S valueS]))) (let [tagS (if right?S (inc leftsS) leftsS)] (and (n/= tagA tagS) (|> tagS (n/= (dec size)) (bit@= right?S)) @@ -58,7 +58,7 @@ (|> (////analysis.tuple membersA) //.phase (///.run [///bundle.empty ////synthesis.init]) - (case> (^ (#error.Success (////synthesis.tuple membersS))) + (case> (^ (#try.Success (////synthesis.tuple membersS))) (and (n/= size (list.size membersS)) (list.every? (product.uncurry //primitive.corresponds?) (list.zip2 membersA membersS))) diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index 5baccd9dc..b84a6f0a3 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -4,8 +4,8 @@ [abstract/monad (#+ do)] ["r" math/random (#+ Random)] ["_" test (#+ Test)] - [data - ["." error]]] + [control + ["." try]]] {1 ["." / (#+ Dynamic :dynamic :check)]}) @@ -18,15 +18,15 @@ ($_ _.and (_.test "Can check dynamic values." (case (:check Nat value) - (#error.Success actual) + (#try.Success actual) (n/= expected actual) - (#error.Failure error) + (#try.Failure _) false)) (_.test "Cannot confuse types." (case (:check Text value) - (#error.Success actual) + (#try.Success actual) false - (#error.Failure error) + (#try.Failure _) true)))))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 451f4671b..808a09e0e 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -6,13 +6,13 @@ [abstract/monad (#+ do)] [control ["." io (#+ IO)] + ["." try (#+ Try)] [concurrency ["." promise]] [security ["!" capability]]] [data ["." binary (#+ Binary)] - ["." error (#+ Error)] ["." text] [number ["." int]] @@ -36,9 +36,9 @@ (r@wrap (do promise.monad [#let [path (format "temp_file_" (%.nat number))] result (promise.future - (do (error.with io.monad) - [#let [check-existence! (: (IO (Error Bit)) - (error.lift io.monad (/.exists? io.monad /.system path)))] + (do (try.with io.monad) + [#let [check-existence! (: (IO (Try Bit)) + (try.lift io.monad (/.exists? io.monad /.system path)))] pre! check-existence! file (!.use (:: /.system create-file) path) post! check-existence! @@ -48,21 +48,21 @@ post! (not remains?)))))] (_.assert "Can create/delete files." - (error.default #0 result))))) + (try.default #0 result))))) (def: (read-and-write number data) (-> Nat Binary Test) (r@wrap (do promise.monad [#let [path (format "temp_file_" (%.nat number))] result (promise.future - (do (error.with io.monad) + (do (try.with io.monad) [file (!.use (:: /.system create-file) path) _ (!.use (:: file over-write) data) content (!.use (:: file content) []) _ (!.use (:: file delete) [])] (wrap (:: binary.equivalence = data content))))] (_.assert "Can write/read files." - (error.default #0 result))))) + (try.default #0 result))))) (def: #export test Test @@ -81,18 +81,18 @@ (wrap (do promise.monad [#let [path "temp_file_2"] result (promise.future - (do (error.with io.monad) + (do (try.with io.monad) [file (!.use (:: /.system create-file) path) _ (!.use (:: file over-write) dataL) read-size (!.use (:: file size) []) _ (!.use (:: file delete) [])] (wrap (n/= file-size read-size))))] (_.assert "Can read file size." - (error.default #0 result)))) + (try.default #0 result)))) (wrap (do promise.monad [#let [path "temp_file_3"] result (promise.future - (do (error.with io.monad) + (do (try.with io.monad) [file (!.use (:: /.system create-file) path) _ (!.use (:: file over-write) dataL) _ (!.use (:: file append) dataR) @@ -102,18 +102,18 @@ (wrap (and (n/= (n/* 2 file-size) read-size) (:: binary.equivalence = dataL - (error.assume (binary.slice 0 (dec file-size) content))) + (try.assume (binary.slice 0 (dec file-size) content))) (:: binary.equivalence = dataR - (error.assume (binary.slice file-size (dec read-size) content)))))))] + (try.assume (binary.slice file-size (dec read-size) content)))))))] (_.assert "Can append to files." - (error.default #0 result)))) + (try.default #0 result)))) (wrap (do promise.monad [#let [path "temp_dir_4"] result (promise.future - (do (error.with io.monad) - [#let [check-existence! (: (IO (Error Bit)) - (error.lift io.monad (/.exists? io.monad /.system path)))] + (do (try.with io.monad) + [#let [check-existence! (: (IO (Try Bit)) + (try.lift io.monad (/.exists? io.monad /.system path)))] pre! check-existence! dir (!.use (:: /.system create-directory) path) post! check-existence! @@ -123,12 +123,12 @@ post! (not remains?)))))] (_.assert "Can create/delete directories." - (error.default #0 result)))) + (try.default #0 result)))) (wrap (do promise.monad [#let [file-path "temp_file_5" dir-path "temp_dir_5"] result (promise.future - (do (error.with io.monad) + (do (try.with io.monad) [dir (!.use (:: /.system create-directory) dir-path) file (!.use (:: /.system create-file) (format dir-path "/" file-path)) _ (!.use (:: file over-write) dataL) @@ -137,13 +137,13 @@ _ (!.use (:: dir discard) [])] (wrap (n/= file-size read-size))))] (_.assert "Can create files inside of directories." - (error.default #0 result)))) + (try.default #0 result)))) (wrap (do promise.monad [#let [file-path "temp_file_6" dir-path "temp_dir_6" inner-dir-path "inner_temp_dir_6"] result (promise.future - (do (error.with io.monad) + (do (try.with io.monad) [dir (!.use (:: /.system create-directory) dir-path) pre-files (!.use (:: dir files) []) pre-directories (!.use (:: dir directories) []) @@ -161,11 +161,11 @@ (and (n/= 1 (list.size post-files)) (n/= 1 (list.size post-directories)))))))] (_.assert "Can list files/directories inside a directory." - (error.default #0 result)))) + (try.default #0 result)))) (wrap (do promise.monad [#let [path "temp_file_7"] result (promise.future - (do (error.with io.monad) + (do (try.with io.monad) [file (!.use (:: /.system create-file) path) _ (!.use (:: file over-write) dataL) _ (!.use (:: file modify) new-modified) @@ -173,19 +173,19 @@ _ (!.use (:: file delete) [])] (wrap (:: instant.equivalence = new-modified old-modified))))] (_.assert "Can change the time of last modification." - (error.default #0 result)))) + (try.default #0 result)))) (wrap (do promise.monad [#let [path0 (format "temp_file_8+0") path1 (format "temp_file_8+1")] result (promise.future - (do (error.with io.monad) - [#let [check-existence! (: (-> Path (IO (Error Bit))) + (do (try.with io.monad) + [#let [check-existence! (: (-> Path (IO (Try Bit))) (|>> (/.exists? io.monad /.system) - (error.lift io.monad)))] + (try.lift io.monad)))] file0 (!.use (:: /.system create-file) path0) _ (!.use (:: file0 over-write) dataL) pre! (check-existence! path0) - file1 (: (IO (Error (File IO))) ## TODO: Remove : + file1 (: (IO (Try (File IO))) ## TODO: Remove : (!.use (:: file0 move) path1)) post! (check-existence! path0) confirmed? (check-existence! path1) @@ -194,5 +194,5 @@ (not post!) confirmed?))))] (_.assert "Can move a file from one path to another." - (error.default #0 result)))) + (try.default #0 result)))) )))) -- cgit v1.2.3