From afec7f814f10c2f5bd5b3e00d6af6ecd2aae6031 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Fri, 11 Oct 2024 22:14:28 +0200
Subject: [PATCH] Split pandoc handling into reading and writing steps

---
 byg/byg.cabal               |  1 +
 byg/src/Functions/Pandoc.hs | 35 +++++++++++++++++++++++------------
 byg/src/SiteGenerator.hs    |  9 +++++++--
 3 files changed, 31 insertions(+), 14 deletions(-)

diff --git a/byg/byg.cabal b/byg/byg.cabal
index d82ef79..76b1637 100644
--- a/byg/byg.cabal
+++ b/byg/byg.cabal
@@ -43,6 +43,7 @@ library
       , text
       , directory
       , blaze-html
+      , pandoc-types
       , pandoc
       , JuicyPixels
       , JuicyPixels-stbir
diff --git a/byg/src/Functions/Pandoc.hs b/byg/src/Functions/Pandoc.hs
index ce70da5..3c9f51c 100644
--- a/byg/src/Functions/Pandoc.hs
+++ b/byg/src/Functions/Pandoc.hs
@@ -1,24 +1,35 @@
 module Functions.Pandoc
-  ( runPandoc
+  ( readMarkdown
+  , writeHtml
   ) where
 
 import Types (IsFunction(..), Token)
 import DependencyGenerator (DepGenM, TokenableTo(..), runFunction)
 
 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.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
-instance IsFunction RunPandoc Text Text where
-  evalFunction RunPandoc contents =
+data ReadMarkdown = ReadMarkdown deriving Show
+instance IsFunction ReadMarkdown Text Pandoc where
+  evalFunction ReadMarkdown 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)
-         Right html -> TL.toStrict $ B.renderHtml html
+    in runPandoc $ P.readMarkdown settings contents
 
-runPandoc :: TokenableTo Text a => a -> DepGenM (Token Text)
-runPandoc a = runFunction RunPandoc =<< toToken a
+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
diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs
index 92f7959..22a01e7 100644
--- a/byg/src/SiteGenerator.hs
+++ b/byg/src/SiteGenerator.hs
@@ -30,7 +30,8 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do
     (readTextFile (joinPaths dir (inject "ret.md")))
     ingredienserHeadline
   html <- applyTemplate htmlTemplate
-          $ runPandoc
+          $ writeHtml
+          $ readMarkdown
           $ applyTemplate mdTemplate
           $ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
                         , concatTexts htmlBodyImages
@@ -65,7 +66,11 @@ generateSite = do
   -- Handle about page
   outputAboutDir <- joinPaths outputDir (inject "om")
   makeDir outputAboutDir
-  aboutHtml <- applyTemplate htmlTemplate $ runPandoc $ readTextFile $ inject "om.md"
+  aboutHtml <- applyTemplate htmlTemplate
+               $ writeHtml
+               $ readMarkdown
+               $ readTextFile
+               $ inject "om.md"
   saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
 
   -- Handle style