Merge branch 'main' into goSJW

doc/Command-line.md

@@ -154,7 +154,7 @@ The file is read by hablo when the blog is generated and its content gets includ
 
 `-R, --rss`
 
-Enables the generation of RSS feeds for each [lists](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#page-types) of articles. The feed consists in an additional `rss.xml` file placed in the same directory as the `index.html` and `all.html` files generated for. The feeds only include the most recent articles exactly as the «short» versions of each list, which means that they are affected by the use of the [`--preview-articles`](#number-of-articles-previewed) option.
+Enables the generation of RSS feeds for each [list](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#page-types) of articles. The feed consists in an additional `rss.xml` file placed in the same directory as the `index.html` and `all.html` files generated for. The feeds only include the most recent articles exactly as the «short» versions of each list, which means that they are affected by the use of the [`--preview-articles`](#number-of-articles-previewed) option. When this option is enabled, hablo will also include links to the generated feeds in the list pages. Two [template variables](https://git.marvid.fr/Tissevert/hablo/wiki/Template%20variables#rsslinks) control respectively the content and the title of the link.
 
 Note that this feature requires setting your site URL with [`--site-url`](#site-url).
 

doc/Template-variables.md

@@ -4,33 +4,39 @@ Here is the full list of the available text template variables that you can cust
 
 Variables are prefixed by a `$` and may be enclosed in brackets `{ }` to lift any ambiguity and separate the variable from the surrounding characters (exemple : does the template `the $nth` refers to a `nth` variable or is it the variable `n` followed by the literal characters `th` ? the first interpretation prevails, and if you want the second one you should write `the ${n}th`).
 
-Most of the templates are used «at [compile-time](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#static-and-lazy)» when the blog is generated and so errors, missing variables etc. are caught early but some like [metadata](#metadata) are only used client-side and hence need to be more resistant. If a variable present in a template is missing when the template is rendered, an `undefined` JS value is returned.
+All template variables are checked at «[compile-time](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#static-and-lazy)» when the blog is generated and so syntax errors, missing or unexpected variables etc. are caught early.
 
-Now some contexts, especially article contexts may vary a bit so some templates like `metadata` need a way to «catch» those null values and keep up templating. For instance, an article may or may not have an author or tags. You could for instance decide that the base articles of your blog aren't signed because they obviously come from you or the organization that publish the blog but that when the blog publishes an article by a special guest it needs a special mention. To «harden» a template string against possible null values, just enclose the corresponding optional part between `${? ?}`.
+## Conditional blocks
 
-## allLink
+Now some contexts may vary a bit and sometimes «lack» a variable so some templates like `metadata` need a way to «catch» those possible null values and keep templating. You could for instance decide that most articles of your blog aren't signed because they obviously come from you or the organization that publishes the blog but that when the blog features an article by a special guest it needs a special mention and you would put the corresponding part using the `${author}` variable in a conditional block. The syntax to do so and «warn» the templating system of possible null values is to enclose the corresponding optional part inside `${? ?}` like so :
+
+```
+allPage = The articles{? about ${tag}?}
+```
+
+This will yield just `The articles` on the general pages without tags and `The articles about sea turtles` on the pages for the tag `sea turtles`. Note that conditional blocks are «flat», you can't nest one under another.
+
+## Available variables
+
+### allLink
 
 The text used in the link to the [full](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#full-pages) page on the [latest](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#latest-pages) page of the same category.
 
-## allPage
+### allPage
 
-The `<h2>` title used on the [full page for all the articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages).
+The `<h2>` title used on the [full page for articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages).
 
-## allTaggedPage
+It can use the variable named `$tag` : the name of the tag for the given page. Be careful that this variable will be null for the untagged «general» pages, so you want to escape it using the [conditional](#conditional-blocks) syntax described above if your template string does contain `${tag}`.
 
-The template for the  `<h2>` title used on the [full pages for all the articles tagged a given tag](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages).
+### commentsLink
-
-It of course expects one variable named `$tag` : the name of the tag for the given page.
-
-## commentsLink
 
 The text displayed after the comments as a link to the toot that opens the comments section inviting visitors to comment the post.
 
-## commentsSection
+### commentsSection
 
 The content of the `<h2>` element at the begining of the comments on the pages of articles that have comments enabled.
 
-## dateFormat
+### dateFormat
 
 This isn't really a template per-se but impacts the way the dates are generated to use in the [metadata](#metadata) template. More precisely it contains the arguments passed to the [toLocaleDateString](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toLocaleDateString) method. It can thus only consist in a locale name, but since `toLocaleDateString` also accepts an object as second argument, you can write the whole thing using JSON like this :
 
@@ -38,21 +44,17 @@ This isn't really a template per-se but impacts the way the dates are generated
 dateFormat = ["en-AU", {"month":"long", "day":"2-digit"}]
 ```
 
-## latestLink
+### latestLink
 
 The text used in the link to the [latest](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#latest-pages) page on the [full](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#full-pages) page of the same category.
 
-## latestPage
+### latestPage
 
-The `<h2>` title used on the [latest page for all the articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). This page is the main page of your blog so this is more or less the first title that people see when they come to your blog.
+The `<h2>` title used on the [latest page for articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). The latest page without tags is the «main» page of your blog so this is more or less the first title that people see when they come to your blog.
 
-## latestTaggedPage
+Just like the [allPage](#allpage) above it makes use of the `$tag` variable, that will be null for the untagged «general» pages. Again, see the [conditional](#conditional-blocks) section above to handle this properly.
 
-The template for the  `<h2>` title used on the [latest pages for all the articles tagged a given tag](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages).
+### metadata
-
-It of course expects one variable named `$tag` : the name of the tag for the given page.
-
-## metadata
 
 The template of the text used to present the metadata associated to each article. This template is used both in the preview of an article on any page that lists it and on the article's page itself. It expects three possible variables
 
@@ -68,7 +70,15 @@ metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?}
 
 If an article has an author, the rendered `metadata` string will start with «by <AUTHOR>», otherwise it will directly start with «on <SOME DATE>». Likewise all articles with tags will have their `metadata` end with « tagged » and then the list of comma-separated tags but if an article doesn't have tags, it will simply end after the date.
 
-## tagsList
+### rssLink
+
+This template variable contains the text displayed in the link element pointing to the [RSS feed](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#rss) to each [list page](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). This template is a constant and doesn't expect any templating variable.
+
+### rssTitle
+
+This template variable contains the title attribute of the link element pointing to the [RSS feed](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#rss) to each [list page](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages) that will be visible on mouse hover. The only templating variable it expects is `$tag` (which should be preferably [protected](#conditional-blocks) if you use it because `$tag` will be null on the main page containing a link to the general feed containing all the articles published on your blog).
+
+### tagsList
 
 The content of the `<h2>` element in the navigation `<div>` that lists all the tags of your blog.
 

hablo.cabal

@@ -34,6 +34,7 @@ executable hablo
                      , ArticlesList
                      , Blog
                      , Blog.Path
+                     , Blog.Template
                      , Blog.Skin
                      , Blog.URL
                      , Blog.Wording

share/defaultWording.conf

@@ -1,11 +1,11 @@
 allLink = See all
-allPage = All articles
+allPage = All articles{? tagged ${tag}?}
-allTaggedPage = All articles tagged ${tag}
 commentsLink = Comment on the fediverse
 commentsSection = Comments
 dateFormat = en-US
 latestLink = See only latest
-latestPage = Latest articles
+latestPage = Latest articles{? tagged ${tag}?}
-latestTaggedPage = Latest articles tagged ${tag}
 metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?}
+rssLink = Subscribe
+rssTitle = Follow all articles{? tagged ${tag}?}
 tagsList = Tags

share/js/DomRenderer.js

@@ -3,7 +3,7 @@ import Metadata;
 import Remarkable;
 import Template;
 import * as Dom from UnitJS.Dom;
-import * as Fun from UnitJS.Fun;
+import {defined} from UnitJS.Fun;
 
 return {
   article: article,
@@ -72,28 +72,39 @@ function article(key, markdown, limit) {
 }
 
 function pageTitle(tag, all) {
-  if(tag != undefined) {
+  return Template.render(all ? 'allPage' : 'latestPage', {tag: tag});
-    var template = all ? 'allTaggedPage' : 'latestTaggedPage';
-    return Template.render(template, {tag: tag});
-  } else {
-    return blog.wording[all ? 'allPage' : 'latestPage'];
-  }
 }
 
 function otherUrl(tag, all) {
-  var path = [tag, all ? null : 'all.html'];
+  var path = [tag, all ? '' : 'all.html'];
-  return '/' + path.filter(Fun.defined).join('/');
+  return '/' + path.filter(defined).join('/');
 }
 
 function articlesList(tag, all) {
   return function(articlePreviews) {
     return [
       Dom.make('h2', {innerText: pageTitle(tag, all)}),
-      Dom.make('a', {
+			Dom.make('ul', {}, articlesListLinks(tag, all)),
-        innerText: all ? blog.wording.latestLink : blog.wording.allLink,
+      Dom.make('div', {class: 'articles'}, articlePreviews.filter(defined))
-        href: otherUrl(tag, all)
-      }),
-      Dom.make('div', {class: 'articles'}, articlePreviews.filter(Fun.defined))
     ];
   };
 }
+
+function articlesListLinks(tag, all) {
+  var links = [
+    Dom.make('a', {
+      innerText: all ? blog.wording.latestLink : blog.wording.allLink,
+      href: otherUrl(tag, all),
+      class: 'other'
+    })
+  ];
+  if(blog.hasRSS) {
+    links.unshift(Dom.make('a', {
+      innerText: blog.wording.rssLink,
+      href: 'rss.xml',
+      class: 'RSS',
+      title: Template.render('rssTitle', {tag: tag})
+    }));
+  }
+  return links.map(function(e) {return Dom.make('li', {}, [e]);});
+}

src/ArticlesList.hs

@@ -4,42 +4,45 @@
 module ArticlesList (
       ArticlesList(..)
     , description
-    , otherUrl
+    , getArticles
-    , title
+    , otherURL
+    , rssLinkTexts
   ) where
 
 import Article (Article)
-import Blog (Blog(..))
+import Blog (Blog(..), Renderer, Skin(..), template)
-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 :: Renderer m => ArticlesList -> m Text
-description (ArticlesList {full, tagged}) =
+description (ArticlesList {full, collection}) =
-  getDescription (full, tagged) <$> asks wording
+  template page . environment $ tag collection
   where
-    getDescription (True, Nothing) = render "allPage" []
+    page = if full then "allPage" else "latestPage"
-    getDescription (True, Just tag) = render "allTaggedPage" [("tag", pack tag)]
+    environment = maybe [] $ \value -> [("tag", pack value)]
-    getDescription (False, Nothing) = render "latestPage" []
+
-    getDescription (False, Just tag) =
+rssLinkTexts :: Renderer m => ArticlesList -> m (Text, Text)
-      render "latestTaggedPage" [("tag", pack tag)]
+rssLinkTexts (ArticlesList {collection}) = do
-    
+  text <- template "rssLink" []
-    
+  title <- template "rssTitle" environment
-    
+  return (text, title)
-    
+  where
+    environment = maybe [] (\v -> [("tag", pack v)]) $ tag collection

src/Blog.hs

@@ -1,13 +1,15 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
 module Blog (
       Blog(..)
     , Path(..)
+    , Renderer
     , Skin(..)
     , URL(..)
     , Wording
     , build
-    , get
+    , template
   ) where
 
 import Arguments (Arguments)
@@ -16,6 +18,8 @@ import Article (Article)
 import qualified Article (at, getKey)
 import Blog.Path (Path(..))
 import qualified Blog.Path as Path (build)
+import Blog.Template (Environment, Templates, render)
+import qualified Blog.Template as Template (build)
 import Blog.Skin (Skin(..))
 import qualified Blog.Skin as Skin (build)
 import Blog.URL (URL(..))
@@ -23,11 +27,13 @@ import qualified Blog.URL as URL (build)
 import Blog.Wording (Wording)
 import qualified Blog.Wording as Wording (build)
 import Control.Monad ((>=>), filterM, foldM, forM)
-import Control.Monad.Reader (MonadReader, ask)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Reader (MonadReader, asks)
 import Data.Map (Map, insert, lookup)
 import qualified Data.Map as Map (empty, fromList)
 import Data.Set (Set)
 import qualified Data.Set as Set (empty, null, singleton, union)
+import Data.Text (Text)
 import Files (File(..), absolute)
 import qualified Files (find)
 import Prelude hiding (lookup)
@@ -39,16 +45,20 @@ type Collection = Map String Article
 
 data Blog = Blog {
       articles :: Collection
+    , hasRSS :: Bool
     , name :: String
     , path :: Path
     , skin :: Skin
     , tags :: Map String (Set String)
+    , templates :: Templates
     , urls :: URL
     , wording :: Wording
   }
 
-get :: MonadReader Blog m => (Blog -> a) -> m a
+type Renderer m = (MonadIO m, MonadReader Blog m)
-get = (<$> ask)
+
+template :: Renderer m => String -> Environment -> m Text
+template key environment = asks templates >>= render key environment
 
 keepOrWarn :: Map String Article -> Either ParseError (String, Article) -> IO (Map String Article)
 keepOrWarn accumulator (Left parseErrors) =
@@ -89,7 +99,9 @@ discover path = do
 build :: Arguments -> IO Blog
 build arguments = do
   urls <- URL.build arguments
+  let hasRSS = maybe False (\_-> True) $ rss urls
   wording <- Wording.build arguments
+  templates <- Template.build wording
   root <- Files.absolute . Dir $ Arguments.sourceDir arguments
   withCurrentDirectory root $ do
     path <- Path.build root arguments
@@ -97,4 +109,6 @@ build arguments = do
               $ 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, templates, urls, wording
+      }

src/Blog/Template.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Blog.Template (
+      Environment
+    , Templates(..)
+    , build
+    , render
+  ) where
+
+import Blog.Wording (Wording(..), variables)
+import Control.Monad (foldM)
+import Control.Monad.IO.Class (MonadIO(..))
+import Data.List (intercalate)
+import Data.Map (Map, (!))
+import qualified Data.Map as Map (empty, insert, keys)
+import Data.Text (Text, breakOn)
+import qualified Data.Text as Text (concat, drop, null, unpack)
+import Data.Text.Lazy (toStrict)
+import Data.Text.Template (Template, renderA, showTemplate, templateSafe)
+import System.Exit (die)
+
+data TemplateChunk = Top Template | Sub Template
+newtype HabloTemplate = HabloTemplate [TemplateChunk]
+newtype Templates = Templates (Map String HabloTemplate)
+type Environment = [(Text, Text)]
+
+render :: MonadIO m => String -> Environment -> Templates -> m Text
+render key environment (Templates templates) =
+  (Text.concat . fmap toStrict) <$> mapM renderChunk templateChunks
+  where
+    HabloTemplate templateChunks = templates ! key
+    renderer template = renderA template (flip lookup environment)
+    renderChunk (Top template) =
+      let err = "Could not template " ++ Text.unpack (showTemplate template) in
+      maybe (liftIO $ die err) return $ renderer template
+    renderChunk (Sub template) = return . maybe "" id $ renderer template
+
+makeTemplate :: String -> Text -> IO Template
+makeTemplate key templateText =
+  let testEnvironment = flip lookup [(s, "") | s <- availableVariables] in
+  case templateSafe templateText of
+    Left (row, col) -> die $ syntaxError (show row) (show col)
+    Right template ->
+      maybe (die badTemplate) (return . const template) (renderA template testEnvironment)
+  where
+    availableVariables = variables ! key
+    variablesMessage =
+      " (available variables: " ++ intercalate ", " (Text.unpack <$> availableVariables) ++ ")"
+    syntaxError row col =
+      "Syntax error in template for variable " ++ key ++ "at l." ++ row ++ ", c." ++ col 
+    badTemplate = "Invalid template for variable " ++ key ++ variablesMessage
+
+makeHabloTemplate :: String -> Map String Text -> IO HabloTemplate
+makeHabloTemplate key wording = HabloTemplate <$> toHablo True (wording ! key)
+  where
+    toHablo _ "" = return []
+    toHablo atTop template = do
+      let (start, rest) = (Text.drop 2) <$> breakOn (delimiter atTop) template
+      push atTop start <*> toHablo (not atTop) rest
+    delimiter atTop = if atTop then "{?" else "?}"
+    push atTop t
+      | Text.null t = return id
+      | otherwise = (:) . (if atTop then Top else Sub) <$> makeTemplate key t
+
+build :: Wording -> IO Templates
+build (Wording wordingMap) =
+  Templates <$> foldM templateWording Map.empty (Map.keys variables)
+  where
+    templateWording templated key =
+      flip (Map.insert key) templated <$> makeHabloTemplate key wordingMap

src/Blog/Wording.hs

@@ -1,22 +1,17 @@
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Blog.Wording (
       Wording(..)
     , build
-    , render
+    , variables
   ) where
 
 import Arguments (Arguments(..))
 import Control.Monad (foldM)
 import Data.Aeson (ToJSON(..))
-import Data.List (intercalate)
+import Data.Map (Map)
-import Data.Map (Map, (!))
+import qualified Data.Map as Map (empty, fromList, keys, map, union)
-import qualified Data.Map as Map (empty, fromList, insert, keys, map, union)
 import Data.Text (Text)
-import qualified Data.Text as Text (pack, unpack)
+import qualified Data.Text as Text (pack)
-import Data.Text.Lazy (toStrict)
-import Data.Text.Template (Template, renderA, showTemplate, templateSafe)
-import qualified Data.Text.Template as Template (render)
 import Paths_hablo (getDataFileName)
 import Text.ParserCombinators.Parsec (
       Parser
@@ -25,31 +20,26 @@ import Text.ParserCombinators.Parsec (
   )
 import System.Exit (die)
 
-newtype Wording = Wording (Map String Template)
+newtype Wording = Wording (Map String Text)
 
 variables :: Map String [Text]
 variables = Map.fromList [
       ("allLink", [])
-    , ("allPage", [])
+    , ("allPage", ["tag"])
-    , ("allTaggedPage", ["tag"])
     , ("commentsLink", [])
     , ("commentsSection", [])
     , ("dateFormat", [])
     , ("latestLink", [])
-    , ("latestPage", [])
+    , ("latestPage", ["tag"])
-    , ("latestTaggedPage", ["tag"])
     , ("metadata", ["author", "date", "tags"])
+    , ("rssLink", [])
+    , ("rssTitle", ["tag"])
     , ("tagsList", [])
   ]
 
-
 instance ToJSON Wording where
-  toJSON (Wording m) = toJSON (showTemplate <$> m)
+  toJSON (Wording m) = toJSON m
-  toEncoding (Wording m) = toEncoding (showTemplate <$> m)
+  toEncoding (Wording m) = toEncoding m
-
-render :: String -> [(Text, Text)] -> Wording -> Text
-render key env (Wording wMap) =
-  toStrict $ Template.render (wMap ! key) (Map.fromList env !)
 
 addWording :: Map String Text -> FilePath -> IO (Map String Text)
 addWording currentWording wordingFile = do
@@ -65,30 +55,12 @@ wordingP = Map.map Text.pack . Map.fromList <$>
     restOfLine = many $ noneOf "\r\n"
     eol = try (string "\r\n") <|> string "\r" <|> string "\n"
     skip = optional (char '#' *> restOfLine) *> eol
-    line = (,) <$> (choice (try . string <$> Map.keys variables) <* equal) <*> restOfLine
+    varEqual = choice (try . string <$> Map.keys variables) <* equal
+    line = (,) <$> varEqual <*> restOfLine
     equal = many (char ' ') *> char '=' *> many (char ' ')
 
-makeTemplate :: String -> Map String Text -> IO Template
-makeTemplate key wording =
-  let templateText = wording ! key in
-  let testEnvironment = flip lookup [(s, "") | s <- availableVariables] in
-  case templateSafe templateText of
-    Left (row, col) -> die $ syntaxError (show row) (show col)
-    Right template ->
-      maybe (die badTemplate) (return . const template) (renderA template testEnvironment)
-  where
-    availableVariables = variables ! key
-    variablesMessage =
-      " (available variables: " ++ intercalate ", " (Text.unpack <$> availableVariables) ++ ")"
-    syntaxError row col =
-      "Syntax error in template for variable " ++ key ++ "at l." ++ row ++ ", c." ++ col 
-    badTemplate = "Invalid template for variable " ++ key ++ variablesMessage
-
 build :: Arguments -> IO Wording
 build arguments = do
   defaultWording <- getDataFileName "defaultWording.conf"
   let wordingFiles = maybe id (:) (wording arguments) $ [defaultWording]
-  wordindMap <- foldM addWording Map.empty wordingFiles
+  Wording <$> foldM addWording Map.empty wordingFiles
-  Wording <$> foldM (
-      \templated key -> flip (Map.insert key) templated <$> makeTemplate key wordindMap
-    ) Map.empty (Map.keys variables)

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,11 @@ module DOM (
 
 import Article (Article(..))
 import qualified Article (preview)
-import ArticlesList (ArticlesList(..), otherUrl, description)
+import ArticlesList (
-import Blog (Blog(..), Path(..), Skin(..), URL(..))
+    ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
-import qualified Blog (get)
+  )
-import Blog.Wording (render)
+import Blog (Blog(..), Path(..), Skin(..), URL(..), template)
-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,38 +34,45 @@ 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)
+    preview <- Article.preview <$> (asks $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 =
-      otherLink = Blog.get $wording.$(link)
+        toHtml <$> template (if full then "latestLink" else "allLink") []
+      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)
+  url <- absoluteLink . (</> key <.> extension) <$> (asks $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 ()
 defaultBanner = do
   div_ [id_ "header"] (
       a_ [href_ "/"] (
-          h1_ . toHtml =<< Blog.get name
+          h1_ . toHtml =<< asks name
         )
     )
 
@@ -80,18 +87,18 @@ page aPage =
   doctypehtml_ (do
       head_ (do
           meta_ [charset_ "utf-8"]
-          title_ . toHtml =<< Blog.get name
+          title_ . toHtml =<< asks name
           script_ [src_ "/js/remarkable.min.js"] empty
           script_ [src_ "/js/hablo.js"] empty
-          optional faviconLink =<< (Blog.get $skin.$favicon)
+          optional faviconLink =<< (asks $skin.$favicon)
-          optional (Card.make aPage) =<< (Blog.get $urls.$cards)
+          optional (Card.make aPage) =<< (asks $urls.$cards)
-          (Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
+          optional toHtmlRaw =<< (asks $skin.$head)
         )
       body_ (do
-          maybe defaultBanner toHtmlRaw =<< (Blog.get $skin.$banner)
+          maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner)
           div_ [id_ "navigator"] (do
-              h2_ =<< (Blog.get $wording.$(render "tagsList" []).$toHtml)
+              h2_ . toHtml =<< template "tagsList" []
-              ul_ . mapM_ tag . Map.keys =<< Blog.get tags
+              ul_ . mapM_ tag . Map.keys =<< asks tags
             )
           div_ [id_ "contents"] $ content aPage
         )

src/DOM/Card.hs

@@ -9,11 +9,12 @@ module DOM.Card (
 
 import qualified Article (Article(..))
 import ArticlesList (ArticlesList(..))
-import qualified ArticlesList (description, title)
+import qualified ArticlesList (description)
-import Blog (Blog(..), Skin(..))
+import Blog (Blog(..), Renderer, Skin(..))
-import qualified Blog (get)
+import Collection (Collection(..))
+import qualified Collection (title)
 import Control.Applicative ((<|>))
-import Control.Monad.Reader (MonadReader)
+import Control.Monad.Reader (asks)
 import qualified Data.Map as Map (lookup)
 import Data.Text (Text, pack)
 import Lucid (HtmlT, content_, meta_)
@@ -29,7 +30,7 @@ data Card = Card {
   }
 
 class HasCard a where
-  getCard :: MonadReader Blog m => a -> m Card
+  getCard :: Renderer m => a -> m Card
 
 og :: Applicative m => Text -> Text -> HtmlT m ()
 og attribute value =
@@ -38,15 +39,15 @@ og attribute value =
       , content_ value
     ]
 
-make :: (HasCard a, MonadReader Blog m) => a -> String -> HtmlT m ()
+make :: (HasCard a, Renderer m) => a -> String -> HtmlT m ()
 make element siteURL = do
   Card {cardType, description, image, title, urlPath} <- getCard element
   og "url" . pack $ siteURL ++ urlPath
   og "type" cardType
   og "title" $ pack title
   og "description" description
-  maybeImage =<< ((image <|>) <$> (Blog.get $skin.$cardImage))
+  maybeImage =<< ((image <|>) <$> (asks $skin.$cardImage))
-  og "site_name" =<< (Blog.get $name.$pack)
+  og "site_name" =<< (asks $name.$pack)
   where
     maybeImage = maybe (return ()) (og "image" . pack . (siteURL++))
 
@@ -61,18 +62,18 @@ instance HasCard Article.Article where
         , urlPath = "/articles/" ++ title ++ ".html"
       }
     where
-      getDescription = maybe (Blog.get $name.$("A new article on " <>)) return
+      getDescription = maybe (asks $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 {
+  where
-              tagged = tag
+    file bool = if bool then "all" else "index"
-            , full = False
+    path bool = basePath </> file bool <.> "html"
-            , featured = limit articlesFeatured
-          })
-      , (basePath </> "all" <.> "html", ArticlesList {
-              tagged = tag
-            , full = True
-            , featured = articlesFeatured
-          })
-    ]
 
 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/JS.hs

@@ -4,9 +4,8 @@ module JS (
   ) where
 
 import Blog (Blog(..), Path(..))
-import qualified Blog (get)
 import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Reader (ReaderT)
+import Control.Monad.Reader (ReaderT, asks)
 import Data.ByteString.Lazy (
     ByteString, concat, intercalate, fromStrict, readFile, writeFile
   )
@@ -33,7 +32,7 @@ var (varName, content) = concat ["\t", pack varName, " : ", content]
 generateConfig :: FilePath -> ReaderT Blog IO ()
 generateConfig destinationDir = do
   blogJSON <- exportBlog
-  remarkablePath <- Blog.get $path.$remarkableConfig
+  remarkablePath <- asks $path.$remarkableConfig
   liftIO $ do
     remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
     let jsVars = [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
@@ -51,7 +50,7 @@ generateMain destinationDir = do
 
 generate :: ReaderT Blog IO ()
 generate = do
-  destinationDir <- (</> "js") <$> (Blog.get $path.$root)
+  destinationDir <- asks $path.$root.$(</> "js")
   liftIO . createDirectoryIfMissing True $ destinationDir </> "Hablo"
   generateConfig destinationDir
   liftIO $ generateMain destinationDir

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(..), Renderer, 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)
@@ -67,28 +68,24 @@ articleItem siteURL (Article {key, metadata, title}) =
         formatTime defaultTimeLocale rfc822DateFormat
       . posixSecondsToUTCTime . fromIntegral . (read :: String -> Int)
 
-feed :: MonadReader Blog m => String -> ArticlesList -> HtmlT m ()
+feed :: Renderer 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