hablo/src/ArticlesList.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module ArticlesList (
      ArticlesList(..)
    , description
    , otherUrl
    , title
  ) where

import Article (Article)
import Blog (Blog(..))
import Blog.Wording (render)
import Control.Monad.Reader (MonadReader, asks)
import Data.Text (Text, pack)
import Files (absoluteLink)
import System.FilePath.Posix ((</>))

data ArticlesList = ArticlesList {
      tagged :: Maybe String
    , full :: Bool
    , featured :: [Article]
  }

otherUrl :: ArticlesList -> String
otherUrl (ArticlesList {full, tagged}) = absoluteLink $
  (if full then id else (</> "all.html")) $ maybe "" id tagged

title :: MonadReader Blog m => ArticlesList -> m String
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
    getDescription (True, Nothing) = render "allPage" []
    getDescription (True, Just tag) = render "allTaggedPage" [("tag", pack tag)]
    getDescription (False, Nothing) = render "latestPage" []
    getDescription (False, Just tag) =
      render "latestTaggedPage" [("tag", pack tag)]