Split pandoc handling into reading and writing steps

This commit is contained in:
Niels G. W. Serup 2024-10-11 22:14:28 +02:00
parent f348bd1e82
commit afec7f814f
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
3 changed files with 31 additions and 14 deletions

View File

@ -43,6 +43,7 @@ library
, text , text
, directory , directory
, blaze-html , blaze-html
, pandoc-types
, pandoc , pandoc
, JuicyPixels , JuicyPixels
, JuicyPixels-stbir , JuicyPixels-stbir

View File

@ -1,24 +1,35 @@
module Functions.Pandoc module Functions.Pandoc
( runPandoc ( readMarkdown
, writeHtml
) where ) where
import Types (IsFunction(..), Token) import Types (IsFunction(..), Token)
import DependencyGenerator (DepGenM, TokenableTo(..), runFunction) import DependencyGenerator (DepGenM, TokenableTo(..), runFunction)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text.Lazy as TL import Text.Pandoc.Definition (Pandoc)
import qualified Text.Pandoc as P import qualified Text.Pandoc as P
import qualified Text.Blaze.Html.Renderer.Text as B
runPandoc :: P.PandocPure a -> a
data RunPandoc = RunPandoc deriving Show runPandoc m = case P.runPure m of
instance IsFunction RunPandoc Text Text where
evalFunction RunPandoc contents =
let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
m = P.writeHtml5 P.def =<< P.readMarkdown settings contents
in case P.runPure m of
Left e -> error ("unexpected pandoc error: " ++ show e) Left e -> error ("unexpected pandoc error: " ++ show e)
Right html -> TL.toStrict $ B.renderHtml html Right result -> result
runPandoc :: TokenableTo Text a => a -> DepGenM (Token Text) data ReadMarkdown = ReadMarkdown deriving Show
runPandoc a = runFunction RunPandoc =<< toToken a instance IsFunction ReadMarkdown Text Pandoc where
evalFunction ReadMarkdown contents =
let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
in runPandoc $ P.readMarkdown settings contents
readMarkdown :: TokenableTo Text a => a -> DepGenM (Token Pandoc)
readMarkdown a = runFunction ReadMarkdown =<< toToken a
data WriteHtml = WriteHtml deriving Show
instance IsFunction WriteHtml Pandoc Text where
evalFunction WriteHtml pandoc =
runPandoc
$ P.writeHtml5String P.def pandoc
writeHtml :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
writeHtml a = runFunction WriteHtml =<< toToken a

View File

@ -30,7 +30,8 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do
(readTextFile (joinPaths dir (inject "ret.md"))) (readTextFile (joinPaths dir (inject "ret.md")))
ingredienserHeadline ingredienserHeadline
html <- applyTemplate htmlTemplate html <- applyTemplate htmlTemplate
$ runPandoc $ writeHtml
$ readMarkdown
$ applyTemplate mdTemplate $ applyTemplate mdTemplate
$ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n" $ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
, concatTexts htmlBodyImages , concatTexts htmlBodyImages
@ -65,7 +66,11 @@ generateSite = do
-- Handle about page -- Handle about page
outputAboutDir <- joinPaths outputDir (inject "om") outputAboutDir <- joinPaths outputDir (inject "om")
makeDir outputAboutDir makeDir outputAboutDir
aboutHtml <- applyTemplate htmlTemplate $ runPandoc $ readTextFile $ inject "om.md" aboutHtml <- applyTemplate htmlTemplate
$ writeHtml
$ readMarkdown
$ readTextFile
$ inject "om.md"
saveTextFile aboutHtml (joinPaths outputAboutDir indexName) saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
-- Handle style -- Handle style