From 1a3ecbb58d85f70be0625777f9deb9a58907d2e2 Mon Sep 17 00:00:00 2001 From: Chris Wells Date: Sat, 11 Jan 2025 10:28:34 -0600 Subject: More basic modules for errors and parsers --- src/Hakyll/Error.hs | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100644 src/Hakyll/Error.hs (limited to 'src/Hakyll/Error.hs') 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 -- cgit v1.2.3