Categories in Hakyll
Recently I added “categories” field to the front matter of blogposts to categorize them.
AI fail moment!
I tried to solve this problem with the help of AI(chatgpt), and it ended up with a lot of wasted time.
Despite trying different variations to the prompt, I couldn’t get ChatGPT to give me a working code 1.
Taming the AI!
The tool is only as good as how you weild it. So, instead of being a pessimist2, I turned to using it differently.
I turned my frustration-of not being able to get ChatGPT to conjure code that solved my problem and wasting my time to instead help me understand Hakyll.
This shift in approach yielded positive results. Having ChatGPT explain the codebase, along with my own logical thinking as an engineer, helped me piece together the code I needed to get categories working on my blog. I could have achieved this without ChatGPT’s help, but its explanations certainly guided me to the right places in the source code.
Code snippet
The implementeation is similar to Hakyll handles tags but with the “categories” metadata field.
-- paste inside the main function
main = do
..
..
..
-- builds the categories
categories <- Main.buildCategories "posts/*" (fromCapture "categories/*.html")
..
..
tagsRules categories $ \category pattern -> do
let title = "Posts in category \"" ++ category ++ "\""
route idRoute
compile $ do
posts <- recentFirst =<< loadAll pattern
let ctx = constField "title" title
`mappend` listField "posts" (postCtxWithCategories categories) (return posts)
`mappend` defaultContext
makeItem ""
>>= loadAndApplyTemplate "templates/category.html" ctx
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
-- Posts
matchMetadata "posts/*.md" (isPreview env) $ do
route $ setExtension "html"
compile $
pandocCompiler
>>= loadAndApplyTemplate "templates/post.html" (postCtxWithTagsAndCategories tags categories)
>>= saveSnapshot "content"
>>= loadAndApplyTemplate "templates/default.html" (postCtxWithTagsAndCategories tags categories)
>>= relativizeUrls
-- This can go anywhere (depends on the orginazation of your site.hs
-- I just have it at the bottom of my site.hs file
postCtxWithTagsAndCategories :: Tags -> Tags -> Context String
postCtxWithTagsAndCategories tags categories =
tagsField "tags" tags `mappend`
categoriesField "cat" categories `mappend`
categoryCountField categories `mappend`
postCtx
trimString :: String -> String
trimString = f . f
where f = reverse . dropWhile isSpace
categoryCountField :: Tags -> Context String
categoryCountField categories = field "categoryCount" $ \item -> do
let ident = itemIdentifier item
allTags = tagsMap categories -- already [(category, [Identifier])]
catList = [tag | (tag, idents) <- allTags, ident `elem` idents]
return $ show $ length catList
getCategories :: MonadMetadata m => Identifier -> m [String]
getCategories = getTagsByField "categories"
buildCategoriesWith :: MonadMetadata m
=> (Identifier -> m [String])
-> Pattern
-> (String -> Identifier)
-> m Tags
buildCategoriesWith f pattern makeId = do
ids <- getMatches pattern
tagMap <- foldM addCategories M.empty ids
let set' = S.fromList ids
return $ Tags (M.toList tagMap) makeId (PatternDependency pattern set')
where
addCategories tagMap ident = do
cats <- f ident
let tagMap' = M.fromList $ zip cats (repeat [ident])
return $ M.unionWith (++) tagMap tagMap'
-- Simplified version using getCategories
buildCategories :: Pattern -> (String -> Identifier) -> Rules Tags
buildCategories = buildCategoriesWith getCategories
-- | Render tags with links with custom functions to get tags and to
-- render links
categoriesFieldWith :: (Identifier -> Compiler [String])
-- ^ Get the tags
-> (String -> (Maybe FilePath) -> Maybe H.Html)
-- ^ Render link for one tag
-> ([H.Html] -> H.Html)
-- ^ Concatenate tag links
-> String
-- ^ Destination field
-> Tags
-- ^ Tags structure
-> Context a
-- ^ Resulting context
categoriesFieldWith getTags' renderLink cat key tags = field key $ \item -> do
tags' <- getTags' $ itemIdentifier item
links <- forM tags' $ \tag -> do
route' <- getRoute $ tagsMakeId tags tag
return $ renderLink tag route'
return $ renderHtml $ cat $ catMaybes $ links
-- | Render tags with links
categoriesField :: String -- ^ Destination key
-> Tags -- ^ Tags
-> Context a -- ^ Context
categoriesField =
categoriesFieldWith getCategories simpleRenderLink (mconcat . intersperse ", ")If you read the hakyll source code then you would know that most of the code towards the bottom is very similar to how Hakyll handles tags but updated for “categories”.