From eae34707e977da68cf35d18d60428ef2ce893e25 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Fri, 11 Oct 2024 22:41:31 +0200
Subject: [PATCH] Start extracting titles from recipes

---
 byg/src/Functions/Pandoc.hs | 13 +++++++++++++
 byg/src/SiteGenerator.hs    | 24 ++++++++++++++----------
 2 files changed, 27 insertions(+), 10 deletions(-)

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 "<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")