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

Rename ArticlesLists' description and title for more clarity and reuse in RSS feeds

Browse source
This commit is contained in:
Tissevert 2020-03-23 16:18:22 +01:00
parent dfd3a78b79
commit 2fba3d8b6a
3 changed files with 22 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
src/ArticlesList.hs
View file

@ -3,14 +3,15 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
module ArticlesList ( module ArticlesList (
ArticlesList(..) ArticlesList(..)
, description
, otherUrl , otherUrl
, pageTitle , title
) where ) where
import Article (Article) import Article (Article)
import Blog (Blog(..), get) import Blog (Blog(..))
import Blog.Wording (render) import Blog.Wording (render)
import Control.Monad.Reader (MonadReader) import Control.Monad.Reader (MonadReader, asks)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Files (absoluteLink) import Files (absoluteLink)
import System.FilePath.Posix ((</>)) import System.FilePath.Posix ((</>))
@ -25,13 +26,19 @@ otherUrl :: ArticlesList -> String
otherUrl (ArticlesList {full, tagged}) = absoluteLink $ otherUrl (ArticlesList {full, tagged}) = absoluteLink $
(if full then id else (</> "all.html")) $ maybe "" id tagged (if full then id else (</> "all.html")) $ maybe "" id tagged
pageTitle :: (MonadReader Blog m) => ArticlesList -> m Text title :: MonadReader Blog m => ArticlesList -> m String
pageTitle (ArticlesList {full, tagged}) = title (full, tagged) <$> Blog.get wording title (ArticlesList {tagged}) = do
asks $ (\name -> maybe name ((name ++ " - ") ++) tagged) . name
description :: MonadReader Blog m => ArticlesList -> m Text
description (ArticlesList {full, tagged}) =
getDescription (full, tagged) <$> asks wording
where where
title (True, Nothing) = render "allPage" [] getDescription (True, Nothing) = render "allPage" []
title (True, Just tag) = render "allTaggedPage" [("tag", pack tag)] getDescription (True, Just tag) = render "allTaggedPage" [("tag", pack tag)]
title (False, Nothing) = render "latestPage" [] getDescription (False, Nothing) = render "latestPage" []
title (False, Just tag) = render "latestTaggedPage" [("tag", pack tag)] getDescription (False, Just tag) =
render "latestTaggedPage" [("tag", pack tag)]

4
src/DOM.hs
View file

@ -6,7 +6,7 @@ module DOM (
import Article (Article(..)) import Article (Article(..))
import qualified Article (preview) import qualified Article (preview)
import ArticlesList (ArticlesList(..), otherUrl, pageTitle) import ArticlesList (ArticlesList(..), otherUrl, description)
import Blog (Blog(..), Path(..), Skin(..), URL(..)) import Blog (Blog(..), Path(..), Skin(..), URL(..))
import qualified Blog (get) import qualified Blog (get)
import Blog.Wording (render) import Blog.Wording (render)
@ -32,7 +32,7 @@ instance Page Article where
instance Page ArticlesList where instance Page ArticlesList where
content al@(ArticlesList {featured, full}) = do content al@(ArticlesList {featured, full}) = do
preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount) preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
h2_ . toHtml =<< pageTitle al h2_ . toHtml =<< description al
a_ [href_ . pack $ otherUrl al] . toHtml =<< otherLink a_ [href_ . pack $ otherUrl al] . toHtml =<< otherLink
div_ [class_ "articles"] ( div_ [class_ "articles"] (
mapM_ (article False . preview) featured mapM_ (article False . preview) featured

8
src/DOM/Card.hs
View file

@ -8,7 +8,8 @@ module DOM.Card (
) where ) where
import qualified Article (Article(..)) import qualified Article (Article(..))
import ArticlesList (ArticlesList(..), pageTitle) import ArticlesList (ArticlesList(..))
import qualified ArticlesList (description, title)
import Blog (Blog(..), Skin(..)) import Blog (Blog(..), Skin(..))
import qualified Blog (get) import qualified Blog (get)
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
@ -64,8 +65,8 @@ instance HasCard Article.Article where
instance HasCard ArticlesList where instance HasCard ArticlesList where
getCard al = do getCard al = do
cardTitle <- getTitle <$> Blog.get name cardTitle <- ArticlesList.title al
description <- pageTitle al description <- ArticlesList.description al
return $ Card { return $ Card {
cardType = "website" cardType = "website"
, description , description
@ -74,5 +75,4 @@ instance HasCard ArticlesList where
, urlPath = maybe "" ('/':) (tagged al) ++ file , urlPath = maybe "" ('/':) (tagged al) ++ file
} }
where where
getTitle name = maybe name ((name ++ " - ") ++) $ tagged al
file = '/' : (if full al then "all" else "index") ++ ".html" file = '/' : (if full al then "all" else "index") ++ ".html"