Better publish time handling, dynamic topnav

4 files changed, 60 insertions, 30 deletions

diff --git a/hakyll.hs b/hakyll.hs
index 9ec9225..2afd1b7 100644
--- a/hakyll.hs
+++ b/hakyll.hs
@@ -18,7 +18,7 @@ import Data.Time.Format (parseTime, formatTime)
 
 import Text.Printf
 
-import Hakyll
+import Hakyll hiding (chronological, recentFirst)
 
 main :: IO ()
 main = hakyll $ do
@@ -42,14 +42,15 @@ main = hakyll $ do
         >>> addArchiveLinks
         >>> renderTagsField "prettytags" (fromCapture "tags/*")
         >>> applyTemplateCompiler "templates/post.html"
+        >>> addTopnav
         >>> applyTemplateCompiler "templates/default.html"
         >>> relativizeUrlsCompiler
 
   -- Index
   match "index*" $ route $ setExtension ".html"
   metaCompile $ requireAllA allPosts $ arr (recentFirst . snd)
-    >>> ((constA () &&& constA "index*") &&& id)
-    >>> paginatePosts (const "Home")
+    >>> (constA ("Home", "index*") &&& id)
+    >>> paginatePosts
 
   match "posts/*" $ compile $ pageCompiler
     >>> (id &&& getIdentifier)
@@ -64,8 +65,9 @@ main = hakyll $ do
   match "tags/*" $ route $ setExtension ".html"
   metaCompile $ require_ "tags"
     >>> arr tagsMap
-    >>> mapCompiler (((arr id &&& arr (parseGlob . (++ "*") . identifierPath . tagIdentifier)) *** id)
-                     >>> paginatePosts (\tag -> "Posts tagged ‘" ++ tag ++ "’")
+    >>> arr (map $ second recentFirst)
+    >>> mapCompiler (((arr (\tag -> "Posts tagged ‘" ++ tag ++ "’") &&& arr (parseGlob . (++ "*") . identifierPath . tagIdentifier)) *** id)
+                     >>> paginatePosts
                     )
     >>> arr concat
 
@@ -76,8 +78,9 @@ main = hakyll $ do
   match "archive/**" $ route $ setExtension ".html"
   metaCompile $ require_ "archive"
     >>> arr tagsMap
-    >>> mapCompiler (((arr id &&& arr (parseGlob . (++ "*") . identifierPath . archiveIdentifier)) *** id)
-                     >>> paginatePosts (\month -> "Archive for " ++ prettyMonth month)
+    >>> arr (map $ second recentFirst)
+    >>> mapCompiler (((arr (\month -> "Archive for " ++ prettyMonth month) &&& arr (parseGlob . (++ "*") . identifierPath . archiveIdentifier)) *** id)
+                     >>> paginatePosts
                     )
     >>> arr concat
 
@@ -101,41 +104,61 @@ main = hakyll $ do
     allPosts :: Pattern (Page String)
     allPosts = notInPostGroup "posts/*"
 
-    nav prev next = navPrev prev ++ navNext next
+    addTopnav :: Compiler (Page a) (Page a)
+    addTopnav = arr (id &&& const ()) >>> setFieldA "topnav" topnav
 
-    navPrev Nothing = "<span class=\"newer\">&nbsp;</span>"
-    navPrev (Just url) = "<span class=\"newer\"><a href=\"" ++ url ++ "\" rel=\"prev\">&laquo; Newer Entries</a></span>"
+    topnav :: Compiler () String
+    topnav = constA topLinks >>> mapCompiler topnavLink >>> arr (concat . catMaybes)
+      where
+        topnavLink = second (id &&& (getRouteFor >>> arr (fmap toUrl)) >>> arr pullSnd)
+                     >>> arr pullSnd
+                     >>> (getIdentifier &&& id)
+                     >>> arr pullSnd
+                     >>> arr (fmap (\(cur, (text, (link, url))) -> "<li><a href=\"" ++ url ++ "\"" ++ cl cur link ++ "><span>" ++ escapeHtml text ++ "</span></a></li>"))
+
+        cl cur link = if cur == link then " class=\"s\"" else ""
+
+    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>"
 
-    navNext Nothing = "<span class=\"older\">&nbsp;</span>"
-    navNext (Just url) = "<span class=\"older\"><a href=\"" ++ url ++ "\" rel=\"next\">Older Entries &raquo;</a></span>"
+    pagenavNext Nothing = "<span class=\"older\">&nbsp;</span>"
+    pagenavNext (Just url) = "<span class=\"older\"><a href=\"" ++ url ++ "\" rel=\"next\">Older Entries &raquo;</a></span>"
 
     pageTitle 0 = ""
     pageTitle i = " - Page " ++ show (i+1)
 
-    paginatePosts :: (a -> String) -> Compiler ((a, Pattern (Page String)), [Page String]) [(Identifier (Page String), Compiler () (Page String))]
-    paginatePosts title = paginate 5 (setExtension ".html")
-                          (arr (\(a, prev, next, i, pages) -> ((mempty, (a, prev, next, i)), pages))
-                           >>> first (first (addTagCloud >>> addArchiveLinks)
-                                      >>> arr (\(page, (a, prev, next, i)) -> setField "nav" (nav prev next) $ setField "title" (title a ++ pageTitle i) page)
-                                     )
-                           >>> addPosts
-                           >>> applyTemplateCompiler "templates/index.html"
-                           >>> applyTemplateCompiler "templates/default.html"
-                           >>> relativizeUrlsCompiler
-                          )
+    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)
+                               )
+                     >>> addPosts
+                     >>> applyTemplateCompiler "templates/index.html"
+                     >>> addTopnav
+                     >>> applyTemplateCompiler "templates/default.html"
+                     >>> relativizeUrlsCompiler
+                    )
+
 
