help needed to better understand Hakyll, and minor proposals

55 views
Skip to first unread message

paul rivier

unread,
Jun 22, 2010, 5:30:42 AM6/22/10
to hakyll
Hi,

We just replaced my company blog with a static one generated with
hakyll. Thank you very much for this nice gem, I'll finally be able to
write posts right from my editor of choice and get html generated
properly, yeah !

However, some misunderstanding of some aspects of Hakyll have forced
me to twist it a bit, so I'd like to share with you what I wanted to
obtain, and how I managed to do it. I'm fairly sure most of it is bad
practice, so I hope someone will jump in soon and tell us how to do it
properly.

The blog is a fairly common one, with common requirements.

> -- (...)

I want the tag list to appear in every page, so there is a $tagList
reference in my default.html template. Also, I want the main RSS feed
to be proposed from any page, except from a "tag index page" (the page
that list all posts tagged with ...), from which I want to propose
a tag-specific feed. Therefore, the RSS part of default.html is filled
with $references.

> let tagMap = readTagMap "postTags" postPaths
> tagList = tagMap >>> renderTagList
> otherContext = [ ("feedUrl", Left "/rss.xml")
> , ("feedTitle", Left "Demotera")
> , ("feedLabel", Left "Fil RSS du blog")
> , ("tagList", Right tagList) ]


> let renderablePosts = map (myCreatePage otherContext) postPaths

> -- Render all posts list.
> renderPostList "posts.html" "Tous les billets" renderablePosts otherContext


The renderPostList is convenient in the way it allows to pass some
extra Context to the default createPage action. For some other
problems, I wished there were a 'createPageWithContext' method that
would do the same as createPage, but allow to embbed more Key-Values
context from a list.

> -- Render post list per tag
> let renderListForTag tag posts =
> renderPostList (tagToUrlHtml tag)
> ("Rubrique " ++ tag)
> (map (>>> postManipulation) posts)
> [ ("feedUrl", Left $ tagToUrlRss tag)
> , ("feedTitle", Left $ "Demotera, " ++ tag)
> , ("feedLabel", Left $ "Fil RSS de la rubrique " ++ tag)
> , ("tagList", Right tagList)] in
> withTagMap tagMap renderListForTag

This hack to embbed 'otherContext' in rendering isn't really pleasant.

> -- Render index, including recent posts.
> let index = createListing "index.html"
> ["templates/post.html"
> ,"templates/post_without_comment.html"]
> (take 5 renderablePosts)
> ([ ("title", Left "Blog de Demotera") ] ++ otherContext) in
> renderChain ["index.html", "templates/default.html"] index

The main RSS feed, notice that I added a "wrapCdata" function, to
produce valid RSS.

> -- Render rss feed
> renderRss myFeedConfiguration $
> map (>>> renderValue "body" "description" wrapCdata) (take 10 renderablePosts)

There is an RSS feed for each tag.

> let renderRssForTag tag posts =
> renderRss (getFeedConfForTag tag) $
> map (>>> renderValue "body" "description" wrapCdata) (take 10 posts) in
> withTagMap tagMap renderRssForTag


Below are helper functions :

> where

Ouch ... I didn't know how to benefit both from the default behaviour
of createPage and from the Context tuning of createCustomPage, so
I hacked that up with combine.

> myCreatePage context url = combine (createPage url) (createCustomPage url context)
> >>> postManipulation

As a post manipulation, we render the date and the post tags properly.

> postManipulation = renderDate "date" "%A %e %B %Y" ""
> >>> renderValue "tags" "tagsLabel" tagsText
> >>> renderTagLinks tagToUrlHtml

> -- (...)

We didn't like the tag map, and only wanted the list of tags with
links to tags index page. So we wrote our own. I guess html should not
appear here, so that would better be done through templating, right ?

> renderTagList :: HakyllAction TagMap String
> renderTagList = createHakyllAction renderTagCloud' where
> renderTagCloud' tagMap = return $
> "<ul><li>"
> ++ intercalate "</li><li>" (map tagWithLink (M.keys tagMap))
> ++ "</li></ul>"
> tagWithLink tag = "<a href=\"" ++ tagToUrlHtml tag ++ "\">" ++ tag ++ "</a>"


Notice the required 'context' to provide a correct RSS and a correct
tagList

> renderPostList url title posts context = do
> let list = createListing url ["templates/postitem.html"]
> posts ([ ("title", Left title) ] ++ context)
> renderChain ["posts.html", "templates/default.html"] list


I think this sould be included in Hakyll/Feed.hs, because otherwise
the RSS can't embbed HTML.

> wrapCdata s = "<![CDATA[" ++ s ++ "]]>"


This little helper generates the FeedConfiguration for a given tag.

