Start extracting titles from recipes

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

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 "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
+                          , concatTexts htmlBodyImages
+                          , inject "\n"
+                          , pure ingredienserHeadline
+                          ]
+  title <- extractTitle pandoc
   html <- applyTemplate htmlTemplate
-          $ writeHtml
-          $ readMarkdown
-          $ applyTemplate mdTemplate
-          $ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\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")