Generic type for MonadError constraints

Changelog: API: MonadError constraints use generic error type

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