Add a class type for «things that can be used as a page content»

src/Dom.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Dom (
-      article
+    page
-    , articlesList
-    , page
   ) where
 
 import Article (Article(..))
@@ -18,6 +16,24 @@ import System.FilePath.Posix ((</>), (<.>))
 
 type HtmlGenerator = HtmlT (ReaderT Blog IO)
 
+class Page a where
+  content :: Monad m => a -> HtmlT m ()
+
+instance Page Article where
+  content (Article {fullContents, urlPath}) =
+    article_ (do
+        a_ [href_ . pack $ "/" </> urlPath <.> "md"] "Raw"
+        pre_ $ toHtml fullContents
+      )
+
+instance Page ArticlesList where
+  content al@(ArticlesList {featured}) =
+    div_ [id_ "contents"] (do
+        h2_ . toHtml $ pageTitle al
+        p_ . a_ [href_ $ otherUrl al] . toHtml $ otherLink al
+        div_ [class_ "articles"] (mapM_ previewArticle featured)
+      )
+
 previewArticle :: Article -> HtmlGenerator ()
 previewArticle (Article {urlPath, title, preview}) =
   article_ (do
@@ -40,23 +56,8 @@ defaultBanner = do
         )
     )
 
-article :: Article -> HtmlGenerator ()
+page :: Page a => a -> HtmlGenerator ()
-article (Article {fullContents, urlPath}) =
+page aPage =
-  article_ (do
-      a_ [href_ . pack $ "/" </> urlPath <.> "md"] "Raw"
-      pre_ $ toHtml fullContents
-    )
-
-articlesList :: ArticlesList -> HtmlGenerator ()
-articlesList al@(ArticlesList {featured}) =
-  div_ [id_ "contents"] (do
-      h2_ . toHtml $ pageTitle al
-      p_ . a_ [href_ $ otherUrl al] . toHtml $ otherLink al
-      div_ [class_ "articles"] (mapM_ previewArticle featured)
-    )
-
-page :: HtmlGenerator () -> HtmlGenerator ()
-page contents =
   doctypehtml_ (do
       head_ (do
           meta_ [charset_ "utf-8"]
@@ -71,6 +72,6 @@ page contents =
               h2_ "Tags"
               ul_ . mapM_ tag . Map.keys =<< Blog.get tags
             )
-          div_ [id_ "contents"] contents
+          div_ [id_ "contents"] $ content aPage
         )
     )

src/HTML.hs

@@ -16,7 +16,7 @@ import qualified Data.Map as Map (elems, filterWithKey, toList)
 import Data.Ord (Down(..))
 import qualified Data.Set as Set (member)
 import qualified Data.Text.Lazy.IO as TextIO (writeFile)
-import qualified Dom (article, articlesList, page)
+import Dom (page)
 import Lucid
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath.Posix ((</>), (<.>))
@@ -58,7 +58,7 @@ articlesLists (Collection {articlesFeatured, basePath, tag}) = do
 generateArticles :: [Article] -> ReaderT Blog IO ()
 generateArticles = mapM_ $ \article -> do
   filePath <- (</> urlPath article <.> "html") <$> (Blog.get root)
-  (renderTextT . Dom.page $ Dom.article article)
+  (renderTextT $ page article)
     >>= liftIO . TextIO.writeFile filePath
 
 generateCollection :: Collection -> ReaderT Blog IO ()
@@ -67,7 +67,7 @@ generateCollection aCollection = do
   liftIO . createDirectoryIfMissing False $ basePath aCollection
   articlesLists aCollection
   >>= (mapM_ $ \(filePath, articlesList) ->
-    (renderTextT . Dom.page $ Dom.articlesList articlesList)
+    (renderTextT $ page articlesList)
     >>= liftIO . TextIO.writeFile filePath
   )