summaryrefslogtreecommitdiff
path: root/src/Hakyll/Error.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Error.hs')
-rw-r--r--src/Hakyll/Error.hs70
1 files changed, 70 insertions, 0 deletions
diff --git a/src/Hakyll/Error.hs b/src/Hakyll/Error.hs
new file mode 100644
index 0000000..3ca29d3
--- /dev/null
+++ b/src/Hakyll/Error.hs
@@ -0,0 +1,70 @@
+module Hakyll.Error
+ ( ErrorConv (..)
+ , throwErr
+ , CompilerError
+ ) where
+
+import Prolog
+import Text.Parsec.Error
+
+class ErrorConv c err where
+ toErr :: c -> err
+
+type CompilerError c = ErrorConv c [String]
+
+instance ErrorCnv err err where
+ toErr = id
+
+-- instance Functor f => ErrorCnv c err => ErrorCnv (f c) (f err) where
+-- toErr = fmap toErr
+
+instance Applicative f => ErrorCnv c err => ErrorCnv c (f err) where
+ toErr = pure . toErr
+
+throwErr :: (MonadError err m, ErrorConv c err) => c -> m a
+throwErr = throwError . toErr
+
+liftErr :: (MonadError err m, ErrorConv c err) => Either c a -> m a
+liftErr = either throwErr pure
+
+squashErr :: (MonadError err m, ErrorConv c err) => m (Either c a) -> m a
+squashErr = (>>= liftErr)
+
+instance ErrorConv Message String where
+ toErr = messageString
+
+instance ErrorConv ParseError [String] where
+ toErr = fmap messageString . errorMessages
+
+
+-- class CompilerError c where
+-- toCompilerError :: c -> [String]
+-- default toCompilerError :: Exception c => c -> [String]
+-- toCompilerError = pure . displayException
+
+-- toCompilerErrors :: [c] -> [String]
+-- toCompilerErrors = (>>= toCompilerError)
+
+-- instance CompilerError c => CompilerError [c] where
+-- toCompilerError = toCompilerErrors
+
+
+-- throwCompilerError :: (MonadError [String] m, CompilerError c) => c -> m a
+-- throwCompilerError = throwError . toCompilerError
+
+-- liftCompilerError :: (MonadError [String] m, CompilerError c) => Either c a -> m a
+-- liftCompilerError = either throwError pure
+
+-- squashCompilerError :: (MonadError [String] m, CompilerError c) => m (Either c a) -> m a
+-- squashCompilerError = (>>= liftCompilerError)
+
+-- instance CompilerError Char where
+-- toCompilerError = pure . pure
+-- toCompilerErrors = pure
+
+-- instance CompilerError Message where
+-- toCompilerError = pure . messageString
+-- toCompilerErrors = fmap messageString
+
+-- instance CompilerError ParseError where
+-- toCompilerError = toCompilerErrors . errorMessages