diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll/Error.hs | 70 | ||||
| -rw-r--r-- | src/Hakyll/Parsec/Parsec.hs | 20 | ||||
| -rw-r--r-- | src/Hakyll/TeX/BibTeX.hs | 5 | ||||
| -rw-r--r-- | src/Hakyll/TeX/HaTeX.hs | 6 | ||||
| -rw-r--r-- | src/Hakyll/TeX/LaTeX.hs | 6 | ||||
| -rw-r--r-- | src/Prolog.hs | 20 |
6 files changed, 120 insertions, 7 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 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 diff --git a/src/Prolog.hs b/src/Prolog.hs index 70545c9..a688063 100644 --- a/src/Prolog.hs +++ b/src/Prolog.hs @@ -36,18 +36,22 @@ module Prolog , toSL , convS , convSL + , renderTo + , fromStringlike -- * Utils , (<<$>>) , (<<<$>>>) , (<<&>>) , (-->) , (-/>) + , (>>=?) , foreach , liftMaybe , squashMaybe ) where import Control.Applicative +import Control.Comonad import Control.Monad import Control.Monad.Catch import Control.Monad.Except @@ -110,6 +114,12 @@ infixr 0 -/> (-/>) = (-->) . fmap not {-# INLINE (-/>) #-} +(>>=?) :: (Monad m, Monoid w) => m (Maybe a) -> (a -> m w) -> m w +infixl 1 >>=? +x >>=? f = x >>= maybe (pure mempty) f +{-# INLINE (>>=?) #-} + + liftMaybe :: Alternative m => Maybe a -> m a liftMaybe = maybe empty pure {-# INLINE liftMaybe #-} @@ -118,6 +128,13 @@ squashMaybe :: Alternative m => m (Maybe a) -> m a squashmaybe = (>>= liftMaybe) {-# INLINE squashMaybe #-} +renderTo :: (StringConv T.Text s, L.Render r) => r -> s +renderTo = toSL . L.render +{-# INLINE renderTo #-} + +fromStringlike :: (IsString s, StringConv t String) => t -> s +fromStringlike = fromString . toSL +{-# INLINE fromStringlike #-} -- Orphan instances @@ -134,6 +151,9 @@ instance H.Writable L.LaTeX where instance Contravariant H.Context where contramap f (H.Context c) = H.Context $ \x xs -> c x xs . fmap f +instance Comonad H.Item where + extract = H.itemBody + duplicate = join (<$) instance StringConv L.LaTeX T.Text where strConv _ = L.render |
