From 9170a7f044ae045d1640ea37077118ccac0d92c2 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Sun, 6 Oct 2024 00:03:11 +0200
Subject: [PATCH] Move pandoc execution out of IO

---
 byg/src/DependencyGenerator.hs   |  6 +++---
 byg/src/Evaluation/Function.hs   | 10 ++++++++++
 byg/src/Evaluation/FunctionIO.hs |  7 -------
 byg/src/Types/Function.hs        |  1 +
 byg/src/Types/FunctionIO.hs      |  1 -
 5 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs
index cecbe17..9a1eb5d 100644
--- a/byg/src/DependencyGenerator.hs
+++ b/byg/src/DependencyGenerator.hs
@@ -242,6 +242,9 @@ toText a = runFunction ToText =<< toToken a
 convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM' Image
 convertImage a b = runFunction ConvertImage =<< toTupleToken a b
 
+runPandoc :: TokenableTo Text a => a -> DepGenM' Text
+runPandoc a = runFunction RunPandoc =<< toToken a
+
 listDirectory :: TokenableTo FilePath a => a -> DepGenM' [FilePath]
 listDirectory a = runFunctionIO ListDirectory =<< toToken a
 
@@ -269,9 +272,6 @@ copyFile' = runFunctionIO' CopyFile
 makeDir :: TokenableTo FilePath a => a -> DepGenM ()
 makeDir a = runFunctionIO' MakeDir =<< toToken a
 
-runPandoc :: TokenableTo Text a => a -> DepGenM' Text
-runPandoc a = runFunctionIO RunPandoc =<< toToken a
-
 
 hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM' Bool
 hasExtension exts filename = do
diff --git a/byg/src/Evaluation/Function.hs b/byg/src/Evaluation/Function.hs
index d56ed22..f8625b9 100644
--- a/byg/src/Evaluation/Function.hs
+++ b/byg/src/Evaluation/Function.hs
@@ -12,6 +12,9 @@ import qualified Codec.Picture as CP
 import qualified Codec.Picture.STBIR as CPS
 import Data.Char (toLower)
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Text.Pandoc as P
+import qualified Text.Blaze.Html.Renderer.Text as B
 
 fileComponents :: Prelude.String -> (Prelude.String, Prelude.String)
 fileComponents s =
@@ -70,5 +73,12 @@ evalFunction f x = case (f, x) of
         heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
     in makeImage $ CPS.resize CPS.defaultOptions widthResized heightResized image
 
+  (RunPandoc, Text 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 -> Text $ TL.toStrict $ B.renderHtml html
+
   _ ->
     error "unexpected combination of function and argument type"
diff --git a/byg/src/Evaluation/FunctionIO.hs b/byg/src/Evaluation/FunctionIO.hs
index 1b8e416..a9072df 100644
--- a/byg/src/Evaluation/FunctionIO.hs
+++ b/byg/src/Evaluation/FunctionIO.hs
@@ -7,10 +7,7 @@ import Prelude hiding (String, FilePath)
 import Types.Values
 import Types (FunctionIO(..), Value(..), toValue, makeImage)
 
-import qualified Data.Text.Lazy as TL
 import qualified Data.Text.IO as T
-import qualified Text.Pandoc as P
-import qualified Text.Blaze.Html.Renderer.Text as B
 import qualified Codec.Picture as CP
 import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile)
 
@@ -47,9 +44,5 @@ evalFunctionIO f x = case (f, x) of
     createDirectory s
     pure Empty
 
-  (RunPandoc, Text contents) -> do
-    html <- P.runIOorExplode (P.writeHtml5 P.def =<< P.readMarkdown (P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }) contents)
-    pure $ Text $ TL.toStrict $ B.renderHtml html
-
   _ ->
     error ("unexpected combination of function and argument type; got function " ++ show f ++ " with argument " ++ show x)
diff --git a/byg/src/Types/Function.hs b/byg/src/Types/Function.hs
index 8eb655a..7b0bc87 100644
--- a/byg/src/Types/Function.hs
+++ b/byg/src/Types/Function.hs
@@ -16,5 +16,6 @@ data Function = AppendStrings
               | ApplyTemplate
               | ToText
               | ConvertImage
+              | RunPandoc
   deriving (Show, Lift)
 
diff --git a/byg/src/Types/FunctionIO.hs b/byg/src/Types/FunctionIO.hs
index 2838fe9..bb76d48 100644
--- a/byg/src/Types/FunctionIO.hs
+++ b/byg/src/Types/FunctionIO.hs
@@ -12,5 +12,4 @@ data FunctionIO = ListDirectory
                 | SaveTextFile
                 | CopyFile
                 | MakeDir
-                | RunPandoc
   deriving (Show, Lift)