Messy but quasi-working!

Directly following
https://stackoverflow.com/questions/52805193/in-hakyll-how-can-i-generate-a-tags-page
Sole problem now is that the title field for the tags is #tag instead of
tag leading to troubles with ids (link/#id not found because the id is
\#\#id...)
And archive page is bleh!

app/Main.hs

@@ -18,12 +18,14 @@ import           Utils.FileTree
 import           Utils.Routes
 
 import           Kit.Organisms.TagsFields
+import           Kit.Templates.Archive          ( archiveTemplate )
 import           Kit.Templates.Index            ( indexTemplate )
 import           Kit.Templates.Post             ( postTemplate )
+import           Kit.Templates.Sitemap
 
 resources :: Component ()
 resources = do
-  mconcat [postTemplate, indexTemplate]
+  mconcat [postTemplate, indexTemplate, archiveTemplate]
   tagsField'
   return ()
 
@@ -41,12 +43,6 @@ cssHash = fromString . show . hash $ allCss
 
 main :: IO ()
 main = hakyll $ do
-  match "src/Kit/Templates/*.hs"
-    $   compile
-    $   runGHC
-    >>= compileTemplateItem
-    >>= makeItem
-
   tags <- buildTags (patrn $ Post "*.md") (fromCapture . patrn $ Tag "*")
 
   match (patrn $ Post "*.md") $ do
@@ -57,18 +53,31 @@ main = hakyll $ do
         >>= componentTemplate postTemplate defaultContext
         .   fmap demoteHeaders
 
-    create ["index.html"] $ do
-      route idRoute
-      compile $ do
-        pages <- recentFirst =<< loadAllSnapshots "posts/*.md" "content"
-        let ctx = listField
-              "pages"
-              (  teaserField "teaser" "content"
-              <> getBody tagsField' "tags" tags
-              <> defaultContext
-              )
-              (return pages)
-        makeItem "" >>= loadAndApplyTemplate "src/Kit/Templates/Index.hs" ctx
+  create ["index.html"] $ do
+    route idRoute
+    compile $ do
+      pages <- recentFirst =<< loadAllSnapshots "posts/*.md" "content"
+      let ctx = listField
+            "pages"
+            (  teaserField "teaser" "content"
+            <> getBody tagsField' "tags" tags
+            <> defaultContext
+            )
+            (return pages)
+      makeItem "" >>= componentTemplate indexTemplate ctx
+
+  create ["tags/index.html"] $ do
+    route idRoute
+    compile $ do
+      let archiveCtx = listField "tagList" tagsCtx getAllTags
+          getAllTags = pure . map mkItem $ tagsMap tags
+            where mkItem x = Item (tagsMakeId tags (fst x)) x
+          tagsCtx =
+            listFieldWith "posts" defaultContext getPosts
+              <> titleField "title"
+              <> missingField
+          getPosts itm = mapM load (snd . itemBody $ itm)
+      makeItem "" >>= componentTemplate archiveTemplate archiveCtx
 
   create [cssHash] $ do
     route $ constRoute . tail . path $ DefaultStylesheet
@@ -84,5 +93,4 @@ main = hakyll $ do
       posts <- recentFirst =<< loadAll "posts/*.md"
       let pages      = posts
           sitemapCtx = listField "pages" defaultContext (return pages)
-      makeItem ""
-        >>= loadAndApplyTemplate "src/Kit/Templates/Sitemap.hs" sitemapCtx
+      makeItem "" >>= componentTemplate (pure sitemapTemplate) sitemapCtx

etienne-moqueur.cabal

@@ -53,6 +53,7 @@ library
       Kit.Organisms.Head
       Kit.Organisms.ProfileHeader
       Kit.Organisms.TagsFields
+      Kit.Templates.Archive
       Kit.Templates.Index
       Kit.Templates.Post
       Kit.Templates.Sitemap

src/Core/Compilers.hs

@@ -18,7 +18,7 @@ runGHC = getResourceString
   >>= withItemBody (unixFilter "stack" $ "runghc" : defaultExtensions)
 
 componentTemplate
-  :: Component Html -> Context a -> Item a -> Compiler (Item String)
+  :: Show s => Component s -> Context a -> Item a -> Compiler (Item String)
 componentTemplate comp ctx itm = do
   tpl <- compileTemplateItem =<< makeItem (show . getBody $ comp)
   applyTemplate tpl ctx itm

src/Kit/Molecules/Tag.hs

@@ -29,10 +29,10 @@ linkCss = C.a # byClass "tag" # hover ? do
   color $ primary @ 100
   backgroundColor $ primary @ 60
 
-tagSpan :: Component (Html -> Html)
-tagSpan = do
+tagSpan :: String -> Component (Html -> Html)
+tagSpan tag = do
   addCss "tagSpan" css
-  return $ H.span H.! class_ "tag"
+  return $ H.span H.! class_ "tag" H.! A.id (stringValue tag)
 
 tagLink :: Route -> Component (Html -> Html)
 tagLink ref =

src/Kit/Organisms/TagsFields.hs

@@ -10,7 +10,7 @@ import           Text.Blaze.Html
 
 tagsField' :: Component (String -> Tags -> Context a)
 tagsField' = do
-  tagSpan <*> pure "" -- temporary, remove when defining a tagSpanField
+  tagSpan "" <*> pure "" -- temporary, remove when defining a tagSpanField
   tagLink "" <*> pure ""
   return $ tagsFieldWith getTags tagLinks mconcat
  where

src/Kit/Templates/Archive.hs

@@ -0,0 +1,24 @@
+module Kit.Templates.Archive
+  ( archiveTemplate
+  ) where
+
+import           Clay                          as C
+import           Components
+import           Core.Render                    ( )
+import           Kit.Molecules.Tag
+import           Kit.Organisms.TagsFields
+import           Routes
+import           Text.Blaze.Html5              as H
+import           Text.Blaze.Html5.Attributes   as A
+
+archiveTemplate :: Component Html
+archiveTemplate = H.body <$> mconcat
+  [ pure "$for(tagList)$"
+  , tagSpan "$title$" <*> pure "$title$"
+  , pure H.ul <*> mconcat
+    [ pure "$for(posts)$"
+    , pure $ H.a H.! A.href "$url$" $ "$title$"
+    , pure "$endfor$"
+    ]
+  , pure "$endfor$"
+  ]

src/Kit/Templates/Index.hs

@@ -1,6 +1,5 @@
 module Kit.Templates.Index
-  ( main
-  , indexTemplate
+  ( indexTemplate
   ) where
 
 import           Components
@@ -33,6 +32,3 @@ indexBody =
 indexTemplate :: Component Html
 indexTemplate =
   docTypeHtml <$> defaultHead "Very first try" <> (body <$> indexBody)
-
-main :: IO ()
-main = print $ getBody indexTemplate

src/Kit/Templates/Post.hs

@@ -1,6 +1,5 @@
 module Kit.Templates.Post
   ( postTemplate
-  , main
   ) where
 
 import           Components
@@ -20,6 +19,3 @@ postTemplate =
             "$body$"
           )
         )
-
-main :: IO ()
-main = print $ getBody postTemplate

src/Kit/Templates/Sitemap.hs

@@ -1,4 +1,6 @@
-module Kit.Templates.Sitemap where
+module Kit.Templates.Sitemap
+  ( sitemapTemplate
+  ) where
 
 import           Core.Render
 import           Info
@@ -16,6 +18,3 @@ sitemapTemplate = do
       loc $ toMarkup root <> "$url$"
       lastmod "$if(updated)$$updated$$else$$if(date)$$date$$endif$$endif$"
     "$endfor$"
-
-main :: IO ()
-main = print sitemapTemplate