From 2b3e4156bb8940239e6560bddb6bcd6e2fb2588b Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Sat, 2 Jun 2012 08:47:36 +0200
Subject: Improvements to pagination

---
 hakyll.hs | 30 ++++++++++++++++++++----------
 1 file changed, 20 insertions(+), 10 deletions(-)

(limited to 'hakyll.hs')

diff --git a/hakyll.hs b/hakyll.hs
index 2afd1b7..a1d9bf5 100644
--- a/hakyll.hs
+++ b/hakyll.hs
@@ -118,7 +118,16 @@ main = hakyll $ do
 
         cl cur link = if cur == link then " class=\"s\"" else ""
 
-    pagenav prev next = pagenavPrev prev ++ pagenavNext next
+    maybeGetRouteFor :: Compiler (Maybe (Identifier (Page String))) (Maybe FilePath)
+    maybeGetRouteFor = arr maybeToEither >>> (constA Nothing ||| getRouteFor)
+      where
+        maybeToEither Nothing = Left ()
+        maybeToEither (Just a) = Right a
+
+    addPagenav :: Compiler (Page a, (Maybe (Identifier (Page String)), Maybe (Identifier (Page String)))) (Page a)
+    addPagenav = setFieldA "pagenav" $ (maybeGetRouteFor *** maybeGetRouteFor) >>> arr pagenav
+
+    pagenav (prev, next) = pagenavPrev prev ++ pagenavNext next
 
     pagenavPrev Nothing = "<span class=\"newer\">&nbsp;</span>"
     pagenavPrev (Just url) = "<span class=\"newer\"><a href=\"" ++ url ++ "\" rel=\"prev\">&laquo; Newer Entries</a></span>"
@@ -127,13 +136,14 @@ main = hakyll $ do
     pagenavNext (Just url) = "<span class=\"older\"><a href=\"" ++ url ++ "\" rel=\"next\">Older Entries &raquo;</a></span>"
 
     pageTitle 0 = ""
-    pageTitle i = " - Page " ++ show (i+1)
+    pageTitle i = " &ndash; Page " ++ show (i+1)
 
     paginatePosts :: Compiler ((String, Pattern (Page String)), [Page String]) [(Identifier (Page String), Compiler () (Page String))]
-    paginatePosts = paginate 5 (setExtension ".html")
-                    (arr (\(title, prev, next, i, pages) -> ((mempty, (title, prev, next, i)), pages))
-                     >>> first (first (addTagCloud >>> addArchiveLinks)
-                                >>> arr (\(page, (title, prev, next, i)) -> setField "pagenav" (pagenav prev next) $ setField "title" (title ++ pageTitle i) page)
+    paginatePosts = paginate 5
+                    (arr (\(title, prev, next, i, pages) -> (((mempty, (prev, next)), (title, i)), pages))
+                     >>> first (first (first (addTagCloud >>> addArchiveLinks)
+                                       >>> addPagenav)
+                                >>> arr (\(page, (title, i)) -> setField "title" (title ++ pageTitle i) page)
                                )
                      >>> addPosts
                      >>> applyTemplateCompiler "templates/index.html"
@@ -182,8 +192,8 @@ recentFirst = reverse . chronological
 groupTuples :: Eq a => [(a, b)] -> [(a, [b])]
 groupTuples = map (fst . head &&& map snd) . groupBy ((==) `on` fst)
 
-paginate :: Int -> Routes -> Compiler (a, Maybe String, Maybe String, Int, [Page String]) (Page String) -> Compiler ((a, Pattern (Page String)), [Page String]) [(Identifier (Page String), Compiler () (Page String))]
-paginate perPage routes c = arr $ \((a, pattern), posts) -> renderPages a pattern 0 (n posts) posts
+paginate :: Int -> Compiler (a, Maybe (Identifier (Page String)), Maybe (Identifier (Page String)), Int, [Page String]) (Page String) -> Compiler ((a, Pattern (Page String)), [Page String]) [(Identifier (Page String), Compiler () (Page String))]
+paginate perPage c = arr $ \((a, pattern), posts) -> renderPages a pattern 0 (n posts) posts
   where
     renderPages _ _ _ _ [] = []
     renderPages a pattern i n posts = (name i, constA (a, prev i, next i n, i, cur) >>> c):(renderPages a pattern (i+1) n rest)
@@ -191,9 +201,9 @@ paginate perPage routes c = arr $ \((a, pattern), posts) -> renderPages a patter
         (cur, rest) = splitAt perPage posts
 
         prev 0 = Nothing
-        prev i = fmap toUrl . runRoutes routes . name $ i-1
+        prev i = Just . name $ i-1
 
-        next i n = if i == (n-1) then Nothing else fmap toUrl . runRoutes routes . name $ i+1
+        next i n = if i == (n-1) then Nothing else Just . name $ i+1
 
         name 0 = fromCapture pattern ""
         name i = fromCapture pattern $ show i
-- 
cgit v1.2.3