> getFeedConfForTag tag =
> let t = removeSpaces tag in
> FeedConfiguration { feedUrl = tagToUrlRss t
> , feedTitle = "Demotera, " ++ t
> , feedDescription = "Demotera, cabinet d'ingénierie en systèmes informatiques haute disponibilité. Rubrique " ++ t
> , feedAuthorName = "Demotera" }


We wanted the date to be rendered as French time local, so we had to
rewrite the whole function only to tweak the local. Maybe that should
belong to the hakyll configuration, or at least 'renderDate' should be
defined as 'renderDateWithLocale defaultTimeLocale', so that we can
define our own without cloning.

> renderDate :: String -- ^ Key in which the rendered date should be placed.
> -> String -- ^ Format to use on the date.
> -> String -- ^ Default key, in case the date cannot be parsed.
> -> HakyllAction Context Context
> renderDate key format defaultValue = renderValue "path" key renderDate'
> where
> renderDate' filePath = fromMaybe defaultValue $ do
> let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
> (takeFileName filePath)
> time <- parseTime defaultTimeLocale
> "%Y-%m-%d"
> dateString :: Maybe UTCTime
> return $ formatTime frTimeLocale format time
>


The conclusion is that it works, but with many duplicated code and
a lot of twisted usage. I am sure we could do much much better, and
I would love to know how. I don't really need to track dependencies
between resources, as provided by the Arrow abstraction. I find it
nice and fun, but for *this* blog I'd like to favor simple and concise
code over powerful partial generation :)


~~~~~~~~~~~~~~~~~~~~~~~~~~~


The full hakyll.hs follows:


> module Main where

> import Control.Arrow ((>>>))
> import Text.Hakyll (hakyll)
> import Text.Hakyll.Render
> import Text.Hakyll.Tags (TagMap, readTagMap, renderTagLinks, withTagMap)
> import Text.Hakyll.Feed (FeedConfiguration (..), renderRss)
> import Text.Hakyll.File (getRecursiveContents, directory, removeSpaces)
> import Text.Hakyll.CreateContext (createPage, createCustomPage, createListing, combine)
> import Text.Hakyll.ContextManipulations (renderValue)
> import Text.Hakyll.Regex (substituteRegex)
> import Text.Hakyll.HakyllAction (HakyllAction (..), createHakyllAction,)
> import Text.Hakyll.Context (Context)
>
> import Data.Maybe (fromMaybe)
> import qualified Data.Map as M
> import Data.List (sort, intercalate)
> import Control.Monad (forM_, liftM)
> import System.Locale (TimeLocale(..), defaultTimeLocale)
> import Data.Time.Clock (UTCTime)
> import Data.Time.Format (formatTime, parseTime)
> import System.FilePath (takeFileName)

> main :: IO ()
> main = hakyll "http://blog.demotera.com" $ do
> -- Static directory.
> directory css "css"
> directory static "pictures"
> directory static "js"

> -- Find all post paths.
> postPaths <- liftM (reverse . sort) $ getRecursiveContents "published"

> -- Read tag map and create helpers
> let tagMap = readTagMap "postTags" postPaths
> tagList = tagMap >>> renderTagList
> otherContext = [ ("feedUrl", Left "/rss.xml")
> , ("feedTitle", Left "Demotera")
> , ("feedLabel", Left "Fil RSS du blog")
> , ("tagList", Right tagList) ]


> let renderablePosts = map (myCreatePage otherContext) postPaths

> -- Render all posts list.
> renderPostList "posts.html" "Tous les billets" renderablePosts otherContext

> -- Render post list per tag
> let renderListForTag tag posts =
> renderPostList (tagToUrlHtml tag)
> ("Rubrique " ++ tag)
> (map (>>> postManipulation) posts)
> [ ("feedUrl", Left $ tagToUrlRss tag)
> , ("feedTitle", Left $ "Demotera, " ++ tag)
> , ("feedLabel", Left $ "Fil RSS de la rubrique " ++ tag)
> , ("tagList", Right tagList)] in
> withTagMap tagMap renderListForTag

> -- Render index, including recent posts.
> let index = createListing "index.html"
> ["templates/post.html"
> ,"templates/post_without_comment.html"]
> (take 5 renderablePosts)
> ([ ("title", Left "Blog de Demotera") ] ++ otherContext) in
> renderChain ["index.html", "templates/default.html"] index

> -- Render all posts.
> forM_ renderablePosts $ renderChain [ "templates/post.html"
> , "templates/post_with_comments.html"
> , "templates/default.html"
> ]

> -- Render rss feed
> renderRss myFeedConfiguration $
> map (>>> renderValue "body" "description" wrapCdata) (take 10 renderablePosts)

> let renderRssForTag tag posts =
> renderRss (getFeedConfForTag tag) $
> map (>>> renderValue "body" "description" wrapCdata) (take 10 posts) in
> withTagMap tagMap renderRssForTag

> -- Render other pages
> renderChain ["templates/default.html"] (myCreatePage otherContext "legal.markdown" )

