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.Paths
Functions.Template Functions.Template
Functions.Text Functions.Text
Functions.Date
Functions Functions
DependencyRunner DependencyRunner
SiteGenerator SiteGenerator

View File

@ -4,6 +4,7 @@ module Functions
, module Functions.Paths , module Functions.Paths
, module Functions.Template , module Functions.Template
, module Functions.Text , module Functions.Text
, module Functions.Date
) where ) where
import Functions.Image import Functions.Image
@ -11,3 +12,4 @@ import Functions.Pandoc
import Functions.Paths import Functions.Paths
import Functions.Template import Functions.Template
import Functions.Text import Functions.Text
import Functions.Date

View File

@ -3,10 +3,11 @@ module Functions.Pandoc
, writeHtml , writeHtml
, markdownToHtml , markdownToHtml
, extractTitle , extractTitle
, injectAfterTitle
) where ) where
import Types (Token) import Types (Token)
import DependencyGenerator (DepGenM, TokenableTo(..), onToken) import DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken)
import Data.Text (Text) import Data.Text (Text)
import Control.Monad ((>=>)) import Control.Monad ((>=>))
@ -34,3 +35,8 @@ extractTitle :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of
(PD.Header 1 _ inlines : _) -> PS.stringify inlines (PD.Header 1 _ inlines : _) -> PS.stringify inlines
_ -> error "unexpected" _ -> 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 DependencyGenerator
import Functions import Functions
import Data.Ord (comparing)
import Data.List (sortBy)
import Data.Function ((&)) import Data.Function ((&))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T 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 :: Token FilePath -> Token FilePath
handleRecipeDir outputDir htmlTemplate indexName dir = do -> 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 recipeDirOut <- joinPaths outputDir dir
makeDir recipeDirOut makeDir recipeDirOut
imageFilenames <- imageFilenames <-
listDirectory dir listDirectory dir
& filterDepGenM (hasExtension (inject ["jpg"])) & filterDepGenM (hasExtension (inject ["jpg"]))
htmlBodyImages <- forDepGenM imageFilenames $ \name -> do htmlBodyImages <- forDepGenM imageFilenames $ \filename -> do
path <- joinPaths dir name path <- joinPaths dir filename
path `copyTo` outputDir path `copyTo` outputDir
(base, ext) <- untupleDepGenM $ fileComponents name (base, ext) <- untupleDepGenM $ fileComponents filename
thumbnailName <- onToken concat [ pure base, inject "-thumbnail.", pure ext ] thumbnailName <- onToken concat [ pure base, inject "-thumbnail.", pure ext ]
imageResized <- convertImage (openImage path) (inject (ResizeToWidth 800)) imageResized <- convertImage (openImage path) (inject (ResizeToWidth 800))
saveImage imageResized (joinPaths recipeDirOut thumbnailName) saveImage imageResized (joinPaths recipeDirOut thumbnailName)
onToken T.concat [ inject "<p class=\"image\"><a href=\"" onToken T.concat [ inject "<p class=\"image\"><a href=\""
, onToken T.pack name , onToken T.pack filename
, inject "\"><img src=\"" , inject "\"><img src=\""
, onToken T.pack thumbnailName , onToken T.pack thumbnailName
, inject "\"></a></p>\n" , inject "\"></a></p>\n"
@ -43,12 +48,17 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do
& applyTemplate mdTemplate & applyTemplate mdTemplate
& readMarkdown & readMarkdown
title <- extractTitle pandoc title <- extractTitle pandoc
html <- date <- extractDate name
pandoc' <- injectAfterTitle (onTupleToken T.append
(inject "Offentliggjort ")
(onToken formatDate date))
pandoc pandoc
html <-
pandoc'
& writeHtml & writeHtml
& applyTemplate htmlTemplate & applyTemplate htmlTemplate
saveTextFile html (joinPaths recipeDirOut indexName) saveTextFile html (joinPaths recipeDirOut indexName)
pure $ TupleToken title dir pure $ TupleToken (TupleToken title date) dir
handleFontDir :: Token FilePath -> Token FilePath -> DepGenM () handleFontDir :: Token FilePath -> Token FilePath -> DepGenM ()
handleFontDir outputDir dir = do handleFontDir outputDir dir = do
@ -72,14 +82,14 @@ generateSite = do
makeDir $ outputRecipesDir makeDir $ outputRecipesDir
recipeSubDirs <- recipeSubDirs <-
listDirectory recipesDir listDirectory recipesDir
& mapDepGenM (joinPaths recipesDir) & filterDepGenM (isDirectory <=< joinPaths recipesDir)
& filterDepGenM isDirectory infos <- mapDepGenM (handleRecipeDir recipesDir outputDir htmlTemplate indexName) recipeSubDirs
infos <- mapDepGenM (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs
allRecipesHtml <- allRecipesHtml <-
infos infos
& onToken (T.append "# Alle retter\n\n" & onToken (T.append "# Alle retter\n\n"
. T.intercalate "\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 & markdownToHtml
& applyTemplate htmlTemplate & applyTemplate htmlTemplate
saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName) saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)