Sort things out between Collection and ArticlesList (keep a link to the Collection and just add a flag saying whether the ArticlesList is a restricted version of or the whole Collection) and implement the generation of a link to the RSS feed

src/ArticlesList.hs

@@ -4,38 +4,49 @@
 module ArticlesList (
       ArticlesList(..)
     , description
+    , getArticles
     , otherURL
-    , title
+    , rssLinkTexts
   ) where
 
 import Article (Article)
-import Blog (Blog(..))
+import Blog (Blog(..), Skin(..))
 import Blog.Wording (render)
+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 {
-      tagged :: Maybe String
+      full :: Bool
-    , full :: Bool
+    , collection :: Collection
-    , featured :: [Article]
   }
 
-otherURL :: ArticlesList -> String
+getArticles :: MonadReader Blog m => ArticlesList -> m [Article]
-otherURL (ArticlesList {full, tagged}) = absoluteLink $
+getArticles (ArticlesList {full, collection = Collection {featured}}) = do
-  (if full then id else (</> "all.html")) $ maybe "" id tagged
+  limit <- take <$> (asks $skin.$previewArticlesCount)
+  return $ if full then featured else limit featured
 
-title :: MonadReader Blog m => ArticlesList -> m String
+otherURL :: ArticlesList -> String
-title (ArticlesList {tagged}) = do
+otherURL (ArticlesList {full, collection}) = absoluteLink $
-  asks $ (\name -> maybe name ((name ++ " - ") ++) tagged) . name
+  (if full then id else (</> "all.html")) . maybe "" id $ tag collection
 
 description :: MonadReader Blog m => ArticlesList -> m Text
-description (ArticlesList {full, tagged}) =
+description (ArticlesList {full, collection}) =
-  getDescription (full, tagged) <$> asks wording
+  getDescription (full, tag collection) <$> 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)]
+
+rssLinkTexts :: MonadReader Blog m => ArticlesList -> m (Text, Text)
+rssLinkTexts (ArticlesList {collection}) = do
+  text <- asks $wording.$(render "rssLink" [])
+  title <- asks $wording.$(render "rssTitle" environment)
+  return (text, title)
+  where
+    environment = maybe [] (\v -> [("tag", pack v)]) $ tag collection

src/Blog.hs

