Derive dates from directory name

This commit is contained in:
Niels G. W. Serup 2024-10-15 23:32:15 +02:00
parent 9e6c793d54
commit ae7126bc19
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
4 changed files with 33 additions and 14 deletions

View File

@ -31,6 +31,7 @@ library
Functions.Paths
Functions.Template
Functions.Text
Functions.Date
Functions
DependencyRunner
SiteGenerator

View File

@ -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

View File

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

View File

@ -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
html <-
date <- extractDate name
pandoc' <- injectAfterTitle (onTupleToken T.append
(inject "Offentliggjort ")
(onToken formatDate date))
pandoc
html <-
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)