mad/byg/src/Functions/Pandoc.hs

43 lines
1.5 KiB
Haskell

module Functions.Pandoc
( readMarkdown
, writeHtml
, markdownToHtml
, extractTitle
, injectAfterTitle
) where
import Types (Token)
import DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken)
import Data.Text (Text)
import Control.Monad ((>=>))
import Text.Pandoc.Definition (Pandoc)
import qualified Text.Pandoc.Definition as PD
import qualified Text.Pandoc.Shared as PS
import qualified Text.Pandoc as P
runPandoc :: P.PandocPure a -> a
runPandoc m = case P.runPure m of
Left e -> error ("unexpected pandoc error: " ++ show e)
Right result -> result
readMarkdown :: TokenableTo Text a => a -> DepGenM (Token Pandoc)
readMarkdown = onToken $ runPandoc . P.readMarkdown settings
where settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
writeHtml :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
writeHtml = onToken $ runPandoc . P.writeHtml5String P.def
markdownToHtml :: TokenableTo Text a => a -> DepGenM (Token Text)
markdownToHtml = readMarkdown >=> writeHtml
extractTitle :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of
(PD.Header 1 _ inlines : _) -> PS.stringify inlines
_ -> error "unexpected"
injectAfterTitle :: (TokenableTo Text a, TokenableTo Pandoc b) => a -> b -> DepGenM (Token Pandoc)
injectAfterTitle = onTupleToken $ \extra (PD.Pandoc meta blocks) -> case blocks of
(header@(PD.Header _ _ _) : rest) -> PD.Pandoc meta (header : PD.RawBlock "html" extra : rest)
_ -> error "unexpected"