Added tags list to blog cards.

Feels hacky: I define Core.Contexts.tagsLinksField to make the tags with
a tagLink component, so this is a call to the Kit from Core, and not
gathered in components so I have to have tagSpan and tagLink in my main
with other templates.
How to solve? It is part of the bigger problem to gather resources at
compile time. Most promising lead now would be to have some sort of
ComponentT Monad transform (=WriterT Prop) *on top* of the Compiler /
Rules Monad so that the compilation steps can accumulate resources.

app/Main.hs

@@ -10,6 +10,7 @@ import           Text.Blaze.Html
 
 import           Components
 import           Core.Compilers
+import           Core.Contexts
 import           Core.Render                    ( )
 import           Core.Routers
 import           Core.Rules
@@ -17,11 +18,13 @@ import           Routes
 import           Utils.FileTree
 import           Utils.Routes
 
+import           Kit.Molecules.Tag
 import           Kit.Templates.Index            ( indexTemplate )
 import           Kit.Templates.Post             ( postTemplate )
 
 allTemplates :: [Component Html]
-allTemplates = [postTemplate, indexTemplate]
+allTemplates =
+  [postTemplate, indexTemplate, tagSpan <*> pure "", tagLink "" <*> pure ""]
 
 assets :: [FilePath]
 assets = map tail . getPaths . getAssets . mconcat $ allTemplates
@@ -43,6 +46,8 @@ main = hakyll $ do
     >>= compileTemplateItem
     >>= makeItem
 
+  tags <- buildTags (patrn $ Post "*.md") (fromCapture . patrn $ Tag "*")
+
   match (patrn $ Post "*.md") $ do
     route $ setExtension "html"
     compile $ do
@@ -51,20 +56,18 @@ main = hakyll $ do
         >>= componentTemplate postTemplate defaultContext
         .   fmap demoteHeaders
 
-  tags <- buildTags (patrn $ Post "*.md") (fromCapture . patrn $ Tag "*")
-
-  create ["index.html"] $ do
-    route idRoute
-    compile $ do
-      pages <- recentFirst =<< loadAllSnapshots "posts/*.md" "content"
-      let ctx = listField
-            "pages"
-            (  teaserField "teaser" "content"
-            <> 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"
+              <> tagsLinksField "tags" tags
+              <> defaultContext
+              )
+              (return pages)
+        makeItem "" >>= loadAndApplyTemplate "src/Kit/Templates/Index.hs" ctx
 
   create [cssHash] $ do
     route $ constRoute . tail . path $ DefaultStylesheet

etienne-moqueur.cabal

@@ -20,6 +20,7 @@ library
       Components
       Core.Colors
       Core.Compilers
+      Core.Contexts
       Core.Render
       Core.Routers
       Core.Rules
@@ -48,6 +49,7 @@ library
       Kit.Molecules.ProfileBio
       Kit.Molecules.ProfileContent
       Kit.Molecules.ProfilePic
+      Kit.Molecules.Tag
       Kit.Organisms.Card
       Kit.Organisms.Head
       Kit.Organisms.ProfileHeader
@@ -57,6 +59,7 @@ library
       Routes
       Utils.Clay
       Utils.FileTree
+      Utils.Routes
       Utils.XML
   other-modules:
       Paths_etienne_moqueur

src/Core/Contexts.hs

@@ -0,0 +1,15 @@
+module Core.Contexts
+  ( tagsLinksField
+  ) where
+
+import           Components
+import           Data.List                      ( intersperse )
+import           Hakyll
+import           Kit.Molecules.Tag
+import           Routes
+import           Text.Blaze.Html
+
+tagsLinksField :: String -> Tags -> Context a
+tagsLinksField = tagsFieldWith getTags tagLinks mconcat
+ where
+  tagLinks tag _ = pure . getHtml $ tagLink (Tag tag) <*> pure (toHtml tag)

src/Kit/Molecules/Tag.hs

@@ -0,0 +1,42 @@
+module Kit.Molecules.Tag
+  ( tagSpan
+  , tagLink
+  ) where
+
+import           Clay                          as C
+import           Components
+import           Kit.Atoms.Link
+import           Kit.Atoms.Typography
+import           Kit.Constants.Colors
+import           Kit.Constants.Spacing         as S
+import           Routes
+import           Text.Blaze.Html5              as H
+import           Text.Blaze.Html5.Attributes   as A
+import           Utils.Clay
+
+css :: Css
+css = element ".tag" ? do
+  backgroundColor $ grays @ 75
+  color $ primary @ 60
+  paddingLeft <> paddingRight $ S.small
+  marginRight S.large
+  display inlineBlock
+  uniform borderRadius S.small
+  codeFont
+
+linkCss :: Css
+linkCss = C.a # byClass "tag" # hover ? do
+  color $ primary @ 100
+  backgroundColor $ primary @ 60
+
+tagSpan :: Component (Html -> Html)
+tagSpan = do
+  addCss "tagSpan" css
+  return $ H.span H.! class_ "tag"
+
+tagLink :: Route -> Component (Html -> Html)
+tagLink ref =
+  do
+    addCss "tagLink" linkCss
+    return (H.! class_ "tag")
+  <.> a' ref

src/Kit/Organisms/Card.hs

@@ -21,6 +21,7 @@ data PostProp = PostProp
   , postTitle   :: Html
   , postSummary :: Html
   , postDate    :: Html
+  , postTags    :: Html
   }
 
 css :: Css
@@ -45,11 +46,11 @@ blogCard prop =
     return $ H.article H.! class_ "card"
   <*> mconcat
         [ cardHeader (postRoute prop) <*> pure (postTitle prop)
-        , cardBody
-          <*> (  pure (postSummary prop)
-              <> (   pure (H.div H.! A.style "text-align: center")
-                 <*> (buttonLink (postRoute prop) <*> pure "More")
-                 )
-              )
+        , cardBody <*> mconcat
+          [ pure (postTags prop)
+          , pure (postSummary prop)
+          , (H.div H.! A.style "text-align: center")
+            <$> (buttonLink (postRoute prop) <*> pure "More")
+          ]
         , cardFooter <*> pure (postDate prop)
         ]

src/Kit/Templates/Index.hs

@@ -20,6 +20,7 @@ dummy = PostProp { postRoute   = "$url$"
                  , postTitle   = "$title$"
                  , postSummary = "$teaser$"
                  , postDate    = "$date$"
+                 , postTags    = "$tags$"
                  }
 
 indexBody :: Component Html

src/Routes.hs

@@ -8,6 +8,7 @@ import           GHC.Exts                       ( IsString(..) )
 data Route = Home
             | Blog
             | Post String
+            | Tag String
             | Img String
             | DefaultStylesheet
             | ExternalRoute String
@@ -19,6 +20,7 @@ path :: Route -> String
 path Home                 = "/"
 path Blog                 = "/posts"
 path (Post postId  )      = "/posts/" <> postId
+path (Tag  tag     )      = "/tags/#" <> tag
 path (Img  fileName)      = "/assets/img/" <> fileName
 path DefaultStylesheet    = "/css/default.css"
 path (ExternalRoute addr) = addr