@@ -39,6 +39,7 @@ type Collection = Map String Article
 
 data Blog = Blog {
       articles :: Collection
+    , hasRSS :: Bool
     , name :: String
     , path :: Path
     , skin :: Skin
@@ -92,9 +93,10 @@ build arguments = do
   wording <- Wording.build arguments
   root <- Files.absolute . Dir $ Arguments.sourceDir arguments
   withCurrentDirectory root $ do
+    let hasRSS = maybe False (\_-> True) $ rss urls
     path <- Path.build root arguments
     let name = maybe (takeFileName $ dropTrailingPathSeparator root) id
               $ Arguments.name arguments
     skin <- Skin.build name arguments
     (articles, tags) <- discover path
-    return $ Blog {articles, name, path, skin, tags, urls, wording}
+    return $ Blog {articles, hasRSS, name, path, skin, tags, urls, wording}

src/Collection.hs

@@ -1,10 +1,12 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Collection (
       Collection(..)
     , getAll
+    , title
   ) where
 
-import Article(Article(..))
+import Article(Article(metadata))
 import Blog (Blog(..), Path(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Reader (MonadReader(..), ReaderT, asks)
@@ -15,21 +17,21 @@ import Data.Ord (Down(..))
 import qualified Data.Set as Set (member)
 import Pretty ((.$))
 import System.Directory (createDirectoryIfMissing)
-import System.FilePath.Posix ((</>))
+import System.FilePath ((</>))
 
 data Collection = Collection {
-      articlesFeatured :: [Article]
+      featured :: [Article]
     , basePath :: FilePath
     , tag :: Maybe String
   }
 
 build :: MonadIO m => [Article] -> Maybe String -> ReaderT Blog m Collection
-build articlesFeatured tag = do
+build featured tag = do
   root <- asks $path.$root
   let basePath = maybe root (root </>) tag
   liftIO $ createDirectoryIfMissing False basePath
   return $ Collection {
-      articlesFeatured = sortByDate articlesFeatured, basePath, tag
+      featured = sortByDate featured, basePath, tag
     }
   where
     sortByDate = sortOn (Down . (! "date") . metadata)
@@ -45,3 +47,7 @@ getAll = do
   where
     getArticles tagged =
       Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged)
+
+title :: MonadReader Blog m => Collection -> m String
+title (Collection {tag}) = do
+  asks $ (\name -> maybe name ((name ++ " - ") ++) tag) . name

src/DOM.hs

@@ -6,11 +6,13 @@ module DOM (
 
 import Article (Article(..))
 import qualified Article (preview)
-import ArticlesList (ArticlesList(..), otherURL, description)
+import ArticlesList (
+    ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
+  )
 import Blog (Blog(..), Path(..), Skin(..), URL(..))
 import qualified Blog (get)
 import Blog.Wording (render)
-import Control.Monad.Reader (ReaderT)
+import Control.Monad.Reader (ReaderT, asks)
 import qualified Data.Map as Map (keys)
 import Data.Text (pack, empty)
 import DOM.Card (HasCard)
@@ -34,31 +36,38 @@ instance Page Article where
   content = article True
 
 instance Page ArticlesList where
-  content al@(ArticlesList {featured, full}) = do
+  content al@(ArticlesList {full}) = do
     preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
     h2_ . toHtml =<< description al
-    a_ [href_ . pack $ otherURL al] . toHtml =<< otherLink
+    ul_ $ do
+      asks hasRSS >>= rssLink
+      li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink
     div_ [class_ "articles"] (
-        mapM_ (article False . preview) featured
+        mapM_ (article False . preview) =<< getArticles al
       )
     where
       link = render (if full then "latestLink" else "allLink") []
-      otherLink = Blog.get $wording.$(link)
+      otherLink = Blog.get $wording.$link.$toHtml
+      rssLink :: Bool -> HtmlGenerator ()
+      rssLink True = do
+        (text, title) <- rssLinkTexts al
+        li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text
+      rssLink False = return ()
 
 article :: Bool -> Article -> HtmlGenerator ()
 article raw (Article {key, body, Article.title}) = do
   url <- absoluteLink . (</> key <.> extension) <$> (Blog.get $path.$articlesPath)
   article_ [id_ $ pack key] (do
       header_ (do
-          a_ [href_ . pack $ url] . h1_ $ toHtml title
+          a_ [href_ $ pack url] . h1_ $ toHtml title
         )
       pre_ . toHtml $ unlines body
     )
   where extension = if raw then "md" else "html"
 
 tag :: String -> HtmlGenerator ()
-tag tagName = li_ (
+tag name = li_ (
-    a_ [href_ . pack $ absoluteLink tagName, class_ "tag"] $ toHtml tagName
+    a_ [href_ . pack $ absoluteLink name ++ "/", class_ "tag"] $ toHtml name
   )
 
 defaultBanner :: HtmlGenerator ()

src/DOM/Card.hs

@@ -9,9 +9,11 @@ module DOM.Card (
 
 import qualified Article (Article(..))
 import ArticlesList (ArticlesList(..))
-import qualified ArticlesList (description, title)
+import qualified ArticlesList (description)
 import Blog (Blog(..), Skin(..))
 import qualified Blog (get)
+import Collection (Collection(..))
+import qualified Collection (title)
 import Control.Applicative ((<|>))
 import Control.Monad.Reader (MonadReader)
 import qualified Data.Map as Map (lookup)
@@ -64,15 +66,15 @@ instance HasCard Article.Article where
       getDescription = maybe (Blog.get $name.$("A new article on " <>)) return
 
 instance HasCard ArticlesList where
-  getCard al = do
+  getCard al@(ArticlesList {collection}) = do
-    cardTitle <- ArticlesList.title al
+    cardTitle <- Collection.title collection
     description <- ArticlesList.description al
     return $ Card {
           cardType = "website"
         , description
         , image = Nothing
         , DOM.Card.title = cardTitle
-        , urlPath = maybe "" ('/':) (tagged al) ++ file
+        , urlPath = maybe "" ('/':) (tag collection) ++ file
       }
     where
       file = '/' : (if full al then "all" else "index") ++ ".html"

src/HTML.hs

@@ -6,7 +6,7 @@ module HTML (
 
 import Article(Article(..))
 import ArticlesList (ArticlesList(..))
-import Blog (Blog(..), Path(..), Skin(..))
+import Blog (Blog(..), Path(..))
 import Collection (Collection(..))
 import qualified Collection (getAll)
 import Control.Monad.IO.Class (MonadIO(..))
@@ -18,21 +18,13 @@ import Lucid (renderTextT)
 import Pretty ((.$))
 import System.FilePath.Posix ((</>), (<.>))
 
-articlesLists :: Monad m => Collection -> ReaderT Blog m [(FilePath, ArticlesList)]
+articlesLists :: Collection -> [(FilePath, ArticlesList)]
-articlesLists (Collection {articlesFeatured, basePath, tag}) = do
+articlesLists collection@(Collection {basePath}) = [
-  limit <- take <$> (asks $skin.$previewArticlesCount)
+    (path full, ArticlesList {collection, full}) | full <- [False, True]
-  return [
-        (basePath </> "index" <.> "html", ArticlesList {
-              tagged = tag
-            , full = False
-            , featured = limit articlesFeatured
-          })
-      , (basePath </> "all" <.> "html", ArticlesList {
-              tagged = tag
-            , full = True
-            , featured = articlesFeatured
-          })
   ]
+  where
+    file bool = if bool then "all" else "index"
+    path bool = basePath </> file bool <.> "html"
 
 generateArticles :: [Article] -> ReaderT Blog IO ()
 generateArticles = mapM_ $ \article -> do
@@ -41,13 +33,10 @@ generateArticles = mapM_ $ \article -> do
     >>= liftIO . TextIO.writeFile (baseDir </> key article <.> "html")
 
 generateCollection :: Collection -> ReaderT Blog IO ()
-generateCollection (Collection {articlesFeatured = []}) = return ()
+generateCollection (Collection {featured = []}) = return ()
-generateCollection aCollection = do
+generateCollection collection =
-  articlesLists aCollection
+  flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
-  >>= (mapM_ $ \(filePath, articlesList) ->
+    (renderTextT $ page articlesList) >>= liftIO . TextIO.writeFile filePath
-    (renderTextT $ page articlesList)
-    >>= liftIO . TextIO.writeFile filePath
-  )
 
 generate :: ReaderT Blog IO ()
 generate = do

src/JSON.hs

@@ -28,6 +28,7 @@ instance ToJSON ArticleExport where
 
 data BlogDB = BlogDB {
       articles :: Map String ArticleExport
+    , hasRSS :: Bool
     , path :: Path
     , skin :: Skin
     , tags :: Map String [String]
@@ -51,6 +52,7 @@ exportBlog = do
   blog <- ask
   return . encode $ BlogDB {
         articles = mapWithKey (exportArticle blog) $ Blog.articles blog
+      , hasRSS = Blog.hasRSS blog
       , path = Blog.path blog
       , skin = Blog.skin blog
       , tags = Set.elems <$> Blog.tags blog

src/RSS.hs

@@ -6,10 +6,11 @@ module RSS (
   ) where
 
 import Article (Article(..))
-import ArticlesList (ArticlesList(..))
+import ArticlesList (ArticlesList(..), getArticles)
-import qualified ArticlesList (description, title)
+import qualified ArticlesList (description)
-import Blog (Blog(..), Path(..), Skin(..), URL(..))
+import Blog (Blog(..), Path(..), URL(..))
 import Collection (Collection(..), getAll)
+import qualified Collection (title)
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Reader (MonadReader, ReaderT, asks)
 import Data.Text (Text)
@@ -68,27 +69,23 @@ articleItem siteURL (Article {key, metadata, title}) =
       . posixSecondsToUTCTime . fromIntegral . (read :: String -> Int)
 
 feed :: MonadReader Blog m => String -> ArticlesList -> HtmlT m ()
-feed siteURL al@(ArticlesList {tagged, featured}) = do
+feed siteURL al@(ArticlesList {collection}) = do
   prolog
   rss_ [version, content, atom] $ do
     channel_ $ do
-      title_ . toHtml =<< ArticlesList.title al
+      title_ . toHtml =<< Collection.title collection
-      link_ . toHtml $ siteURL </> maybe "" id tagged
+      link_ . toHtml $ siteURL </> maybe "" (++ "/") (tag collection)
       description_ . toHtml =<< ArticlesList.description al
-      mapM_ (articleItem siteURL) featured
+      mapM_ (articleItem siteURL) =<< getArticles al
   where
     version = version_ "2.0"
     content = xmlns_content_ "http://purl.org/rss/1.0/modules/content/"
     atom = xmlns_atom_ "http://www.w3.org/2005/Atom"
 
 generateCollection :: String -> Collection -> ReaderT Blog IO ()
-generateCollection siteURL (Collection {articlesFeatured, basePath, tag}) = do
+generateCollection siteURL collection =
-  limit <- take <$> (asks $skin.$previewArticlesCount)
+  renderTextT (feed siteURL $ ArticlesList {full = False, collection})
-  let articlesList = ArticlesList {
+  >>= liftIO . TextIO.writeFile (basePath collection </> "rss" <.> "xml")
-      tagged = tag, full = False, featured = limit articlesFeatured
-    }
-  renderTextT (feed siteURL articlesList)
-  >>= liftIO . TextIO.writeFile (basePath </> "rss" <.> "xml")
 
 generate :: ReaderT Blog IO ()
 generate = (asks $urls.$rss) >>= maybe (return ()) generateAll