Add prev and next navigation

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

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"

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 "<p class=\"date\">Offentliggjort "
+                        , onToken formatDate date
+                        , inject "</p>"
+                        ]))
              pandoc
+  dirIndex <- onTupleToken elemIndex' name recipeSubDirs
+  prev <- onTupleToken (
+    \ds i -> if i < length ds - 1
+             then T.concat [ "<a class=\"prev\" href=\"/retter/"
+                           , T.pack (ds !! (i + 1))
+                           , "\">Forrige</a>"
+                           ]
+             else "")
+          recipeSubDirs dirIndex
+  next <- onTupleToken (
+    \ds i -> if i > 0
+             then T.concat [ "<a class=\"next\" href=\"/retter/"
+                           , T.pack (ds !! (i - 1))
+                           , "\">Næste</a>"
+                           ]
+             else "")
+          recipeSubDirs dirIndex
+  prevnext <- onToken T.concat [ inject "<p class=\"prevnext\">", pure prev, pure next, inject "</p>" ]
   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)

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 {