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
runPandoc m = case P.runPure m of
Left e -> error ("unexpected pandoc error: " ++ show e)
Right result -> result
data RunPandoc = RunPandoc deriving Show data ReadMarkdown = ReadMarkdown deriving Show
instance IsFunction RunPandoc Text Text where instance IsFunction ReadMarkdown Text Pandoc where
evalFunction RunPandoc contents = evalFunction ReadMarkdown contents =
let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] } let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
m = P.writeHtml5 P.def =<< P.readMarkdown settings contents in runPandoc $ P.readMarkdown settings contents
in case P.runPure m of
Left e -> error ("unexpected pandoc error: " ++ show e)
Right html -> TL.toStrict $ B.renderHtml html
runPandoc :: TokenableTo Text a => a -> DepGenM (Token Text) readMarkdown :: TokenableTo Text a => a -> DepGenM (Token Pandoc)
runPandoc a = runFunction RunPandoc =<< toToken a 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