Split pandoc handling into reading and writing steps
This commit is contained in:
		@@ -43,6 +43,7 @@ library
 | 
			
		||||
      , text
 | 
			
		||||
      , directory
 | 
			
		||||
      , blaze-html
 | 
			
		||||
      , pandoc-types
 | 
			
		||||
      , pandoc
 | 
			
		||||
      , JuicyPixels
 | 
			
		||||
      , JuicyPixels-stbir
 | 
			
		||||
 
 | 
			
		||||
@@ -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
 | 
			
		||||
 
 | 
			
		||||
@@ -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
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user