Derive dates from directory name
This commit is contained in:
parent
9e6c793d54
commit
ae7126bc19
|
@ -31,6 +31,7 @@ library
|
|||
Functions.Paths
|
||||
Functions.Template
|
||||
Functions.Text
|
||||
Functions.Date
|
||||
Functions
|
||||
DependencyRunner
|
||||
SiteGenerator
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue