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 "

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