hablo/src/ArticlesList.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module ArticlesList (
      ArticlesList(..)
    , description
    , getArticles
    , otherURL
    , rssLinkTexts
  ) where

import Article (Article)
import Blog (Blog(..), Renderer, Skin(..), template)
import Collection (Collection(..))
import Control.Monad.Reader (MonadReader, asks)
import Data.Text (Text, pack)
import Files (absoluteLink)
import Pretty ((.$))
import System.FilePath.Posix ((</>))

data ArticlesList = ArticlesList {
      full :: Bool
    , collection :: Collection
  }

getArticles :: MonadReader Blog m => ArticlesList -> m [Article]
getArticles (ArticlesList {full, collection = Collection {featured}}) = do
  limit <- take <$> (asks $skin.$previewArticlesCount)
  return $ if full then featured else limit featured

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

description :: Renderer m => ArticlesList -> m Text
description (ArticlesList {full, collection}) =
  template page . environment $ tag collection
  where
    page = if full then "allPage" else "latestPage"
    environment = maybe [] $ \value -> [("tag", pack value)]

rssLinkTexts :: Renderer m => ArticlesList -> m (Text, Text)
rssLinkTexts (ArticlesList {collection}) = do
  text <- template "rssLink" []
  title <- template "rssTitle" environment
  return (text, title)
  where
    environment = maybe [] (\v -> [("tag", pack v)]) $ tag collection