Tissevert/hablo
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

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

Browse source
This commit is contained in:
Tissevert 2019-02-04 15:50:35 +01:00
parent 38846e1add
commit fb66c578fa
2 changed files with 25 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
src/Dom.hs
View file

@ -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
)
)

6
src/HTML.hs
View file

@ -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
)