From 1a3ecbb58d85f70be0625777f9deb9a58907d2e2 Mon Sep 17 00:00:00 2001
From: Chris Wells <chris@mathematicaster.org>
Date: Sat, 11 Jan 2025 10:28:34 -0600
Subject: More basic modules for errors and parsers

---
 src/Hakyll/Error.hs         | 70 +++++++++++++++++++++++++++++++++++++++++++++
 src/Hakyll/Parsec/Parsec.hs | 20 +++++++++++++
 src/Hakyll/TeX/BibTeX.hs    |  5 ++--
 src/Hakyll/TeX/HaTeX.hs     |  6 ++--
 src/Hakyll/TeX/LaTeX.hs     |  6 ++--
 5 files changed, 100 insertions(+), 7 deletions(-)
 create mode 100644 src/Hakyll/Error.hs
 create mode 100644 src/Hakyll/Parsec/Parsec.hs

(limited to 'src/Hakyll')

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
diff --git a/src/Hakyll/Parsec/Parsec.hs b/src/Hakyll/Parsec/Parsec.hs
new file mode 100644
index 0000000..cac653c
--- /dev/null
+++ b/src/Hakyll/Parsec/Parsec.hs
@@ -0,0 +1,20 @@
+module Hakyll.Parsec.Parsec
+    ( compileParsec
+    , compileParsec_
+    , evalParsec
+    ) where
+
+import Prolog
+import Hakyll
+import Text.Parsec
+import Text.Parsec.Error
+import Hakyll.Error
+
+-- evalParsec :: (MonadError [String] m) => Either ParseError a -> m a
+-- evalParsec = either (throwError . fmap messageString . errorMessages) pure
+
+compileParsec :: (MonadError [String] m, Stream s Identity t) => Parsec s u a -> u -> Item s -> m (Item a)
+compileParsec p u itm@(Item i _) = traverse (liftErr . runParser p u (show i)) itm
+
+compileParsec_ :: (MonadError [String] m, Stream s Identity t) => Parsec s () a -> Item s -> m (Item a)
+compileParsec_ p = compileParsec p ()
diff --git a/src/Hakyll/TeX/BibTeX.hs b/src/Hakyll/TeX/BibTeX.hs
index b085dfa..434ca54 100644
--- a/src/Hakyll/TeX/BibTeX.hs
+++ b/src/Hakyll/TeX/BibTeX.hs
@@ -13,7 +13,8 @@ import Text.BibTeX.Entry qualified as B
 import Text.BibTeX.Format qualified as B
 import Text.BibTeX.Parse qualified as B
 import Text.Parsec qualified as P
-import Text.Parsec.Error qualified as P
+
+import Hakyll.Parsec.Parsec
 
 type BibTeX = B.T
 
@@ -28,7 +29,7 @@ instance Writable [B.T] where
 
 
 compileBibtex :: (StringConv s String) => Item s -> Compiler (Item [B.T])
-compileBibtex (Item i b) = either (throwError . fmap P.messageString . P.errorMessages) (pure . Item i) $ P.parse p (show i) (toSL b)
+compileBibtex = compileParsec_ p . fmap toSL
     where
         p = B.skippingLeadingSpace $ B.file <* P.eof
 
diff --git a/src/Hakyll/TeX/HaTeX.hs b/src/Hakyll/TeX/HaTeX.hs
index 9b83c62..c71ad09 100644
--- a/src/Hakyll/TeX/HaTeX.hs
+++ b/src/Hakyll/TeX/HaTeX.hs
@@ -6,10 +6,12 @@ module Hakyll.TeX.HaTeX
 import Prolog
 
 import Hakyll
+import Hakyll.Error
+-- import Hakyll.Parsec.Parsec
 import Text.LaTeX.Base.Parser
 
-compileHatex :: (StringConv s Text, Traversable t) => t s -> Compiler (t LaTeX)
-compileHatex = traverse $ either (throwError . fmap messageString . errorMessages) pure . parseLaTeX . toSL
+compileHatex :: (StringConv s Text, Traversable t, MonadError [String] m) => t s -> m (t LaTeX)
+compileHatex = traverse $ liftErr . parseLaTeX . toSL
 
 hatexCompiler :: Compiler (Item LaTeX)
 hatexCompiler = getResourceLBS >>= compileHatex
diff --git a/src/Hakyll/TeX/LaTeX.hs b/src/Hakyll/TeX/LaTeX.hs
index 8f6d5cc..66f3ba5 100644
--- a/src/Hakyll/TeX/LaTeX.hs
+++ b/src/Hakyll/TeX/LaTeX.hs
@@ -8,11 +8,11 @@ import Prolog
 
 import Hakyll
 
-rubberPipe :: [String] -> LazyByteString -> Compiler LazyByteString
-rubberPipe = unixFilterLBS "rubber-pipe"
+rubberPipe :: (StringConv s LazyByteString) => [String] -> s -> Compiler LazyByteString
+rubberPipe args = unixFilterLBS "rubber-pipe" args . toSL
 
 compileLatexPdf :: (StringConv s LazyByteString, Traversable t) => t s -> Compiler (t LazyByteString)
-compileLatexPdf = traverse $ rubberPipe [ "--pdf" ] . toSL
+compileLatexPdf = traverse $ rubberPipe [ "--pdf" ]
 
 latexPdfCompiler :: Compiler (Item LazyByteString)
 latexPdfCompiler = getResourceLBS >>= compileLatexPdf
-- 
cgit v1.2.3