49 lines
1.5 KiB
Haskell
49 lines
1.5 KiB
Haskell
{-# 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
|