+topLinks :: [(String, Identifier (Page String))]
+topLinks = [("Home", "index")
+           ]
 
 
+pullSnd :: Functor m => (a, m b) -> m (a, b)
+pullSnd (a, b) = fmap (const a &&& id) b
 
 
 patternIntersection :: [Pattern a] -> Pattern a
 patternIntersection patterns = predicate $ flip all patterns . flip matches
 
 
-getUTCMaybe :: TimeLocale     -- ^ Output time locale
-            -> Page a         -- ^ Input page
+getUTCMaybe :: Page a         -- ^ Input page
             -> Maybe UTCTime  -- ^ Parsed UTCTime
-getUTCMaybe locale page = msum
+getUTCMaybe page = msum
     [ fromPublished "%a, %d %b %Y %H:%M:%S UT"
     , fromPublished "%Y-%m-%dT%H:%M:%SZ"
     , fromPublished "%B %e, %Y %l:%M %p"
@@ -145,10 +168,16 @@ getUTCMaybe locale page = msum
     ]
   where
     fromPublished f  = getFieldMaybe "published" page >>= parseTime' f
-    parseTime' f str = parseTime locale f str
+    parseTime' f str = parseTime defaultTimeLocale f str
 
 getDate :: Page a -> Maybe String
-getDate = liftM ((\(y, m, _) -> printf "%04d/%02d" y m) . toGregorian . utctDay) . getUTCMaybe defaultTimeLocale
+getDate = liftM ((\(y, m, _) -> printf "%04d/%02d" y m) . toGregorian . utctDay) . getUTCMaybe
+
+chronological :: [Page a] -> [Page a]
+chronological = sortBy (compare `on` getUTCMaybe)
+
+recentFirst :: [Page a] -> [Page a]
+recentFirst = reverse . chronological
 
 groupTuples :: Eq a => [(a, b)] -> [(a, [b])]
 groupTuples = map (fst . head &&& map snd) . groupBy ((==) `on` fst)
diff --git a/posts/2012-06-01-a-new-blog-is-born.markdown b/posts/2012-06-01-a-new-blog-is-born.markdown
index 73f7ec0..b258a53 100644
--- a/posts/2012-06-01-a-new-blog-is-born.markdown
+++ b/posts/2012-06-01-a-new-blog-is-born.markdown
@@ -1,6 +1,7 @@
 ---
 title: A new blog is born
 tags: meta, memes, Hakyll, Haskell
+published: 2012-06-01T20:59:04Z
 ---
 
 <p><img src="/images/2012-06-01-wonka.jpg" alt="Wonka: Oh, you have a blog now. You must have so many stories to tell!" /></p>
diff --git a/templates/default.html b/templates/default.html
index 38331ab..584e3cc 100644
--- a/templates/default.html
+++ b/templates/default.html
@@ -25,7 +25,7 @@
 	<div id="top_bar">
 	  <div class="center_menu">
 	    <ul id="front_menu" >
-	      <li><a class="s" href="/"><span>Home</span></a></li>
+	      $topnav$
 	    </ul>
 	  </div>
 	</div>
diff --git a/templates/index.html b/templates/index.html
index b221afe..408f174 100644
--- a/templates/index.html
+++ b/templates/index.html
@@ -1,5 +1,5 @@
 $posts$
 
 <div class="newer_older">
-  $nav$
+  $pagenav$
 </div>