Derive dates from directory name
This commit is contained in:
parent
9e6c793d54
commit
ae7126bc19
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue