From ae7126bc1901245040f06d2cc58f78e9c5eb0396 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Tue, 15 Oct 2024 23:32:15 +0200
Subject: [PATCH] Derive dates from directory name

---
 byg/byg.cabal               |  1 +
 byg/src/Functions.hs        |  2 ++
 byg/src/Functions/Pandoc.hs |  8 +++++++-
 byg/src/SiteGenerator.hs    | 36 +++++++++++++++++++++++-------------
 4 files changed, 33 insertions(+), 14 deletions(-)

diff --git a/byg/byg.cabal b/byg/byg.cabal
index 8dcb12a..feeab93 100644
--- a/byg/byg.cabal
+++ b/byg/byg.cabal
@@ -31,6 +31,7 @@ library
         Functions.Paths
         Functions.Template
         Functions.Text
+        Functions.Date
         Functions
         DependencyRunner
         SiteGenerator
diff --git a/byg/src/Functions.hs b/byg/src/Functions.hs
index c54e724..e34bd12 100644
--- a/byg/src/Functions.hs
+++ b/byg/src/Functions.hs
@@ -4,6 +4,7 @@ module Functions
   , module Functions.Paths
   , module Functions.Template
   , module Functions.Text
+  , module Functions.Date
   ) where
 
 import Functions.Image
@@ -11,3 +12,4 @@ import Functions.Pandoc
 import Functions.Paths
 import Functions.Template
 import Functions.Text
+import Functions.Date
diff --git a/byg/src/Functions/Pandoc.hs b/byg/src/Functions/Pandoc.hs
index a1a4485..c13eb51 100644
--- a/byg/src/Functions/Pandoc.hs
+++ b/byg/src/Functions/Pandoc.hs
@@ -3,10 +3,11 @@ module Functions.Pandoc
   , writeHtml
   , markdownToHtml
   , extractTitle
+  , injectAfterTitle
   ) where
 
 import Types (Token)
-import DependencyGenerator (DepGenM, TokenableTo(..), onToken)
+import DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken)
 
 import Data.Text (Text)
 import Control.Monad ((>=>))
@@ -34,3 +35,8 @@ extractTitle :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
 extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of
   (PD.Header 1 _ inlines : _) -> PS.stringify inlines
   _ -> error "unexpected"
+
+injectAfterTitle :: (TokenableTo Text a, TokenableTo Pandoc b) => a -> b -> DepGenM (Token Pandoc)
+injectAfterTitle = onTupleToken $ \extra (PD.Pandoc meta blocks) -> case blocks of
+  (header@(PD.Header _ _ _) : rest) -> PD.Pandoc meta (header : PD.Para [PD.Emph [PD.Str extra]] : rest)
+  _ -> error "unexpected"
diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs
index 236e0d7..cf3fca2 100644
--- a/byg/src/SiteGenerator.hs
+++ b/byg/src/SiteGenerator.hs
@@ -4,27 +4,32 @@ import Types (Token(..))
 import DependencyGenerator
 import Functions
 
+import Data.Ord (comparing)
+import Data.List (sortBy)
 import Data.Function ((&))
 import Data.Text (Text)
 import qualified Data.Text as T
-import Control.Monad (forM_)
+import Control.Monad (forM_, (<=<))
 
-handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM (Token (Text, FilePath))
-handleRecipeDir outputDir htmlTemplate indexName dir = do
+handleRecipeDir :: Token FilePath -> Token FilePath
+                -> Token Template -> Token FilePath
+                -> Token FilePath -> DepGenM (Token ((Text, Date), FilePath))
+handleRecipeDir recipesDir outputDir htmlTemplate indexName name = do
+  dir <- joinPaths recipesDir name
   recipeDirOut <- joinPaths outputDir dir
   makeDir recipeDirOut
   imageFilenames <-
     listDirectory dir
     & filterDepGenM (hasExtension (inject ["jpg"]))
-  htmlBodyImages <- forDepGenM imageFilenames $ \name -> do
-    path <- joinPaths dir name
+  htmlBodyImages <- forDepGenM imageFilenames $ \filename -> do
+    path <- joinPaths dir filename
     path `copyTo` outputDir
-    (base, ext) <- untupleDepGenM $ fileComponents name
+    (base, ext) <- untupleDepGenM $ fileComponents filename
     thumbnailName <- onToken concat [ pure base, inject "-thumbnail.", pure ext ]
     imageResized <- convertImage (openImage path) (inject (ResizeToWidth 800))
     saveImage imageResized (joinPaths recipeDirOut thumbnailName)
     onToken T.concat [ inject "<p class=\"image\"><a href=\""
-                     , onToken T.pack name
+                     , onToken T.pack filename
                      , inject "\"><img src=\""
                      , onToken T.pack thumbnailName
                      , inject "\"></a></p>\n"
@@ -43,12 +48,17 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do
     & applyTemplate mdTemplate
     & readMarkdown
   title <- extractTitle pandoc
+  date <- extractDate name
+  pandoc' <- injectAfterTitle (onTupleToken T.append
+                               (inject "Offentliggjort ")
+                               (onToken formatDate date))
+             pandoc
   html <-
-    pandoc
+    pandoc'
     & writeHtml
     & applyTemplate htmlTemplate
   saveTextFile html (joinPaths recipeDirOut indexName)
-  pure $ TupleToken title dir
+  pure $ TupleToken (TupleToken title date) dir
 
 handleFontDir :: Token FilePath -> Token FilePath -> DepGenM ()
 handleFontDir outputDir dir = do
@@ -72,14 +82,14 @@ generateSite = do
   makeDir $ outputRecipesDir
   recipeSubDirs <-
     listDirectory recipesDir
-    & mapDepGenM (joinPaths recipesDir)
-    & filterDepGenM isDirectory
-  infos <- mapDepGenM (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs
+    & filterDepGenM (isDirectory <=< joinPaths recipesDir)
+  infos <- mapDepGenM (handleRecipeDir recipesDir outputDir htmlTemplate indexName) recipeSubDirs
   allRecipesHtml <-
     infos
     & onToken (T.append "# Alle retter\n\n"
                . T.intercalate "\n"
-               . map (\(t, u) -> T.concat ["- ", "[", t, "](/", T.pack u, ")"]))
+               . map (\((t, d), u) -> T.concat ["- ", "[", t, " *(", formatDateShort d, ")*](/", T.pack u, ")"])
+               . sortBy (flip (comparing (\((_, d), _) -> d))))
     & markdownToHtml
     & applyTemplate htmlTemplate
   saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)