hakyll/examples/categoryblog/hakyll.hs

65 lines
2.6 KiB
Haskell
Raw Normal View History

2010-01-29 14:16:08 +00:00
module Main where
import Text.Hakyll (hakyll)
import Text.Hakyll.Render
2010-01-29 17:36:54 +00:00
import Text.Hakyll.Tags (TagMap, readCategoryMap)
import Text.Hakyll.File (getRecursiveContents, directory, removeSpaces, sortByBaseName)
2010-01-29 14:16:08 +00:00
import Text.Hakyll.Renderables (createPagePath, createCustomPage, createListingWith, createListing)
import Text.Hakyll.Context (ContextManipulation, renderDate)
import Text.Hakyll.Util (link)
import Data.Map (toList)
import Control.Monad (mapM_, liftM, (<=<))
import Data.Either (Either(..))
main = hakyll $ do
-- Static directory.
directory css "css"
-- Find all post paths.
2010-01-29 17:36:54 +00:00
postPaths <- liftM (reverse . sortByBaseName) $ getRecursiveContents "posts"
2010-01-29 14:16:08 +00:00
let renderablePosts = map createPagePath postPaths
-- Read category map.
categoryMap <- readCategoryMap "categoryMap" renderablePosts
-- Render all posts list.
renderPostList "posts.html" "All posts" renderablePosts
-- Render post list per category
2010-01-31 10:19:57 +00:00
mapM_ (\(category, posts) -> renderPostList (categoryToUrl category) ("Posts about " ++ category) posts)
2010-01-29 14:16:08 +00:00
(toList categoryMap)
-- Render index, including recent posts.
let index = createListingWith postManipulation "index.html"
"templates/postitem.html"
(take 3 renderablePosts)
[ ("title", "Home")
, ("categories", categoryList categoryMap)
]
renderChain ["index.html", "templates/default.html"] index
-- Render all posts.
mapM_ (renderChainWith postManipulation
["templates/post.html"
,"templates/default.html"
]) renderablePosts
-- Render rss feed
let rss = createListing "rss.xml" "templates/rssitem.xml" (take 3 renderablePosts) []
renderChain ["templates/rss.xml"] rss
where postManipulation :: ContextManipulation
postManipulation = renderDate "date" "%B %e, %Y" "Date unknown"
2010-01-31 10:19:57 +00:00
categoryToUrl category = "$root/categories/" ++ removeSpaces category ++ ".html"
2010-01-29 14:16:08 +00:00
2010-01-29 17:36:54 +00:00
categoryList :: TagMap -> String
2010-01-29 14:16:08 +00:00
categoryList = uncurry categoryListItem <=< toList
2010-01-31 10:19:57 +00:00
categoryListItem category posts = "<li>" ++ link category (categoryToUrl category)
2010-01-29 14:16:08 +00:00
++ " - " ++ show (length posts) ++ " items.</li>"
renderPostList url title posts = do
let list = createListingWith postManipulation url "templates/postitem.html" posts [("title", title)]
renderChain ["posts.html", "templates/default.html"] list