diff options
Diffstat (limited to 'examples/tagblog/hakyll.hs')
| -rw-r--r-- | examples/tagblog/hakyll.hs | 139 |
1 files changed, 86 insertions, 53 deletions
diff --git a/examples/tagblog/hakyll.hs b/examples/tagblog/hakyll.hs index a81c280..447f232 100644 --- a/examples/tagblog/hakyll.hs +++ b/examples/tagblog/hakyll.hs @@ -1,71 +1,104 @@ +{-# LANGUAGE OverloadedStrings #-} module Main where -import Control.Arrow ((>>>)) -import Text.Hakyll (hakyll) -import Text.Hakyll.Render -import Text.Hakyll.Tags (readTagMap, renderTagCloud, renderTagLinks, withTagMap) -import Text.Hakyll.Feed (FeedConfiguration (..), renderRss) -import Text.Hakyll.File (getRecursiveContents, directory, removeSpaces) -import Text.Hakyll.CreateContext (createPage, createCustomPage, createListing) -import Text.Hakyll.ContextManipulations (renderDate, copyValue) -import Data.List (sort) -import Data.Map (toList) -import Control.Monad (forM_, liftM) -import Data.Either (Either(..)) +import Prelude hiding (id) +import Control.Arrow ((>>>), (***), arr) +import Control.Category (id) +import Control.Monad (forM_) +import qualified Data.Map as M +import Data.Monoid (mempty, mconcat) -main = hakyll "http://example.com" $ do - -- Static directory. - directory css "css" +import Hakyll - -- Find all post paths. - postPaths <- liftM (reverse . sort) $ getRecursiveContents "posts" - let renderablePosts = map ((>>> postManipulation) . createPage) postPaths +main :: IO () +main = hakyll $ do + -- Compress CSS + route "css/*" idRoute + compile "css/*" compressCssCompiler - -- Read tag map. - let tagMap = readTagMap "postTags" postPaths + -- Render posts + route "posts/*" $ setExtension ".html" + compile "posts/*" $ + pageCompiler + >>> arr (renderDateField "date" "%B %e, %Y" "Date unknown") + >>> renderTagsField "prettytags" (fromCaptureString "tags/*") + >>> applyTemplateCompiler "templates/post.html" + >>> applyTemplateCompiler "templates/default.html" + >>> relativizeUrlsCompiler - -- Render all posts list. - renderPostList "posts.html" "All posts" renderablePosts + -- Render posts list + route "posts.html" $ idRoute + create "posts.html" $ + constA mempty + >>> arr (setField "title" "All posts") + >>> requireAllA "posts/*" addPostList + >>> applyTemplateCompiler "templates/posts.html" + >>> applyTemplateCompiler "templates/default.html" + >>> relativizeUrlsCompiler - -- Render post list per tag - let renderListForTag tag posts = - renderPostList (tagToUrl tag) ("Posts tagged " ++ tag) - (map (>>> postManipulation) posts) - withTagMap tagMap renderListForTag + -- Index + route "index.html" $ idRoute + create "index.html" $ + constA mempty + >>> arr (setField "title" "Home") + >>> requireA "tags" (setFieldA "tagcloud" (renderTagCloud')) + >>> requireAllA "posts/*" (id *** arr (take 3 . reverse . sortByBaseName) >>> addPostList) + >>> applyTemplateCompiler "templates/index.html" + >>> applyTemplateCompiler "templates/default.html" + >>> relativizeUrlsCompiler - -- Render index, including recent posts. - let tagCloud = tagMap >>> renderTagCloud tagToUrl 100 200 - index = createListing "index.html" - ["templates/postitem.html"] - (take 3 renderablePosts) - [ ("title", Left "Home") - , ("tagcloud", Right tagCloud) - ] - renderChain ["index.html", "templates/default.html"] index + -- Tags + create "tags" $ + requireAll "posts/*" (\_ ps -> readTags ps :: Tags String) - -- Render all posts. - forM_ renderablePosts $ renderChain [ "templates/post.html" - , "templates/default.html" - ] + -- Add a tag list compiler for every tag + route "tags/*" $ setExtension ".html" + metaCompile $ require_ "tags" + >>> arr (M.toList . tagsMap) + >>> arr (map (\(t, p) -> (tagIdentifier t, makeTagList t p))) - -- Render rss feed - renderRss myFeedConfiguration $ - map (>>> copyValue "body" "description") (take 3 renderablePosts) + -- Render RSS feed + route "rss.xml" $ idRoute + create "rss.xml" $ + requireAll_ "posts/*" + >>> renderRss feedConfiguration + -- Read templates + compile "templates/*" templateCompiler + + -- End + return () where - postManipulation = renderDate "date" "%B %e, %Y" "Date unknown" - >>> renderTagLinks tagToUrl + renderTagCloud' :: Compiler (Tags String) String + renderTagCloud' = renderTagCloud tagIdentifier 100 120 + + tagIdentifier :: String -> Identifier + tagIdentifier = fromCaptureString "tags/*" - tagToUrl tag = "$root/tags/" ++ removeSpaces tag ++ ".html" +-- | Auxiliary compiler: generate a post list from a list of given posts, and +-- add it to the current page under @$posts@ +-- +addPostList :: Compiler (Page String, [Page String]) (Page String) +addPostList = setFieldA "posts" $ + arr (reverse . sortByBaseName) + >>> require "templates/postitem.html" (\p t -> map (applyTemplate t) p) + >>> arr mconcat + >>> arr pageBody - renderPostList url title posts = do - let list = createListing url ["templates/postitem.html"] - posts [("title", Left title)] - renderChain ["posts.html", "templates/default.html"] list +makeTagList :: String + -> [Page String] + -> Compiler () (Page String) +makeTagList tag posts = + constA (mempty, posts) + >>> addPostList + >>> arr (setField "title" ("Posts tagged ‘" ++ tag ++ "’")) + >>> applyTemplateCompiler "templates/posts.html" + >>> applyTemplateCompiler "templates/default.html" -myFeedConfiguration = FeedConfiguration - { feedUrl = "rss.xml" - , feedTitle = "SimpleBlog RSS feed." +feedConfiguration :: FeedConfiguration +feedConfiguration = FeedConfiguration + { feedTitle = "SimpleBlog RSS feed." , feedDescription = "A simple demo of an RSS feed created with Hakyll." , feedAuthorName = "Jasper Van der Jeugt" + , feedRoot = "http://example.com" } |