diff --git a/byg/src/Functions/Pandoc.hs b/byg/src/Functions/Pandoc.hs index 3c9f51c..0d121d3 100644 --- a/byg/src/Functions/Pandoc.hs +++ b/byg/src/Functions/Pandoc.hs @@ -1,6 +1,7 @@ module Functions.Pandoc ( readMarkdown , writeHtml + , extractTitle ) where import Types (IsFunction(..), Token) @@ -8,6 +9,8 @@ import DependencyGenerator (DepGenM, TokenableTo(..), runFunction) import Data.Text (Text) 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 @@ -33,3 +36,13 @@ instance IsFunction WriteHtml Pandoc Text where writeHtml :: TokenableTo Pandoc a => a -> DepGenM (Token Text) writeHtml a = runFunction WriteHtml =<< toToken a + + +data ExtractTitle = ExtractTitle deriving Show +instance IsFunction ExtractTitle Pandoc Text where + evalFunction ExtractTitle (PD.Pandoc _ blocks) = case blocks of + (PD.Header 1 _ inlines : _) -> PS.stringify inlines + _ -> error "unexpected" + +extractTitle :: TokenableTo Pandoc a => a -> DepGenM (Token Text) +extractTitle a = runFunction ExtractTitle =<< toToken a diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index 22a01e7..dec297e 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -4,9 +4,10 @@ import Types (Token) import DependencyGenerator import Functions +import Data.Text (Text) import Control.Monad (forM_) -handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM () +handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM (Token Text) handleRecipeDir outputDir htmlTemplate indexName dir = do recipeDirOut <- joinPaths outputDir dir makeDir recipeDirOut @@ -29,16 +30,18 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do mdTemplate <- makeTemplate (readTextFile (joinPaths dir (inject "ret.md"))) ingredienserHeadline + pandoc <- readMarkdown + $ applyTemplate mdTemplate + $ concatTexts [ inject "
Opskrift fortsætter efter billedet.
\n" + , concatTexts htmlBodyImages + , inject "\n" + , pure ingredienserHeadline + ] + title <- extractTitle pandoc html <- applyTemplate htmlTemplate - $ writeHtml - $ readMarkdown - $ applyTemplate mdTemplate - $ concatTexts [ inject "Opskrift fortsætter efter billedet.
\n" - , concatTexts htmlBodyImages - , inject "\n" - , pure ingredienserHeadline - ] + $ writeHtml pandoc saveTextFile html (joinPaths recipeDirOut indexName) + pure title handleFontDir :: Token FilePath -> Token FilePath -> DepGenM () handleFontDir outputDir dir = do @@ -61,7 +64,8 @@ generateSite = do recipeSubDirs <- filterDepGenM isDirectory $ mapDepGenM (joinPaths recipesDir) $ listDirectory recipesDir - mapDepGenM_ (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs + _titles <- mapDepGenM (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs + -- TODO: Use titles -- Handle about page outputAboutDir <- joinPaths outputDir (inject "om")