summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2012-06-02 08:05:21 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2012-06-02 08:05:21 +0200
commit5a7c9b9c1f405d143c9fdc5aeb241c13f53320b7 (patch)
tree1926220bc1502e008aa7faf6810a655b72c4230f
parentdc3772c0dec1f0b307192d1646ed2bae35ff79a7 (diff)
downloadblog.universe-factory.net-5a7c9b9c1f405d143c9fdc5aeb241c13f53320b7.tar
blog.universe-factory.net-5a7c9b9c1f405d143c9fdc5aeb241c13f53320b7.zip
Better publish time handling, dynamic topnav
-rw-r--r--hakyll.hs85
-rw-r--r--posts/2012-06-01-a-new-blog-is-born.markdown1
-rw-r--r--templates/default.html2
-rw-r--r--templates/index.html2
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 &#8216;" ++ tag ++ "&#8217;")
+ >>> arr (map $ second recentFirst)
+ >>> mapCompiler (((arr (\tag -> "Posts tagged &#8216;" ++ tag ++ "&#8217;") &&& 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>