@@ -1,71 +1,104 @@
1+{-# LANGUAGE OverloadedStrings #-}
12module Main where
23
3−import Control.Arrow ((>>>))
4−import Text.Hakyll (hakyll)
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)
14−import Data.Either (Either(..))
4+import Prelude hiding (id)
5+import Control.Arrow ((>>>), (***), arr)
6+import Control.Category (id)
7+import Control.Monad (forM_)
8+import qualified Data.Map as M
9+import Data.Monoid (mempty, mconcat)
1510
16−main = hakyll "http://example.com" $ do
17− -- Static directory.
18− directory css "css"
11+import Hakyll
1912
20− -- Find all post paths.
21− postPaths <- liftM (reverse . sort) $ getRecursiveContents "posts"
22− let renderablePosts = map ((>>> postManipulation) . createPage) postPaths
13+main :: IO ()
14+main = hakyll $ do
15+ -- Compress CSS
16+ route "css/*" idRoute
17+ compile "css/*" compressCssCompiler
2318
24− -- Read tag map.
25− let tagMap = readTagMap "postTags" postPaths
19+ -- Render posts
20+ route "posts/*" $ setExtension ".html"
21+ compile "posts/*" $
22+ pageCompiler
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
2628
27− -- Render all posts list.
28− renderPostList "posts.html" "All posts" renderablePosts
29+ -- Render posts list
30+ route "posts.html" $ idRoute
31+ create "posts.html" $
32+ constA mempty
33+ >>> arr (setField "title" "All posts")
34+ >>> requireAllA "posts/*" addPostList
35+ >>> applyTemplateCompiler "templates/posts.html"
36+ >>> applyTemplateCompiler "templates/default.html"
37+ >>> relativizeUrlsCompiler
2938
30− -- Render post list per tag
31− let renderListForTag tag posts =
32− renderPostList (tagToUrl tag) ("Posts tagged " ++ tag)
33− (map (>>> postManipulation) posts)
34− withTagMap tagMap renderListForTag
39+ -- Index
40+ route "index.html" $ idRoute
41+ create "index.html" $
42+ constA mempty
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
3549
36− -- Render index, including recent posts.
37− let tagCloud = tagMap >>> renderTagCloud tagToUrl 100 200
38− index = createListing "index.html"
39− ["templates/postitem.html"]
40− (take 3 renderablePosts)
41− [ ("title", Left "Home")
42− , ("tagcloud", Right tagCloud)
43− ]
44− renderChain ["index.html", "templates/default.html"] index
50+ -- Tags
51+ create "tags" $
52+ requireAll "posts/*" (\_ ps -> readTags ps :: Tags String)
4553
46− -- Render all posts.
47− forM_ renderablePosts $ renderChain [ "templates/post.html"
48− , "templates/default.html"
49− ]
54+ -- Add a tag list compiler for every tag
55+ route "tags/*" $ setExtension ".html"
56+ metaCompile $ require_ "tags"
57+ >>> arr (M.toList . tagsMap)
58+ >>> arr (map (\(t, p) -> (tagIdentifier t, makeTagList t p)))
5059
51− -- Render rss feed
52− renderRss myFeedConfiguration $
53− map (>>> copyValue "body" "description") (take 3 renderablePosts)
60+ -- Render RSS feed
61+ route "rss.xml" $ idRoute
62+ create "rss.xml" $
63+ requireAll_ "posts/*"
64+ >>> renderRss feedConfiguration
5465
66+ -- Read templates
67+ compile "templates/*" templateCompiler
68+
69+ -- End
70+ return ()
5571 where
56− postManipulation = renderDate "date" "%B %e, %Y" "Date unknown"
57− >>> renderTagLinks tagToUrl
72+ renderTagCloud' :: Compiler (Tags String) String
73+ renderTagCloud' = renderTagCloud tagIdentifier 100 120
74+
75+ tagIdentifier :: String -> Identifier
76+ tagIdentifier = fromCaptureString "tags/*"
5877
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@
80+--
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)
85+ >>> arr mconcat
86+ >>> arr pageBody
6087
61− renderPostList url title posts = do
62− let list = createListing url ["templates/postitem.html"]
63− posts [("title", Left title)]
64− renderChain ["posts.html", "templates/default.html"] list
88+makeTagList :: String
89+ -> [Page String]
90+ -> Compiler () (Page String)
91+makeTagList tag posts =
92+ constA (mempty, posts)
93+ >>> addPostList
94+ >>> arr (setField "title" ("Posts tagged ‘" ++ tag ++ "’"))
95+ >>> applyTemplateCompiler "templates/posts.html"
96+ >>> applyTemplateCompiler "templates/default.html"
6597
66−myFeedConfiguration = FeedConfiguration
67− { feedUrl = "rss.xml"
68− , feedTitle = "SimpleBlog RSS feed."
98+feedConfiguration :: FeedConfiguration
99+feedConfiguration = FeedConfiguration
100+ { feedTitle = "SimpleBlog RSS feed."
69101 , feedDescription = "A simple demo of an RSS feed created with Hakyll."
70102 , feedAuthorName = "Jasper Van der Jeugt"
103+ , feedRoot = "http://example.com"
71104 }