diff --git a/src/Dom.hs b/src/Dom.hs index d20cbf9..dfc996a 100644 --- a/src/Dom.hs +++ b/src/Dom.hs @@ -1,9 +1,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Dom ( - article - , articlesList - , page + 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 () -article (Article {fullContents, urlPath}) = - 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 = +page :: Page a => a -> HtmlGenerator () +page aPage = 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 ) ) diff --git a/src/HTML.hs b/src/HTML.hs index a6c54fe..86c1a1a 100644 --- a/src/HTML.hs +++ b/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 )