From ca1d4d3d4371c8175ea6addb1ca1b09c3b56a7bb Mon Sep 17 00:00:00 2001 From: Chris Wells Date: Sat, 25 Jan 2025 14:33:21 -0600 Subject: Adding templates and cleaning up --- src/Hakyll/Error.hs | 16 +++++++++++----- src/Hakyll/Parsec.hs | 27 +++++++++++++++++++++++++++ src/Hakyll/Parsec/Parsec.hs | 27 --------------------------- src/Hakyll/TeX/BibTeX.hs | 16 +++++++++------- src/Hakyll/TeX/HaTeX.hs | 3 ++- src/Hakyll/TeX/TikZ.hs | 25 ++++++++++++++++++++----- src/Hakyll/Util.hs | 19 +++++++++++++++++++ 7 files changed, 88 insertions(+), 45 deletions(-) create mode 100644 src/Hakyll/Parsec.hs delete mode 100644 src/Hakyll/Parsec/Parsec.hs create mode 100644 src/Hakyll/Util.hs (limited to 'src/Hakyll') diff --git a/src/Hakyll/Error.hs b/src/Hakyll/Error.hs index 35102d4..7495b4d 100644 --- a/src/Hakyll/Error.hs +++ b/src/Hakyll/Error.hs @@ -14,17 +14,17 @@ class ErrorConv c err where type CompilerError c = ErrorConv c [String] -instance ErrorCnv err err where +instance ErrorConv err err where toErr = id -instance Exception c => ErrorCnv c SomeException where +instance Exception c => ErrorConv c SomeException where toErr = SomeException --- instance Functor f => ErrorCnv c err => ErrorCnv (f c) (f err) where +-- instance Functor f => ErrorConv c err => ErrorConv (f c) (f err) where -- toErr = fmap toErr -instance (Applicative f, ErrorCnv c err) => ErrorCnv c (f err) where - toErr = pure . toErr +-- instance (Applicative f, ErrorConv c err) => ErrorConv c (f err) where +-- toErr = pure . toErr throwErr :: (MonadError err m, ErrorConv c err) => c -> m a throwErr = throwError . toErr @@ -38,6 +38,12 @@ squashErr = (>>= liftErr) instance ErrorConv Message String where toErr = messageString +instance ErrorConv String [String] where + toErr = pure + +instance ErrorConv Message [String] where + toErr = pure . messageString + instance ErrorConv ParseError [String] where toErr = fmap messageString . errorMessages diff --git a/src/Hakyll/Parsec.hs b/src/Hakyll/Parsec.hs new file mode 100644 index 0000000..edd7b18 --- /dev/null +++ b/src/Hakyll/Parsec.hs @@ -0,0 +1,27 @@ +module Hakyll.Parsec + ( compileParsec + , compileParsec_ + , parsecCompiler + , parsecCompiler_ + ) 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 () + +parsecCompiler :: (Stream s Identity t, StringConv LazyByteString s) => Parsec s u a -> u -> Compiler (Item a) +parsecCompiler p u = getResourceLBS >>= compileParsec p u . fmap toSL + +parsecCompiler_ :: (Stream s Identity t, StringConv LazyByteString s) => Parsec s () a -> Compiler (Item a) +parsecCompiler_ p = parsecCompiler p () diff --git a/src/Hakyll/Parsec/Parsec.hs b/src/Hakyll/Parsec/Parsec.hs deleted file mode 100644 index 123c5fd..0000000 --- a/src/Hakyll/Parsec/Parsec.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Hakyll.Parsec.Parsec - ( compileParsec - , compileParsec_ - , parsecCompiler - , parsecCompiler_ - ) 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 () - -parsecCompiler :: (Stream s Identity t, StringConv LazyByteString s) => Parsec s u a -> u -> Compiler (Item a) -parsecCompiler p u = getResourceLBS >>= compileParsec p u . fmap toSL - -parsecCompiler_ :: (Stream s Identity t, StringConv LazyByteString s) => Parsec s () a -> Compiler (Item a) -parsecCompiler_ p = parsecCompiler p () diff --git a/src/Hakyll/TeX/BibTeX.hs b/src/Hakyll/TeX/BibTeX.hs index 434ca54..ddf9166 100644 --- a/src/Hakyll/TeX/BibTeX.hs +++ b/src/Hakyll/TeX/BibTeX.hs @@ -2,6 +2,7 @@ module Hakyll.TeX.BibTeX ( bibtexCompiler , compileBibtex + , BibEntry , BibTeX ) where @@ -10,28 +11,29 @@ import Prolog import Data.List qualified as L import Hakyll import Text.BibTeX.Entry qualified as B -import Text.BibTeX.Format qualified as B +import Text.BibTeX.Format qualified as BF import Text.BibTeX.Parse qualified as B import Text.Parsec qualified as P -import Hakyll.Parsec.Parsec +import Hakyll.Parsec -type BibTeX = B.T +type BibEntry = B.T +type BibTeX = [BibEntry] deriving instance Generic B.T instance Binary B.T instance Writable B.T where - write p = write p . B.entry + write p = write p . fmap BF.entry instance Writable [B.T] where - write p = write p . fold . L.intersperse "\n" . fmap B.entry + write p = write p . fmap (fold . L.intersperse "\n" . fmap BF.entry) -compileBibtex :: (StringConv s String) => Item s -> Compiler (Item [B.T]) +compileBibtex :: (StringConv s String) => Item s -> Compiler (Item BibTeX) compileBibtex = compileParsec_ p . fmap toSL where p = B.skippingLeadingSpace $ B.file <* P.eof -bibtexCompiler :: Compiler (Item [B.T]) +bibtexCompiler :: Compiler (Item BibTeX) bibtexCompiler = getResourceBody >>= compileBibtex diff --git a/src/Hakyll/TeX/HaTeX.hs b/src/Hakyll/TeX/HaTeX.hs index c71ad09..790d57c 100644 --- a/src/Hakyll/TeX/HaTeX.hs +++ b/src/Hakyll/TeX/HaTeX.hs @@ -8,9 +8,10 @@ import Prolog import Hakyll import Hakyll.Error -- import Hakyll.Parsec.Parsec +import Text.LaTeX.Base import Text.LaTeX.Base.Parser -compileHatex :: (StringConv s Text, Traversable t, MonadError [String] m) => t s -> m (t LaTeX) +compileHatex :: (StringConv s StrictText, Traversable t, MonadError [String] m) => t s -> m (t LaTeX) compileHatex = traverse $ liftErr . parseLaTeX . toSL hatexCompiler :: Compiler (Item LaTeX) diff --git a/src/Hakyll/TeX/TikZ.hs b/src/Hakyll/TeX/TikZ.hs index 9df98fd..c9087e7 100644 --- a/src/Hakyll/TeX/TikZ.hs +++ b/src/Hakyll/TeX/TikZ.hs @@ -1,7 +1,12 @@ +{-# LANGUAGE TemplateHaskell #-} module Hakyll.TeX.TikZ ( TikzTemplate - , tikzfilter + , tikzFilter , tikzBlockFilter + -- * Using the default TikZ template + , tikzTemplate + , tikzFilter_ + , tikzBlockFilter_ ) where import Network.URI.Encode qualified as URI @@ -14,16 +19,26 @@ import Prolog import Hakyll.TeX.LaTeX (rubberPipe) -type TikzTemplate = Identifier +type TikzTemplate = Template tikzFilter :: TikzTemplate -> Pandoc -> Compiler Pandoc -tikzFilter = walkM tikzBlockFilter +tikzFilter = walkM . tikzBlockFilter -- | Requires `rubber` and `poppler_utils` tikzBlockFilter :: TikzTemplate -> Block -> Compiler Block tikzBlockFilter tmpl (CodeBlock info@(_, "tikzpicture":_, _) contents) = do let imageBlock fname = Para [ Image info [] (toSL fname, "") ] - makeItem (toSL contents) >>= loadAndApplyTemplate tmpl (bodyField "body") >>= + makeItem (toSL contents) >>= applyTemplate tmpl (bodyField "body") >>= traverse (convSL $ rubberPipe [ "--pdf" ] >=> unixFilterLBS "pdftocairo" [ "-svg", "-", "-" ]) >>= - \(Item _ b) -> imageBlock $ ("data:image/svg+sml;utf8," <>) $ URI.encode $ filter (/= '\n') b + \(Item _ b) -> pure $ imageBlock $ ("data:image/svg+sml;utf8," <>) $ URI.encode $ filter (/= '\n') b tikzBlockFilter _ x = pure x + + +tikzTemplate :: TikzTemplate +tikzTemplate = $(embedTemplate "templates/tikz.tex") + +tikzBlockFilter_ :: Block -> Compiler Block +tikzBlockFilter_ = tikzBlockFilter tikzTemplate + +tikzFilter_ :: Pandoc -> Compiler Pandoc +tikzFilter_ = tikzFilter tikzTemplate diff --git a/src/Hakyll/Util.hs b/src/Hakyll/Util.hs new file mode 100644 index 0000000..edbdb16 --- /dev/null +++ b/src/Hakyll/Util.hs @@ -0,0 +1,19 @@ +module Hakyll.Util + ( dropParentRoute + , modifyDirRoute + , modifyDirRoute_ + ) where + +import Prolog +import Hakyll +import System.FilePath + +-- | Drop some number of parent directories +dropParentRoute :: Int -> Routes +dropParentRoute n = modifyDirRoute_ $ drop n + +modifyDirRoute :: ([FilePath] -> FilePath) -> Routes +modifyDirRoute f = customRoute $ f . splitDirectories . toFilePath + +modifyDirRoute_ :: ([FilePath] -> [FilePath]) -> Routes +modifyDirRoute_ f = modifyDirRoute $ joinPath . f -- cgit v1.2.3