Move pandoc execution out of IO

This commit is contained in:
Niels G. W. Serup 2024-10-06 00:03:11 +02:00
parent eb7848064a
commit 9170a7f044
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
5 changed files with 14 additions and 11 deletions

View File

@ -242,6 +242,9 @@ toText a = runFunction ToText =<< toToken a
convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM' Image convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM' Image
convertImage a b = runFunction ConvertImage =<< toTupleToken a b 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 :: TokenableTo FilePath a => a -> DepGenM' [FilePath]
listDirectory a = runFunctionIO ListDirectory =<< toToken a listDirectory a = runFunctionIO ListDirectory =<< toToken a
@ -269,9 +272,6 @@ copyFile' = runFunctionIO' CopyFile
makeDir :: TokenableTo FilePath a => a -> DepGenM () makeDir :: TokenableTo FilePath a => a -> DepGenM ()
makeDir a = runFunctionIO' MakeDir =<< toToken a 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 :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM' Bool
hasExtension exts filename = do hasExtension exts filename = do

View File

@ -12,6 +12,9 @@ import qualified Codec.Picture as CP
import qualified Codec.Picture.STBIR as CPS import qualified Codec.Picture.STBIR as CPS
import Data.Char (toLower) import Data.Char (toLower)
import qualified Data.Text as T 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 :: Prelude.String -> (Prelude.String, Prelude.String)
fileComponents s = fileComponents s =
@ -70,5 +73,12 @@ evalFunction f x = case (f, x) of
heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor) heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
in makeImage $ CPS.resize CPS.defaultOptions widthResized heightResized image 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" error "unexpected combination of function and argument type"

View File

@ -7,10 +7,7 @@ import Prelude hiding (String, FilePath)
import Types.Values import Types.Values
import Types (FunctionIO(..), Value(..), toValue, makeImage) import Types (FunctionIO(..), Value(..), toValue, makeImage)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.IO as T 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 qualified Codec.Picture as CP
import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile) import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile)
@ -47,9 +44,5 @@ evalFunctionIO f x = case (f, x) of
createDirectory s createDirectory s
pure Empty 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) error ("unexpected combination of function and argument type; got function " ++ show f ++ " with argument " ++ show x)

View File

@ -16,5 +16,6 @@ data Function = AppendStrings
| ApplyTemplate | ApplyTemplate
| ToText | ToText
| ConvertImage | ConvertImage
| RunPandoc
deriving (Show, Lift) deriving (Show, Lift)

View File

@ -12,5 +12,4 @@ data FunctionIO = ListDirectory
| SaveTextFile | SaveTextFile
| CopyFile | CopyFile
| MakeDir | MakeDir
| RunPandoc
deriving (Show, Lift) deriving (Show, Lift)