diff options
| -rw-r--r-- | hakyll.hs | 85 | ||||
| -rw-r--r-- | posts/2012-06-01-a-new-blog-is-born.markdown | 1 | ||||
| -rw-r--r-- | templates/default.html | 2 | ||||
| -rw-r--r-- | templates/index.html | 2 |
4 files changed, 60 insertions, 30 deletions
@@ -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\"> </span>" - navPrev (Just url) = "<span class=\"newer\"><a href=\"" ++ url ++ "\" rel=\"prev\">« 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\"> </span>" + pagenavPrev (Just url) = "<span class=\"newer\"><a href=\"" ++ url ++ "\" rel=\"prev\">« Newer Entries</a></span>" - navNext Nothing = "<span class=\"older\"> </span>" - navNext (Just url) = "<span class=\"older\"><a href=\"" ++ url ++ "\" rel=\"next\">Older Entries »</a></span>" + pagenavNext Nothing = "<span class=\"older\"> </span>" + pagenavNext (Just url) = "<span class=\"older\"><a href=\"" ++ url ++ "\" rel=\"next\">Older Entries »</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> |