diff --git a/byg/src/Functions/Date.hs b/byg/src/Functions/Date.hs new file mode 100644 index 0000000..f3fc4a0 --- /dev/null +++ b/byg/src/Functions/Date.hs @@ -0,0 +1,62 @@ +module Functions.Date + ( Date + , extractDate + , formatDate + , formatDateShort + ) where + +import Types (Token) +import DependencyGenerator (DepGenM, TokenableTo(..), onToken) + +import Text.Printf (printf) +import qualified Data.Text as T +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NE +import Data.Text (Text) + +data Date = Date Int Int Int + deriving (Eq, Ord, Show) + +split :: Eq a => a -> [a] -> NonEmpty [a] +split sep = \case + [] -> + NE.singleton [] + (c : cs) -> + (if sep == c + then NE.cons [] + else \(h :| t) -> (c : h) :| t) + $ split sep cs + +extractDate :: TokenableTo String a => a -> DepGenM (Token Date) +extractDate = onToken $ \dirName -> case split '-' dirName of + year :| (month : day : _) -> + Date (read year) (read month) (read day) + _ -> + error "unexpected" + +formatDate :: Date -> Text +formatDate (Date year month day) = + T.concat [ "den " + , T.pack (show day) + , ". " + , months !! (month - 1) + , " " + , T.pack (show year) + ] + where months = [ "januar" + , "februar" + , "marts" + , "april" + , "maj" + , "juni" + , "juli" + , "august" + , "september" + , "oktober" + , "november" + , "december" + ] + +formatDateShort :: Date -> Text +formatDateShort (Date year month day) = + T.concat [ T.pack (show year), "-", T.pack (printf "%02d" month), "-", T.pack (printf "%02d" day) ] diff --git a/byg/src/Functions/Pandoc.hs b/byg/src/Functions/Pandoc.hs index c13eb51..928ec84 100644 --- a/byg/src/Functions/Pandoc.hs +++ b/byg/src/Functions/Pandoc.hs @@ -38,5 +38,5 @@ extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of 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) + (header@(PD.Header _ _ _) : rest) -> PD.Pandoc meta (header : PD.RawBlock "html" extra : rest) _ -> error "unexpected" diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index cf3fca2..464ad86 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -4,17 +4,22 @@ import Types (Token(..)) import DependencyGenerator import Functions -import Data.Ord (comparing) -import Data.List (sortBy) +import Data.List (sort, elemIndex) import Data.Function ((&)) import Data.Text (Text) import qualified Data.Text as T import Control.Monad (forM_, (<=<)) +elemIndex' :: (Show a, Eq a) => a -> [a] -> Int +elemIndex' x xs = case elemIndex x xs of + Just i -> i + Nothing -> error ("unexpected unknown directory index for " ++ show x ++ " in " ++ show xs) + handleRecipeDir :: Token FilePath -> Token FilePath -> Token Template -> Token FilePath - -> Token FilePath -> DepGenM (Token ((Text, Date), FilePath)) -handleRecipeDir recipesDir outputDir htmlTemplate indexName name = do + -> Token [FilePath] -> Token FilePath + -> DepGenM (Token ((Text, Date), FilePath)) +handleRecipeDir recipesDir outputDir htmlTemplate indexName recipeSubDirs name = do dir <- joinPaths recipesDir name recipeDirOut <- joinPaths outputDir dir makeDir recipeDirOut @@ -49,13 +54,35 @@ handleRecipeDir recipesDir outputDir htmlTemplate indexName name = do & readMarkdown title <- extractTitle pandoc date <- extractDate name - pandoc' <- injectAfterTitle (onTupleToken T.append - (inject "Offentliggjort ") - (onToken formatDate date)) + pandoc' <- injectAfterTitle ( + (onToken T.concat [ inject "

Offentliggjort " + , onToken formatDate date + , inject "

" + ])) pandoc + dirIndex <- onTupleToken elemIndex' name recipeSubDirs + prev <- onTupleToken ( + \ds i -> if i < length ds - 1 + then T.concat [ "Forrige" + ] + else "") + recipeSubDirs dirIndex + next <- onTupleToken ( + \ds i -> if i > 0 + then T.concat [ "Næste" + ] + else "") + recipeSubDirs dirIndex + prevnext <- onToken T.concat [ inject "

", pure prev, pure next, inject "

" ] html <- pandoc' & writeHtml + & onTupleToken T.append prevnext + & onTupleToken (flip T.append) prevnext & applyTemplate htmlTemplate saveTextFile html (joinPaths recipeDirOut indexName) pure $ TupleToken (TupleToken title date) dir @@ -82,14 +109,14 @@ generateSite = do makeDir $ outputRecipesDir recipeSubDirs <- listDirectory recipesDir + & onToken (reverse . sort) & filterDepGenM (isDirectory <=< joinPaths recipesDir) - infos <- mapDepGenM (handleRecipeDir recipesDir outputDir htmlTemplate indexName) recipeSubDirs + infos <- mapDepGenM (handleRecipeDir recipesDir outputDir htmlTemplate indexName recipeSubDirs) recipeSubDirs allRecipesHtml <- infos & onToken (T.append "# Alle retter\n\n" . T.intercalate "\n" - . map (\((t, d), u) -> T.concat ["- ", "[", t, " *(", formatDateShort d, ")*](/", T.pack u, ")"]) - . sortBy (flip (comparing (\((_, d), _) -> d)))) + . map (\((t, d), u) -> T.concat ["- ", "[", t, " *(", formatDateShort d, ")*](/", T.pack u, ")"])) & markdownToHtml & applyTemplate htmlTemplate saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName) diff --git a/style.css b/style.css index 5bb12e8..ee58bff 100644 --- a/style.css +++ b/style.css @@ -66,7 +66,7 @@ section { } article { - padding: 0 10px; + padding: 0 10px 50px 10px; } h1, h2, h3 { @@ -76,6 +76,7 @@ h1, h2, h3 { h1 { font-size: 2em; + clear: both; } h2 { @@ -98,6 +99,29 @@ p.imagetext { margin-bottom: 0.1em; } +p.prevnext { + margin: 0; + a { + display: inline-block; + } + a.prev { + float: left; + } + a.prev:before { + content: '↫ '; + } + a.next { + float: right; + } + a.next:after { + content: ' ↬'; + } +} + +p.date { + margin: 0; +} + p.image { margin: 0; img {