diff options
Diffstat (limited to 'src/Erebos/Error.hs')
| -rw-r--r-- | src/Erebos/Error.hs | 14 |
1 files changed, 12 insertions, 2 deletions
diff --git a/src/Erebos/Error.hs b/src/Erebos/Error.hs index 3bb8736..da9db75 100644 --- a/src/Erebos/Error.hs +++ b/src/Erebos/Error.hs @@ -3,19 +3,24 @@ module Erebos.Error ( showErebosError, FromErebosError(..), + throwErebosError, throwOtherError, ) where import Control.Monad.Except +import {-# SOURCE #-} Erebos.Network.Protocol + data ErebosError = ManyErrors [ ErebosError ] | OtherError String + | UnhandledService ServiceID showErebosError :: ErebosError -> String showErebosError (ManyErrors errs) = unlines $ map showErebosError errs showErebosError (OtherError str) = str +showErebosError (UnhandledService svc) = "unhandled service ‘" ++ show svc ++ "’" instance Semigroup ErebosError where ManyErrors [] <> b = b @@ -23,7 +28,7 @@ instance Semigroup ErebosError where 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 ] + a <> b = ManyErrors [ a, b ] instance Monoid ErebosError where mempty = ManyErrors [] @@ -31,9 +36,14 @@ instance Monoid ErebosError where class FromErebosError e where fromErebosError :: ErebosError -> e + toErebosError :: e -> Maybe ErebosError instance FromErebosError ErebosError where fromErebosError = id + toErebosError = Just + +throwErebosError :: (MonadError e m, FromErebosError e) => ErebosError -> m a +throwErebosError = throwError . fromErebosError throwOtherError :: (MonadError e m, FromErebosError e) => String -> m a -throwOtherError = throwError . fromErebosError . OtherError +throwOtherError = throwErebosError . OtherError |