Revised how the tags css is brought in.

Feels much less hacky: An Organism with type Component (String -> Tags
-> Context a) makes the necessary field and includes the appropriate
Css. A Component () is defined in main, which gathers all resources. It
is bound to become IO (Component ()) (or Component (IO ())?) when reading
from external files, see
#22

app/Main.hs

@@ -10,7 +10,6 @@ import           Text.Blaze.Html
 
 import           Components
 import           Core.Compilers
-import           Core.Contexts
 import           Core.Render                    ( )
 import           Core.Routers
 import           Core.Rules
@@ -18,19 +17,21 @@ import           Routes
 import           Utils.FileTree
 import           Utils.Routes
 
-import           Kit.Molecules.Tag
+import           Kit.Organisms.TagsFields
 import           Kit.Templates.Index            ( indexTemplate )
 import           Kit.Templates.Post             ( postTemplate )
 
-allTemplates :: [Component Html]
-allTemplates =
-  [postTemplate, indexTemplate, tagSpan <*> pure "", tagLink "" <*> pure ""]
+resources :: Component ()
+resources = do
+  mconcat [postTemplate, indexTemplate]
+  tagsField'
+  return ()
 
 assets :: [FilePath]
-assets = map tail . getPaths . getAssets . mconcat $ allTemplates
+assets = map tail . getPaths . getAssets $ resources
 
 allCss :: String
-allCss = show . getCss . mconcat $ allTemplates
+allCss = show . getCss $ resources
 
 css :: Compiler (Item String)
 css = makeItem allCss
@@ -63,7 +64,7 @@ main = hakyll $ do
         let ctx = listField
               "pages"
               (  teaserField "teaser" "content"
-              <> tagsLinksField "tags" tags
+              <> getBody tagsField' "tags" tags
               <> defaultContext
               )
               (return pages)

etienne-moqueur.cabal

@@ -20,7 +20,6 @@ library
       Components
       Core.Colors
       Core.Compilers
-      Core.Contexts
       Core.Render
       Core.Routers
       Core.Rules
@@ -53,6 +52,7 @@ library
       Kit.Organisms.Card
       Kit.Organisms.Head
       Kit.Organisms.ProfileHeader
+      Kit.Organisms.TagsFields
       Kit.Templates.Index
       Kit.Templates.Post
       Kit.Templates.Sitemap

src/Components.hs

@@ -7,7 +7,7 @@ module Components
   , addCss
   , addAsset
   , addAsset'
-  , getHtml
+  , getBody
   , getCss
   , getAssets
   ) where
@@ -53,9 +53,9 @@ addAsset fp = tell $ Prop Map.empty (build fp)
 addAsset' :: Route -> Component ()
 addAsset' r = tell $ Prop Map.empty (build' r)
 
--- |Get a Component's Html
-getHtml :: Component Html -> Html
-getHtml = fst . runWriter
+-- |Get a Component's body
+getBody :: Component a -> a
+getBody = fst . runWriter
 
 -- |Get a Component's Css
 getCss :: Component a -> Css

src/Core/Compilers.hs

@@ -20,5 +20,5 @@ runGHC = getResourceString
 componentTemplate
   :: Component Html -> Context a -> Item a -> Compiler (Item String)
 componentTemplate comp ctx itm = do
-  tpl <- compileTemplateItem =<< makeItem (show . getHtml $ comp)
+  tpl <- compileTemplateItem =<< makeItem (show . getBody $ comp)
   applyTemplate tpl ctx itm

src/Core/Contexts.hs

@@ -1,15 +0,0 @@
-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/Organisms/TagsFields.hs

@@ -0,0 +1,17 @@
+module Kit.Organisms.TagsFields
+  ( tagsField'
+  ) where
+
+import           Components
+import           Hakyll
+import           Kit.Molecules.Tag
+import           Routes
+import           Text.Blaze.Html
+
+tagsField' :: Component (String -> Tags -> Context a)
+tagsField' = do
+  tagSpan <*> pure "" -- temporary, remove when defining a tagSpanField
+  tagLink "" <*> pure ""
+  return $ tagsFieldWith getTags tagLinks mconcat
+ where
+  tagLinks tag _ = pure . getBody $ tagLink (Tag tag) <*> pure (toHtml tag)

src/Kit/Templates/Index.hs

@@ -35,4 +35,4 @@ indexTemplate =
   docTypeHtml <$> defaultHead "Very first try" <> (body <$> indexBody)
 
 main :: IO ()
-main = print $ getHtml indexTemplate
+main = print $ getBody indexTemplate

src/Kit/Templates/Post.hs

@@ -22,4 +22,4 @@ postTemplate =
         )
 
 main :: IO ()
-main = print $ getHtml postTemplate
+main = print $ getBody postTemplate