Split pandoc handling into reading and writing steps
This commit is contained in:
		@@ -43,6 +43,7 @@ library
 | 
				
			|||||||
      , text
 | 
					      , text
 | 
				
			||||||
      , directory
 | 
					      , directory
 | 
				
			||||||
      , blaze-html
 | 
					      , blaze-html
 | 
				
			||||||
 | 
					      , pandoc-types
 | 
				
			||||||
      , pandoc
 | 
					      , pandoc
 | 
				
			||||||
      , JuicyPixels
 | 
					      , JuicyPixels
 | 
				
			||||||
      , JuicyPixels-stbir
 | 
					      , JuicyPixels-stbir
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -1,24 +1,35 @@
 | 
				
			|||||||
module Functions.Pandoc
 | 
					module Functions.Pandoc
 | 
				
			||||||
  ( runPandoc
 | 
					  ( readMarkdown
 | 
				
			||||||
 | 
					  , writeHtml
 | 
				
			||||||
  ) where
 | 
					  ) where
 | 
				
			||||||
 | 
					
 | 
				
			||||||
import Types (IsFunction(..), Token)
 | 
					import Types (IsFunction(..), Token)
 | 
				
			||||||
import DependencyGenerator (DepGenM, TokenableTo(..), runFunction)
 | 
					import DependencyGenerator (DepGenM, TokenableTo(..), runFunction)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
import Data.Text (Text)
 | 
					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.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
 | 
					data ReadMarkdown = ReadMarkdown deriving Show
 | 
				
			||||||
instance IsFunction RunPandoc Text Text where
 | 
					instance IsFunction ReadMarkdown Text Pandoc where
 | 
				
			||||||
  evalFunction RunPandoc contents =
 | 
					  evalFunction ReadMarkdown contents =
 | 
				
			||||||
    let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
 | 
					    let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
 | 
				
			||||||
        m = P.writeHtml5 P.def =<< P.readMarkdown settings contents
 | 
					    in runPandoc $ 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
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
runPandoc :: TokenableTo Text a => a -> DepGenM (Token Text)
 | 
					readMarkdown :: TokenableTo Text a => a -> DepGenM (Token Pandoc)
 | 
				
			||||||
runPandoc a = runFunction RunPandoc =<< toToken a
 | 
					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")))
 | 
					    (readTextFile (joinPaths dir (inject "ret.md")))
 | 
				
			||||||
    ingredienserHeadline
 | 
					    ingredienserHeadline
 | 
				
			||||||
  html <- applyTemplate htmlTemplate
 | 
					  html <- applyTemplate htmlTemplate
 | 
				
			||||||
          $ runPandoc
 | 
					          $ writeHtml
 | 
				
			||||||
 | 
					          $ readMarkdown
 | 
				
			||||||
          $ applyTemplate mdTemplate
 | 
					          $ applyTemplate mdTemplate
 | 
				
			||||||
          $ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
 | 
					          $ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
 | 
				
			||||||
                        , concatTexts htmlBodyImages
 | 
					                        , concatTexts htmlBodyImages
 | 
				
			||||||
@@ -65,7 +66,11 @@ generateSite = do
 | 
				
			|||||||
  -- Handle about page
 | 
					  -- Handle about page
 | 
				
			||||||
  outputAboutDir <- joinPaths outputDir (inject "om")
 | 
					  outputAboutDir <- joinPaths outputDir (inject "om")
 | 
				
			||||||
  makeDir outputAboutDir
 | 
					  makeDir outputAboutDir
 | 
				
			||||||
  aboutHtml <- applyTemplate htmlTemplate $ runPandoc $ readTextFile $ inject "om.md"
 | 
					  aboutHtml <- applyTemplate htmlTemplate
 | 
				
			||||||
 | 
					               $ writeHtml
 | 
				
			||||||
 | 
					               $ readMarkdown
 | 
				
			||||||
 | 
					               $ readTextFile
 | 
				
			||||||
 | 
					               $ inject "om.md"
 | 
				
			||||||
  saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
 | 
					  saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  -- Handle style
 | 
					  -- Handle style
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user