packages feed

hablo-1.0.0.0: src/ArticlesList.hs

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

import Article (Article)
import Blog (Blog(..), Wording(..), get)
import Control.Monad.Reader (MonadReader)
import Data.Text (Text, pack)
import Data.Text.Lazy (toStrict)
import Data.Text.Template (render)
import Files (absoluteLink)
import Pretty ((.$))
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

pageTitle :: (MonadReader Blog m) => ArticlesList -> m Text
pageTitle (ArticlesList {full, tagged}) = do
  template <- Blog.get $wording.$(if full then allTaggedPage else latestTaggedPage)
  untagged <- Blog.get $wording.$(if full then allPage else latestPage)
  return $ maybe untagged (toStrict . render template . tag) tagged
  where
    tag :: String -> Text -> Text
    tag t = \"tag"  -> pack t