@@ -1,71 +1,104 @@
1+{-# LANGUAGE OverloadedStrings #-}
1module Main where
2module Main where
4+import Prelude hiding (id)
3−import Control.Arrow ((>>>))
5+import Control.Arrow ((>>>), (***), arr)
4−import Text.Hakyll (hakyll)
6+import Control.Category (id)
5−import Text.Hakyll.Render
6−import Text.Hakyll.Tags (readTagMap, renderTagCloud, renderTagLinks, withTagMap)
7−import Text.Hakyll.Feed (FeedConfiguration (..), renderRss)
8−import Text.Hakyll.File (getRecursiveContents, directory, removeSpaces)
9−import Text.Hakyll.CreateContext (createPage, createCustomPage, createListing)
10−import Text.Hakyll.ContextManipulations (renderDate, copyValue)
11−import Data.List (sort)
12−import Data.Map (toList)
13−import Control.Monad (forM_, liftM)
7+import Control.Monad (forM_)
14−import Data.Either (Either(..))
8+import qualified Data.Map as M
9+import Data.Monoid (mempty, mconcat)
16−main = hakyll "http://example.com" $ do
11+import Hakyll
20− -- Find all post paths.
13+main :: IO ()
21− postPaths <- liftM (reverse . sort) $ getRecursiveContents "posts"
14+main = hakyll $ do
22− let renderablePosts = map ((>>> postManipulation) . createPage) postPaths
15+ -- Compress CSS
16+ route "css/*" idRoute
17+ compile "css/*" compressCssCompiler
24− -- Read tag map.
19+ -- Render posts
25− let tagMap = readTagMap "postTags" postPaths
20+ route "posts/*" $ setExtension ".html"
23+ >>> arr (renderDateField "date" "%B %e, %Y" "Date unknown")
24+ >>> renderTagsField "prettytags" (fromCaptureString "tags/*")
25+ >>> applyTemplateCompiler "templates/post.html"
26+ >>> applyTemplateCompiler "templates/default.html"
27+ >>> relativizeUrlsCompiler
27− -- Render all posts list.
29+ -- Render posts list
28− renderPostList "posts.html" "All posts" renderablePosts
30+ route "posts.html" $ idRoute
31+ create "posts.html" $
33+ >>> arr (setField "title" "All posts")
34+ >>> requireAllA "posts/*" addPostList
35+ >>> applyTemplateCompiler "templates/posts.html"
36+ >>> applyTemplateCompiler "templates/default.html"
37+ >>> relativizeUrlsCompiler
30− -- Render post list per tag
39+ -- Index
31− let renderListForTag tag posts =
40+ route "index.html" $ idRoute
32− renderPostList (tagToUrl tag) ("Posts tagged " ++ tag)
41+ create "index.html" $
33− (map (>>> postManipulation) posts)
42+ constA mempty
34− withTagMap tagMap renderListForTag
43+ >>> arr (setField "title" "Home")
44+ >>> requireA "tags" (setFieldA "tagcloud" (renderTagCloud'))
45+ >>> requireAllA "posts/*" (id *** arr (take 3 . reverse . sortByBaseName) >>> addPostList)
46+ >>> applyTemplateCompiler "templates/index.html"
47+ >>> applyTemplateCompiler "templates/default.html"
48+ >>> relativizeUrlsCompiler
36− -- Render index, including recent posts.
50+ -- Tags
37− let tagCloud = tagMap >>> renderTagCloud tagToUrl 100 200
51+ create "tags" $
38− index = createListing "index.html"
52+ requireAll "posts/*" (\_ ps -> readTags ps :: Tags String)
39− ["templates/postitem.html"]
40− (take 3 renderablePosts)
41− [ ("title", Left "Home")
42− , ("tagcloud", Right tagCloud)
44− renderChain ["index.html", "templates/default.html"] index
46− -- Render all posts.
54+ -- Add a tag list compiler for every tag
47− forM_ renderablePosts $ renderChain [ "templates/post.html"
55+ route "tags/*" $ setExtension ".html"
48− , "templates/default.html"
56+ metaCompile $ require_ "tags"
49− ]
57+ >>> arr (M.toList . tagsMap)
58+ >>> arr (map (\(t, p) -> (tagIdentifier t, makeTagList t p)))
51− -- Render rss feed
60+ -- Render RSS feed
52− renderRss myFeedConfiguration $
61+ route "rss.xml" $ idRoute
53− map (>>> copyValue "body" "description") (take 3 renderablePosts)
62+ create "rss.xml" $
63+ requireAll_ "posts/*"
64+ >>> renderRss feedConfiguration
67+ compile "templates/*" templateCompiler
56− postManipulation = renderDate "date" "%B %e, %Y" "Date unknown"
72+ renderTagCloud' :: Compiler (Tags String) String
57− >>> renderTagLinks tagToUrl
73+ renderTagCloud' = renderTagCloud tagIdentifier 100 120
75+ tagIdentifier :: String -> Identifier
76+ tagIdentifier = fromCaptureString "tags/*"
59− tagToUrl tag = "$root/tags/" ++ removeSpaces tag ++ ".html"
78+-- | Auxiliary compiler: generate a post list from a list of given posts, and
79+-- add it to the current page under @$posts@
81+addPostList :: Compiler (Page String, [Page String]) (Page String)
82+addPostList = setFieldA "posts" $
83+ arr (reverse . sortByBaseName)
84+ >>> require "templates/postitem.html" (\p t -> map (applyTemplate t) p)
61− renderPostList url title posts = do
88+makeTagList :: String
62− let list = createListing url ["templates/postitem.html"]
89+ -> [Page String]
63− posts [("title", Left title)]
90+ -> Compiler () (Page String)
91+makeTagList tag posts =
92+ constA (mempty, posts)
94+ >>> arr (setField "title" ("Posts tagged ‘" ++ tag ++ "’"))
95+ >>> applyTemplateCompiler "templates/posts.html"
64− renderChain ["posts.html", "templates/default.html"] list
96+ >>> applyTemplateCompiler "templates/default.html"
98+feedConfiguration :: FeedConfiguration
66−myFeedConfiguration = FeedConfiguration
99+feedConfiguration = FeedConfiguration
67− { feedUrl = "rss.xml"
68− , feedTitle = "SimpleBlog RSS feed."
100+ { feedTitle = "SimpleBlog RSS feed."
69 , feedDescription = "A simple demo of an RSS feed created with Hakyll."
101 , feedDescription = "A simple demo of an RSS feed created with Hakyll."
70 , feedAuthorName = "Jasper Van der Jeugt"
102 , feedAuthorName = "Jasper Van der Jeugt"
103+ , feedRoot = "http://example.com"