summaryrefslogtreecommitdiff
path: root/src/Erebos/Error.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Erebos/Error.hs')
-rw-r--r--src/Erebos/Error.hs39
1 files changed, 39 insertions, 0 deletions
diff --git a/src/Erebos/Error.hs b/src/Erebos/Error.hs
new file mode 100644
index 0000000..3bb8736
--- /dev/null
+++ b/src/Erebos/Error.hs
@@ -0,0 +1,39 @@
+module Erebos.Error (
+ ErebosError(..),
+ showErebosError,
+
+ FromErebosError(..),
+ throwOtherError,
+) where
+
+import Control.Monad.Except
+
+
+data ErebosError
+ = ManyErrors [ ErebosError ]
+ | OtherError String
+
+showErebosError :: ErebosError -> String
+showErebosError (ManyErrors errs) = unlines $ map showErebosError errs
+showErebosError (OtherError str) = str
+
+instance Semigroup ErebosError where
+ ManyErrors [] <> b = b
+ a <> ManyErrors [] = a
+ ManyErrors a <> ManyErrors b = ManyErrors (a ++ b)
+ ManyErrors a <> b = ManyErrors (a ++ [ b ])
+ a <> ManyErrors b = ManyErrors (a : b)
+ a@OtherError {} <> b@OtherError {} = ManyErrors [ a, b ]
+
+instance Monoid ErebosError where
+ mempty = ManyErrors []
+
+
+class FromErebosError e where
+ fromErebosError :: ErebosError -> e
+
+instance FromErebosError ErebosError where
+ fromErebosError = id
+
+throwOtherError :: (MonadError e m, FromErebosError e) => String -> m a
+throwOtherError = throwError . fromErebosError . OtherError