> where
> myCreatePage context url = combine (createPage url) (createCustomPage url context)
> >>> postManipulation

> postManipulation = renderDate "date" "%A %e %B %Y" ""
> >>> renderValue "tags" "tagsLabel" tagsText
> >>> renderTagLinks tagToUrlHtml

> tagsText tags = if (length $ filter (==',') tags) > 0 then
> "les rubriques" else "la rubrique"

> tagToUrl tag = "$root/tags/" ++ removeSpaces tag
> tagToUrlHtml tag = tagToUrl tag ++ ".html"
> tagToUrlRss tag = tagToUrl tag ++ ".xml"
>
> renderTagList :: HakyllAction TagMap String
> renderTagList = createHakyllAction renderTagCloud' where
> renderTagCloud' tagMap = return $
> "<ul><li>"
> ++ intercalate "</li><li>" (map tagWithLink (M.keys tagMap))
> ++ "</li></ul>"
> tagWithLink tag = "<a href=\"" ++ tagToUrlHtml tag ++ "\">" ++ tag ++ "</a>"


> renderPostList url title posts context = do
> let list = createListing url ["templates/postitem.html"]
> posts ([ ("title", Left title) ] ++ context)
> renderChain ["posts.html", "templates/default.html"] list

> wrapCdata s = "<![CDATA[" ++ s ++ "]]>"

> getFeedConfForTag tag =
> let t = removeSpaces tag in
> FeedConfiguration { feedUrl = tagToUrlRss t
> , feedTitle = "Demotera, " ++ t
> , feedDescription = "Demotera, cabinet d'ingénierie en systèmes informatiques haute disponibilité. Rubrique " ++ t
> , feedAuthorName = "Demotera" }


> myFeedConfiguration :: FeedConfiguration
> myFeedConfiguration = FeedConfiguration
> { feedUrl = "rss.xml"
> , feedTitle = "Demotera"
> , feedDescription = "Demotera, cabinet d'ingénierie en systèmes informatiques haute disponibilité."
> , feedAuthorName = "Demotera"
> }


> renderDate :: String -- ^ Key in which the rendered date should be placed.
> -> String -- ^ Format to use on the date.
> -> String -- ^ Default key, in case the date cannot be parsed.
> -> HakyllAction Context Context
> renderDate key format defaultValue = renderValue "path" key renderDate'
> where
> renderDate' filePath = fromMaybe defaultValue $ do
> let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
> (takeFileName filePath)
> time <- parseTime defaultTimeLocale
> "%Y-%m-%d"
> dateString :: Maybe UTCTime
> return $ formatTime frTimeLocale format time
>


> frTimeLocale :: TimeLocale
> frTimeLocale = TimeLocale {
> wDays = [("dimanche", "dim"), ("lundi", "lun"),
> ("mardi", "mar"), ("mercredi", "mer"),
> ("jeudi", "jeu"), ("vendredi", "ven"),
> ("samedi", "sam")],

> months = [("janvier", "jan"), ("fevrier", "fev"),
> ("mars", "mar"), ("avril", "avr"),
> ("Mai", "mai"), ("juin", "juin"),
> ("juillet", "juil"), ("août", "août"),
> ("septembre", "sep"), ("octobre", "oct"),
> ("novembre", "nov"), ("décembre", "dec")],

> intervals = [ ("année","années")
> , ("mois", "mois")
> , ("jour","jours")
> , ("heure","heures")
> , ("min","mins")
> , ("sec","secs")
> , ("usec","usecs")
> ],

> amPm = (" du matin", " de l'après-midi"),
> dateTimeFmt = "%a %e %b %Y, %H:%M:%S %Z",
> dateFmt = "%d-%m-%Y",
> timeFmt = "%H:%M:%S",
> time12Fmt = "%I:%M:%S %p"
> }

Jasper Van der Jeugt

unread,
Jun 22, 2010, 6:08:55 AM6/22/10
to hak...@googlegroups.com
Hey Paul,

I've released a quick .1, Hakyll-2.2.1, which will fix your CDATA and
time locale issues. It wraps description by default in CDATA, which is
a good default, I think. It also provides a function
`renderDateWithLocale`.

For the `otherContext`, you could perhaps make a page out of this
using `createCustomPage` and then `combine` it with the index page?
Something like:

> -- Render index, including recent posts.
> let index = createListing "index.html"
> ["templates/post.html"
> ,"templates/post_without_comment.html"]
> (take 5 renderablePosts)

> ([ ("title", Left "Blog de Demotera") ]) in
> renderChain ["index.html", "templates/default.html"] $ index `combine` otherContextPage

I don't have an elegant solution for the `renderTagList` function
*yet*. If I think of something elegant, I'll let you know. If you have
further questions, do not hesitate to mail again :-) I'm glad you like
Hakyll, and thanks for the feedback!

Kind regards,
Jasper Van der Jeugt

Reply all
Reply to author
Forward
0 new messages