From c907d178d89dde5ad03b799b973b4ad0d360ffe3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 3 May 2017 19:53:08 -0400 Subject: - Moved lux/data/error/exception to lux/control/exception. --- stdlib/source/lux/control/exception.lux | 67 +++++++++++++++++++++++++++ stdlib/source/lux/data/error/exception.lux | 67 --------------------------- stdlib/test/test/lux/control/exception.lux | 47 +++++++++++++++++++ stdlib/test/test/lux/data/error/exception.lux | 47 ------------------- 4 files changed, 114 insertions(+), 114 deletions(-) create mode 100644 stdlib/source/lux/control/exception.lux delete mode 100644 stdlib/source/lux/data/error/exception.lux create mode 100644 stdlib/test/test/lux/control/exception.lux delete mode 100644 stdlib/test/test/lux/data/error/exception.lux diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux new file mode 100644 index 000000000..94cdf4dd5 --- /dev/null +++ b/stdlib/source/lux/control/exception.lux @@ -0,0 +1,67 @@ +(;module: {#;doc "Exception-handling functionality built on top of the Error type."} + lux + (lux (control monad) + (data [error #- fail] + [text]) + [macro] + (macro [ast] + ["s" syntax #+ syntax: Syntax] + (syntax [common])))) + +## [Types] +(type: #export Exception + {#;doc "An exception provides a way to decorate error messages."} + (-> Text Text)) + +## [Values] +(def: #hidden _Text/append_ + (-> Text Text Text) + (:: text;Monoid append)) + +(def: #export (catch exception then try) + {#;doc "If a particular exception is detected on a possibly-erroneous value, handle it. + + If no exception was detected, or a different one from the one being checked, then pass along the original value."} + (All [a] + (-> Exception (-> Text a) (Error a) + (Error a))) + (case try + (#;Right output) + (#;Right output) + + (#;Left error) + (if (text;starts-with? (exception "") error) + (#;Right (then error)) + (#;Left error)))) + +(def: #export (otherwise to-do try) + {#;doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} + (All [a] + (-> (-> Text a) (Error a) a)) + (case try + (#;Right output) + output + + (#;Left error) + (to-do error))) + +(def: #export (return value) + {#;doc "A way to lift normal values into the error-handling context."} + (All [a] (-> a (Error a))) + (#;Right value)) + +(def: #export (throw exception message) + {#;doc "Decorate an error message with an Exception and lift it into the error-handling context."} + (All [a] (-> Exception Text (Error a))) + (#;Left (exception message))) + +(syntax: #export (exception: [_ex-lev common;export-level] [name s;local-symbol]) + {#;doc (doc "Define a new exception type." + "It moslty just serves as a way to tag error messages for later catching." + (exception: #export Some-Exception))} + (do @ + [current-module macro;current-module-name + #let [g!message (ast;symbol ["" "message"])]] + (wrap (list (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~ g!message)) + Exception + ($_ _Text/append_ "[" (~ (ast;text current-module)) ";" (~ (ast;text name)) "]\t" (~ g!message)))))))) diff --git a/stdlib/source/lux/data/error/exception.lux b/stdlib/source/lux/data/error/exception.lux deleted file mode 100644 index 94cdf4dd5..000000000 --- a/stdlib/source/lux/data/error/exception.lux +++ /dev/null @@ -1,67 +0,0 @@ -(;module: {#;doc "Exception-handling functionality built on top of the Error type."} - lux - (lux (control monad) - (data [error #- fail] - [text]) - [macro] - (macro [ast] - ["s" syntax #+ syntax: Syntax] - (syntax [common])))) - -## [Types] -(type: #export Exception - {#;doc "An exception provides a way to decorate error messages."} - (-> Text Text)) - -## [Values] -(def: #hidden _Text/append_ - (-> Text Text Text) - (:: text;Monoid append)) - -(def: #export (catch exception then try) - {#;doc "If a particular exception is detected on a possibly-erroneous value, handle it. - - If no exception was detected, or a different one from the one being checked, then pass along the original value."} - (All [a] - (-> Exception (-> Text a) (Error a) - (Error a))) - (case try - (#;Right output) - (#;Right output) - - (#;Left error) - (if (text;starts-with? (exception "") error) - (#;Right (then error)) - (#;Left error)))) - -(def: #export (otherwise to-do try) - {#;doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} - (All [a] - (-> (-> Text a) (Error a) a)) - (case try - (#;Right output) - output - - (#;Left error) - (to-do error))) - -(def: #export (return value) - {#;doc "A way to lift normal values into the error-handling context."} - (All [a] (-> a (Error a))) - (#;Right value)) - -(def: #export (throw exception message) - {#;doc "Decorate an error message with an Exception and lift it into the error-handling context."} - (All [a] (-> Exception Text (Error a))) - (#;Left (exception message))) - -(syntax: #export (exception: [_ex-lev common;export-level] [name s;local-symbol]) - {#;doc (doc "Define a new exception type." - "It moslty just serves as a way to tag error messages for later catching." - (exception: #export Some-Exception))} - (do @ - [current-module macro;current-module-name - #let [g!message (ast;symbol ["" "message"])]] - (wrap (list (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~ g!message)) - Exception - ($_ _Text/append_ "[" (~ (ast;text current-module)) ";" (~ (ast;text name)) "]\t" (~ g!message)))))))) diff --git a/stdlib/test/test/lux/control/exception.lux b/stdlib/test/test/lux/control/exception.lux new file mode 100644 index 000000000..80267cedd --- /dev/null +++ b/stdlib/test/test/lux/control/exception.lux @@ -0,0 +1,47 @@ +(;module: + lux + (lux [io] + (control monad + ["&" exception #+ exception:]) + (data [error #- fail] + [text] + text/format + [number]) + ["R" math/random]) + lux/test) + +(exception: Some-Exception) + +(exception: Another-Exception) + +(exception: Unknown-Exception) + +(test: "Exceptions" + [should-throw? R;bool + which? R;bool + should-catch? R;bool + default-val R;nat + some-val R;nat + another-val R;nat + otherwise-val R;nat + #let [this-ex (if should-catch? + (if which? + Some-Exception + Another-Exception) + Unknown-Exception) + expected (if should-throw? + (if should-catch? + (if which? + some-val + another-val) + otherwise-val) + default-val) + actual (|> (: (Error Nat) + (if should-throw? + (&;throw this-ex "Uh-oh...") + (&;return default-val))) + (&;catch Some-Exception (function [ex] some-val)) + (&;catch Another-Exception (function [ex] another-val)) + (&;otherwise (function [ex] otherwise-val)))]] + (assert "Catch and otherwhise handlers can properly handle the flow of exception-handling." + (n.= expected actual))) diff --git a/stdlib/test/test/lux/data/error/exception.lux b/stdlib/test/test/lux/data/error/exception.lux deleted file mode 100644 index 2a297a587..000000000 --- a/stdlib/test/test/lux/data/error/exception.lux +++ /dev/null @@ -1,47 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [error #- fail] - (error ["&" exception #+ exception:]) - [text] - text/format - [number]) - ["R" math/random]) - lux/test) - -(exception: Some-Exception) - -(exception: Another-Exception) - -(exception: Unknown-Exception) - -(test: "Exceptions" - [should-throw? R;bool - which? R;bool - should-catch? R;bool - default-val R;nat - some-val R;nat - another-val R;nat - otherwise-val R;nat - #let [this-ex (if should-catch? - (if which? - Some-Exception - Another-Exception) - Unknown-Exception) - expected (if should-throw? - (if should-catch? - (if which? - some-val - another-val) - otherwise-val) - default-val) - actual (|> (: (Error Nat) - (if should-throw? - (&;throw this-ex "Uh-oh...") - (&;return default-val))) - (&;catch Some-Exception (function [ex] some-val)) - (&;catch Another-Exception (function [ex] another-val)) - (&;otherwise (function [ex] otherwise-val)))]] - (assert "Catch and otherwhise handlers can properly handle the flow of exception-handling." - (n.= expected actual))) -- cgit v1.2.3