From 36651ddc38461025ed997054eab9325aa8d905d1 Mon Sep 17 00:00:00 2001 From: Tissevert Date: Sat, 21 Dec 2019 12:50:38 +0100 Subject: [PATCH 1/6] Fix Open Graph cards by adding a new option to provide the site's URL --- CHANGELOG.md | 5 +++ doc/Architectural-choices.md | 4 +- doc/Command-line.md | 20 +++++---- doc/Customizing-your-blog.md | 2 +- doc/Metadata.md | 6 +-- hablo.cabal | 8 ++-- share/js/metadata.js | 4 +- src/Arguments.hs | 6 ++- src/Blog.hs | 7 +++- src/Blog/Path.hs | 10 +---- src/Blog/URL.hs | 28 +++++++++++++ src/{Dom.hs => DOM.hs} | 48 ++++++---------------- src/DOM/Card.hs | 78 ++++++++++++++++++++++++++++++++++++ src/HTML.hs | 2 +- src/JSON.hs | 4 +- 15 files changed, 166 insertions(+), 66 deletions(-) create mode 100644 src/Blog/URL.hs rename src/{Dom.hs => DOM.hs} (65%) create mode 100644 src/DOM/Card.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b66129..52b472b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for hablo +## 1.0.3.0 -- 2019-12-21 + +* Fix OpenGraph cards displayed for links to hablo-generated pages posted on the Fediverse (should work elsewhere too but I don't care and have never tested) +* This fix alas requires to «anchor» the generated website at a given location by means of the new `--site-url` option. OpenGraph cards are just completely disabled if you prefer your website to remain portable. + ## 1.0.2.0 -- 2019-08-27 * Format for [conditional blocks](/Tissevert/hablo/wiki/Template-variables#metadata) changed to allow an internal simplification. This is transparent if you're creating a new blog or using the default wording but be sure to edit your wording if you're using a custom one : diff --git a/doc/Architectural-choices.md b/doc/Architectural-choices.md index ab3806b..c06647c 100644 --- a/doc/Architectural-choices.md +++ b/doc/Architectural-choices.md @@ -24,7 +24,7 @@ Pages include a banner, a navigation `
` with links to the various tags and ### Article pages -Ideally, the markdown files would be enough and there wouldn't be any HTML generated for articles. Unfortunately, in order to share direct links to articles, some HTML is necessary to reach the blog's interface, loading some JS, to handle the navigation and not only display a markdown file. The additional HTML also allows to generate [open-graph](http://ogp.me/) cards to make the links look nicer on [social media](#fediverse). +Ideally, the markdown files would be enough and there wouldn't be any HTML generated for articles. Unfortunately, in order to share direct links to articles, some HTML is necessary to reach the blog's interface, loading some JS, to handle the navigation and not only display a markdown file. The additional HTML also allows to generate [Open Graph](http://ogp.me/) cards to make the links look nicer on [social media](#fediverse). The article pages' content is the body of the markdown file wrapped in a HTML `
` element and its title.
 
@@ -48,6 +48,6 @@ Hablo takes a stand against this. It aims at generating HTML files that are simp
 
 ## Fediverse
 
-Hablo is conceived from the start to interact with the [fediverse](https://fediverse.network/) and social media in general so all pages generated embed a set of basic [open-graph](http://ogp.me/) metadata in their header. This allows links posted on social media to appear in a nice box with a picture, the name of the blog and a short description.
+Hablo is conceived from the start to interact with the [fediverse](https://fediverse.network/) and social media in general. It can embed a set of basic [Open Graph](http://ogp.me/) metadata in the header of all generated pages if you [provide the URL](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#site-url) where your blog will be deployed to hablo. This allows links posted on social media to appear in a nice box with a picture, the name of the blog and a short description.
 
 Also, being static, hablo doesn't handle dynamic things like comments directly. Instead, comments are [toots](https://git.marvid.fr/Tissevert/hablo/wiki/Customizing%20your%20blog#how-do-i-customize-the-templates-) listed on a fediverse instance.
diff --git a/doc/Command-line.md b/doc/Command-line.md
index 217a128..fe57384 100644
--- a/doc/Command-line.md
+++ b/doc/Command-line.md
@@ -48,13 +48,11 @@ hablo --banner /my/set/of/banner/turtles.html /path/to/your/blog
 
 `-c, --card-image`
 
-By default, hablo will try to find the image to use for cards [automatically](https://git.marvid.fr/Tissevert/hablo/src/branch/master/src/Blog/Skin.hs#L36). It will look for a file with the [name](#name) of your blog and the extension `.ico`, `.gif`, `.jpeg`, `.jpg`, `.png` or `.svg` located at the root of the blog or in a directory called `image`, `images`, `pictures`, `skin` or `static`.
+By default, hablo will try to find the image to use for cards [automatically](https://git.marvid.fr/Tissevert/hablo/src/branch/main/src/Blog/Skin.hs#L36). It will look for a file with the [name](#name) of your blog and the extension `.ico`, `.gif`, `.jpeg`, `.jpg`, `.png` or `.svg` located at the root of the blog or in a directory called `image`, `images`, `pictures`, `skin` or `static`.
 
-This option allows you to skip the auto-discover step or to use an image that wouldn't be found with the above method and directly tell hablo what file to use.
+This option allows you to skip the auto-discover step or to use an image that wouldn't be found with the above method and directly tell hablo what file to use. It is of course only relevant if you have [enabled](#site-url) Open Graph cards for your website by providing its deployment URL to hablo. Since it already knows the root URL of your website, this option expects only the local path to the image of course.
 
-Note that not all cards generated for your blog will necessarily contain an image. If none of the expected path for card images exists and you don't provide one with this option, then pages won't embed an [open-graph](http://ogp.me/) picture in their card by default but articles with a [featured image](https://git.marvid.fr/Tissevert/hablo/wiki/Metadata#featured-image) will still do (and the image used for the card will be the featured image of the article).
-
-Card images in themselves are only relevant once your blog is deployed and accessed by a browser or linked to. Hablo only includes a link to them or not, so of course the value of this option must be a relative path within your blog's structure. If you put a file outside, your web server will of course return 404 errors whenever something will read the corresponding header and attempt to access it.
+Note that not all cards generated for your blog will necessarily contain an image. If none of the expected path for card images exists and you don't provide one with this option, then pages won't embed an [Open Graph](http://ogp.me/) picture in their card by default but articles with a [featured image](https://git.marvid.fr/Tissevert/hablo/wiki/Metadata#featured-image) will still do (and the image used for the card will be the featured image of the article).
 
 ```bash
 hablo --card-image skin/defaultCardImage.png
@@ -90,7 +88,7 @@ hablo --favicon skin/eyeOfTheTurtle.jpg
 
 `-H, --head`
 
-The header section of the HTML pages includes several things such as the [open-graph](http://ogp.me/) metadata, the script inclusions for hablo's client code and for its [dependencies](https://git.marvid.fr/Tissevert/hablo/wiki/Deploying%20a%20hablo%20blog).
+The header section of the HTML pages includes several things such as the [Open Graph](http://ogp.me/) metadata, the script inclusions for hablo's client code and for its [dependencies](https://git.marvid.fr/Tissevert/hablo/wiki/Deploying%20a%20hablo%20blog).
 
 Use the `--head` option to add some arbitrary HTML elements to the header of your pages. This is the way to use a CSS theme for your blog, as is shown in the [customization](https://git.marvid.fr/Tissevert/hablo/wiki/Customizing%20your%20blog#how-do-i-use-a-custom-skin-) how-to.
 
@@ -98,7 +96,7 @@ Use the `--head` option to add some arbitrary HTML elements to the header of you
 
 `-n, --name`
 
-Each blog has a name which is used in the default banner of your site and as the title of all pages (displayed in the tab's name and in the window name when your blog's tab is focused). Hablo infers it from the name of the directory containing it. It works on an absolute version the path it receives, so it won't suddenly think your blog is called `..` because you ran
+Each blog has a name which is used in the default banner of your site and as the title of all pages (displayed in the tab's name and in the window name when your blog's tab is focused). Hablo infers it from the name of the directory containing it. It works on an absolute version of the path it receives, so it won't suddenly think your blog is called `..` because you ran
 
 ```bash
 hablo ..
@@ -146,6 +144,14 @@ Hablo uses [remarkable](https://github.com/jonschlinkert/remarkable) to render y
 
 The file is read by hablo when the blog is generated and its content gets included into the client JS code so it can be located absolutely anywhere, even outside your blog's directory.
 
+## Site URL
+
+`-u, --site-url`
+
+To enable Open Graph cards and display a pretty preview of the page instead of the raw URL in links posted to social media, you need to tell Hablo about the URL where the website is going to be deployed. This used to work without but apparently Pleroma no longer considers valid cards with an image path local to the website.
+
+Note that this is purely optional and you don't have to use this option if you don't care about Open Graph cards. They will simply disappear instead of being generated without the absolute URL. This means that option now works as a switch to enable Open Graph cards or not.
+
 ## Wording
 
 `-w, --wording`
diff --git a/doc/Customizing-your-blog.md b/doc/Customizing-your-blog.md
index 717358e..2818987 100644
--- a/doc/Customizing-your-blog.md
+++ b/doc/Customizing-your-blog.md
@@ -104,4 +104,4 @@ Now, when you generate your blog, tell hablo to look for comments on the instanc
 hablo --comments-at https://turtles.social
 ```
 
-Be sure to clear the cache of your web browser before visiting your article again. A «comments» section now shows after your article, with possibly some comments if someone has already answered your post on the fediverse.
+Be sure to clear the cache of your web browser before visiting your article again. A «comments» section now shows after your article, with possibly some comments if someone has already answered your post on the fediverse. Also, please note that, as comments are purely handled by the fediverse so is the moderation : you should preferably use this feature on an instance where you have moderation rights and will be able to delete hateful comments or where you know the moderation team will be able to react appropriately.
diff --git a/doc/Metadata.md b/doc/Metadata.md
index 8eec238..c771ef3 100644
--- a/doc/Metadata.md
+++ b/doc/Metadata.md
@@ -41,11 +41,11 @@ comments: 101781535999718634
 
 Hablo associates to each article the date when it was written or last edited to sort articles chronologically and to display it. Trying to [reuse](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#reuse) as much as possible, this date is by default the «last modified» Unix date of the file that contains the article.
 
-You can override this behaviour by setting a `date` metadata. It can contain a date with an optional time (hour and minute) and a timezone, also optional. If you don't set a timezone the current one will be used. Note that this means that some of your article might seem to have their dates «moving» a bit, if for example you set the date for one of your article (but not the timezone), generate your blog, then travel to a place with a very different timezone, and generate your blog again.
+You can override this behaviour by setting a `date` metadata. It can contain a date with an optional time (hour and minute) and a timezone, also optional. If you don't set a timezone the current one will be used. Note that this means that some of your articles might seem to have their dates «moving» a bit, if for example you set the date for one of your article (but not the timezone), generate your blog, then travel to a place with a very different timezone, and generate your blog again.
 
 ### Featured image
 
-Every article can contain as many pictures as you like, anywhere you like in it. But you can choose one of them (or even one that doesn't appear in your article) to appear in the [open-graph](http://ogp.me/) card of your article, so that it is displayed and «represents» your article when you paste links to it on social media. The exact name of the metadata is `featuredImage`, camel-case, and it expects the site-root relative link of the picture (so the path as seen from your blog by a client accessing it).
+Every article can contain as many pictures as you like, anywhere you like in it. But you can choose one of them (or even one that doesn't appear in your article) to appear in the [Open Graph](http://ogp.me/) card of your article if you've [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#site-url) them, so that it is displayed and «represents» your article when you paste links to it on social media. The exact name of the metadata is `featuredImage`, camel-case, and it expects the site-root relative link of the picture (so the path as seen from your blog by a client accessing it).
 
 ```YAML
 featuredImage: /media/turtles/olive-ridley.jpg
@@ -53,7 +53,7 @@ featuredImage: /media/turtles/olive-ridley.jpg
 
 ### Summary
 
-You can write a short description of your article and use it as the value of its `summary` metadata and this text will be used in the open-graph [description](http://ogp.me/#optional) of the card generated for the article.
+You can write a short description of your article and use it as the value of its `summary` metadata and this text will be used in the Open Graph [description](http://ogp.me/#optional) of the card generated for the article (like above for the featured image, if they're [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#site-url))
 
 ```YAML
 summary: This week, I'm gonna tell you everything about the olive ridley sea turtle !
diff --git a/hablo.cabal b/hablo.cabal
index f1ad46c..b426c5c 100644
--- a/hablo.cabal
+++ b/hablo.cabal
@@ -3,7 +3,7 @@ cabal-version:       >= 1.10
 -- For further documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hablo
-version:             1.0.2.0
+version:             1.0.3.0
 synopsis:            A minimalist static blog generator
 description:
   Hablo is a fediverse-oriented static blog generator for articles written
@@ -35,8 +35,10 @@ executable hablo
                      , Blog
                      , Blog.Path
                      , Blog.Skin
+                     , Blog.URL
                      , Blog.Wording
-                     , Dom
+                     , DOM
+                     , DOM.Card
                      , Files
                      , HTML
                      , JS
@@ -52,7 +54,7 @@ executable hablo
                      , filepath >= 1.4.2 && < 1.5
                      , lucid >= 2.9.11 && < 2.10
                      , mtl >= 2.2.2 && < 2.3
-                     , optparse-applicative >= 0.14.3 && < 0.15
+                     , optparse-applicative >= 0.14.3 && < 0.16
                      , parsec >= 3.1.13 && < 3.2
                      , template >= 0.2.0 && < 0.3
                      , text >= 1.2.3 && < 1.3
diff --git a/share/js/metadata.js b/share/js/metadata.js
index 176d757..c37c2f3 100644
--- a/share/js/metadata.js
+++ b/share/js/metadata.js
@@ -16,7 +16,7 @@ function Metadata(modules) {
 	};
 
 	function url(threadId) {
-		return blog.path.commentsAt + '/api/v1/statuses/' + threadId;
+		return blog.urls.comments + '/api/v1/statuses/' + threadId;
 	}
 
 	function getJSON(url) {
@@ -38,7 +38,7 @@ function Metadata(modules) {
 
 	function getComments(articleKey) {
 		var threadId = blog.articles[articleKey].metadata.comments;
-		if(blog.path.commentsAt != undefined && threadId != undefined) {
+		if(blog.urls.comments != undefined && threadId != undefined) {
 			var ul = modules.dom.make('ul');
 			var div = emptySection(ul);
 			modules.async.run(
diff --git a/src/Arguments.hs b/src/Arguments.hs
index a37dbde..f7b6a4e 100644
--- a/src/Arguments.hs
+++ b/src/Arguments.hs
@@ -16,7 +16,7 @@ data Arguments = BlogConfig {
     , articlesPath :: FilePath
     , bannerPath :: Maybe FilePath
     , cardImage :: Maybe FilePath
-    , commentsAt :: Maybe String
+    , commentsURL :: Maybe String
     , favicon :: Maybe FilePath
     , headPath :: Maybe FilePath
     , name :: Maybe String
@@ -24,6 +24,7 @@ data Arguments = BlogConfig {
     , previewArticlesCount :: Int
     , previewLinesCount :: Int
     , remarkableConfig :: Maybe FilePath
+    , siteURL :: Maybe String
     , wording :: Maybe FilePath
   }
   | Version
@@ -50,7 +51,7 @@ blogConfig = BlogConfig
       )
   <*> option filePath 'b' "banner" "FILE" "path to the file to use for the blog's banner"
   <*> option filePath 'c' "card-image" "FILE" "relative path to the image to use for the blog's card"
-  <*> option filePath 'C' "comments-at" "URL" "url of the instance where comments are stored"
+  <*> option filePath 'C' "comments-url" "URL" "URL of the instance where comments are stored"
   <*> option filePath 'f' "favicon" "FILE" "path to the image to use for the blog's favicon"
   <*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head"
   <*> option str 'n' "name" "BLOG_NAME" "name of the blog"
@@ -72,6 +73,7 @@ blogConfig = BlogConfig
       )
   <*> option filePath 'r' "remarkable-config" "FILE"
         "path to a file containing a custom RemarkableJS configuration"
+  <*> option filePath 'u' "site-url" "URL" "URL where the blog is published"
   <*> option filePath 'w' "wording" "FILE" "path to the file containing the wording to use"
 
 version :: Parser Arguments
diff --git a/src/Blog.hs b/src/Blog.hs
index d7d0b96..a2e6915 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -4,6 +4,7 @@ module Blog (
       Blog(..)
     , Path(..)
     , Skin(..)
+    , URL(..)
     , Wording
     , build
     , get
@@ -17,6 +18,8 @@ import Blog.Path (Path(..))
 import qualified Blog.Path as Path (build)
 import Blog.Skin (Skin(..))
 import qualified Blog.Skin as Skin (build)
+import Blog.URL (URL(..))
+import qualified Blog.URL as URL (build)
 import Blog.Wording (Wording)
 import qualified Blog.Wording as Wording (build)
 import Control.Monad ((>=>), filterM, foldM, forM)
@@ -40,6 +43,7 @@ data Blog = Blog {
     , path :: Path
     , skin :: Skin
     , tags :: Map String (Set String)
+    , urls :: URL
     , wording :: Wording
   }
 
@@ -84,6 +88,7 @@ discover path = do
 
 build :: Arguments -> IO Blog
 build arguments = do
+  urls <- URL.build arguments
   wording <- Wording.build arguments
   root <- Files.absolute . Dir $ Arguments.sourceDir arguments
   withCurrentDirectory root $ do
@@ -92,4 +97,4 @@ build arguments = do
               $ Arguments.name arguments
     skin <- Skin.build name arguments
     (articles, tags) <- discover path
-    return $ Blog {articles, name, path, skin, tags, wording}
+    return $ Blog {articles, name, path, skin, tags, urls, wording}
diff --git a/src/Blog/Path.hs b/src/Blog/Path.hs
index f8ed96f..2bffb48 100644
--- a/src/Blog/Path.hs
+++ b/src/Blog/Path.hs
@@ -15,16 +15,14 @@ import GHC.Generics (Generic)
 
 data Path = Path {
       articlesPath :: FilePath
-    , commentsAt :: Maybe String
     , pagesPath :: Maybe FilePath
     , remarkableConfig :: Maybe FilePath
     , root :: FilePath
   } deriving Generic
 
 instance ToJSON Path where
-  toEncoding (Path {articlesPath, commentsAt, pagesPath}) = pairs (
+  toEncoding (Path {articlesPath, pagesPath}) = pairs (
         "articlesPath" .= articlesPath
-      <> "commentsAt" .= commentsAt
       <> "pagesPath" .= pagesPath
     )
 
@@ -33,8 +31,4 @@ build root arguments = do
   articlesPath <- filePath . Dir $ Arguments.articlesPath arguments
   pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments
   remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments
-  return $ Path {
-      articlesPath, commentsAt, pagesPath, remarkableConfig, root
-    }
-  where
-    commentsAt = Arguments.commentsAt arguments
+  return $ Path {articlesPath, pagesPath, remarkableConfig, root}
diff --git a/src/Blog/URL.hs b/src/Blog/URL.hs
new file mode 100644
index 0000000..4e56d64
--- /dev/null
+++ b/src/Blog/URL.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Blog.URL (
+      URL(..)
+    , build
+  ) where
+
+import Arguments (Arguments)
+import qualified Arguments as Arguments (Arguments(..))
+import Data.Aeson (ToJSON(..), (.=), pairs)
+import GHC.Generics (Generic)
+
+data URL = URL {
+      comments :: Maybe String
+    , site :: Maybe String
+  } deriving Generic
+
+instance ToJSON URL where
+  toEncoding (URL {comments}) = pairs (
+      "comments" .= comments
+    )
+
+build :: Arguments -> IO URL
+build arguments = return $ URL {comments, site}
+  where
+    comments = Arguments.commentsURL arguments
+    site = Arguments.siteURL arguments
diff --git a/src/Dom.hs b/src/DOM.hs
similarity index 65%
rename from src/Dom.hs
rename to src/DOM.hs
index cdbeebc..4955f53 100644
--- a/src/Dom.hs
+++ b/src/DOM.hs
@@ -1,50 +1,35 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Dom (
+module DOM (
     page
   ) where
 
 import Article (Article(..))
 import qualified Article (preview)
 import ArticlesList (ArticlesList(..), otherUrl, pageTitle)
-import Blog (Blog(..), Path(..), Skin(..))
+import Blog (Blog(..), Path(..), Skin(..), URL(..))
 import qualified Blog (get)
 import Blog.Wording (render)
-import Control.Applicative ((<|>))
 import Control.Monad.Reader (ReaderT)
-import qualified Data.Map as Map (keys, lookup)
-import Data.Monoid ((<>))
-import Data.Text (Text, pack, empty)
+import qualified Data.Map as Map (keys)
+import Data.Text (pack, empty)
+import DOM.Card (HasCard)
+import qualified DOM.Card as Card (make)
 import Files (absoluteLink)
 import Lucid
-import Lucid.Base (makeAttribute)
 import Prelude hiding (head, lookup)
 import Pretty ((.$))
 import System.FilePath.Posix ((), (<.>))
 
 type HtmlGenerator = HtmlT (ReaderT Blog IO)
 
-class Page a where
-  card :: a -> HtmlGenerator ()
+class HasCard a => Page a where
   content :: a -> HtmlGenerator ()
 
 instance Page Article where
-  card (Article {title, Article.metadata}) = do
-    description <- getDescription (Map.lookup "summary" metadata)
-    makeCard title (pack description) (Map.lookup "featuredImage" metadata)
-    where
-      getDescription = maybe (Blog.get $name.$("A new article on " <>)) return
-
   content = article True
 
 instance Page ArticlesList where
-  card al = do
-    cardTitle <- getTitle <$> Blog.get name
-    description <- pageTitle al
-    makeCard cardTitle description Nothing
-    where
-      getTitle name = maybe name ((name ++ " - ") ++) $ tagged al
-
   content al@(ArticlesList {featured, full}) = do
     preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
     h2_ . toHtml =<< pageTitle al
@@ -57,7 +42,7 @@ instance Page ArticlesList where
       otherLink = Blog.get $wording.$(link)
 
 article :: Bool -> Article -> HtmlGenerator ()
-article raw (Article {key, body, title}) = do
+article raw (Article {key, body, Article.title}) = do
   url <- absoluteLink . ( key <.> extension) <$> (Blog.get $path.$articlesPath)
   article_ [id_ $ pack key] (do
       header_ (do
@@ -67,16 +52,6 @@ article raw (Article {key, body, title}) = do
     )
   where extension = if raw then "md" else "html"
 
-makeCard :: String -> Text -> Maybe String -> HtmlGenerator ()
-makeCard title description image = do
-  og "title" $ pack title
-  og "description" description
-  maybeImage =<< ((image <|>) <$> (Blog.get $skin.$cardImage))
-  og "site_name" =<< (Blog.get $name.$pack)
-  where
-    og attribute value = meta_ [makeAttribute "property" $ "og:" <> attribute , content_ value]
-    maybeImage = maybe (return ()) (og "image" . pack)
-
 tag :: String -> HtmlGenerator ()
 tag tagName = li_ (
     a_ [href_ . pack $ absoluteLink tagName, class_ "tag"] $ toHtml tagName
@@ -93,6 +68,9 @@ defaultBanner = do
 faviconLink :: FilePath -> HtmlGenerator ()
 faviconLink url = link_ [rel_ "shortcut icon", href_ $ pack url, type_ "image/x-icon"]
 
+optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator ()
+optional = maybe (return ()) 
+
 page :: Page a => a -> HtmlGenerator ()
 page aPage =
   doctypehtml_ (do
@@ -102,8 +80,8 @@ page aPage =
           script_ [src_ "/js/unit.js"] empty
           script_ [src_ "/js/remarkable.min.js"] empty
           script_ [src_ "/js/hablo.js"] empty
-          maybe (toHtml empty) faviconLink =<< (Blog.get $skin.$favicon)
-          card aPage
+          optional faviconLink =<< (Blog.get $skin.$favicon)
+          optional (Card.make aPage) =<< (Blog.get $urls.$site)
           (Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
         )
       body_ (do
diff --git a/src/DOM/Card.hs b/src/DOM/Card.hs
new file mode 100644
index 0000000..b84a598
--- /dev/null
+++ b/src/DOM/Card.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+module DOM.Card (
+      Card(..)
+    , HasCard(..)
+    , make
+  ) where
+
+import qualified Article (Article(..))
+import ArticlesList (ArticlesList(..), pageTitle)
+import Blog (Blog(..), Skin(..))
+import qualified Blog (get)
+import Control.Applicative ((<|>))
+import Control.Monad.Reader (MonadReader)
+import qualified Data.Map as Map (lookup)
+import Data.Text (Text, pack)
+import Lucid (HtmlT, content_, meta_)
+import Lucid.Base (makeAttribute)
+import Pretty ((.$))
+
+data Card = Card {
+      cardType :: Text
+    , description :: Text
+    , image :: Maybe String
+    , title :: String
+    , urlPath :: String
+  }
+
+class HasCard a where
+  getCard :: MonadReader Blog m => a -> m Card
+
+og :: Applicative m => Text -> Text -> HtmlT m ()
+og attribute value =
+  meta_ [
+        makeAttribute "property" $ "og:" <> attribute
+      , content_ value
+    ]
+
+make :: (HasCard a, MonadReader Blog 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))
+  og "site_name" =<< (Blog.get $name.$pack)
+  where
+    maybeImage = maybe (return ()) (og "image" . pack . (siteURL++))
+
+instance HasCard Article.Article where
+  getCard (Article.Article {Article.title, Article.metadata}) = do
+    description <- pack <$> getDescription (Map.lookup "summary" metadata)
+    return $ Card {
+          cardType = "article"
+        , description
+        , image = (Map.lookup "featuredImage" metadata)
+        , DOM.Card.title
+        , urlPath = "/articles/" ++ title ++ ".html"
+      }
+    where
+      getDescription = maybe (Blog.get $name.$("A new article on " <>)) return
+
+instance HasCard ArticlesList where
+  getCard al = do
+    cardTitle <- getTitle <$> Blog.get name
+    description <- pageTitle al
+    return $ Card {
+          cardType = "website"
+        , description
+        , image = Nothing
+        , DOM.Card.title = cardTitle
+        , urlPath = maybe "" ('/':) (tagged al) ++ file
+      }
+    where
+      getTitle name = maybe name ((name ++ " - ") ++) $ tagged al
+      file = '/' : (if full al then "all" else "index") ++ ".html"
diff --git a/src/HTML.hs b/src/HTML.hs
index 8a35c9e..ea1d90f 100644
--- a/src/HTML.hs
+++ b/src/HTML.hs
@@ -17,7 +17,7 @@ import qualified Data.Map as Map (elems, filterWithKey, toList)
 import Data.Ord (Down(..))
 import qualified Data.Set as Set (member)
 import qualified Data.Text.Lazy.IO as TextIO (writeFile)
-import Dom (page)
+import DOM (page)
 import Lucid
 import Pretty ((.$))
 import System.Directory (createDirectoryIfMissing)
diff --git a/src/JSON.hs b/src/JSON.hs
index 3522cab..4b8b5bd 100644
--- a/src/JSON.hs
+++ b/src/JSON.hs
@@ -6,7 +6,7 @@ module JSON (
 
 import Article (Article)
 import qualified Article (Article(..))
-import Blog (Blog, Path, Skin, Wording)
+import Blog (Blog, Path, Skin, URL, Wording)
 import qualified Blog (Blog(..))
 import Control.Monad.Reader (ReaderT, ask)
 import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
@@ -31,6 +31,7 @@ data BlogDB = BlogDB {
     , path :: Path
     , skin :: Skin
     , tags :: Map String [String]
+    , urls :: URL
     , wording :: Wording
   } deriving (Generic)
 
@@ -53,5 +54,6 @@ exportBlog = do
       , path = Blog.path blog
       , skin = Blog.skin blog
       , tags = Set.elems <$> Blog.tags blog
+      , urls = Blog.urls blog
       , wording = Blog.wording blog
     }

From add68897ad52e0b91293652579b6459d01351b49 Mon Sep 17 00:00:00 2001
From: Tissevert 
Date: Fri, 10 Jan 2020 18:56:59 +0100
Subject: [PATCH 2/6] Adapt hablo's JS to SJW and stop requiring unitJS
 separately (since it's gonna get pulled in by sjw at compile time)

---
 share/js/DomRenderer.js |  98 +++++++++++++++++++++++++
 share/js/Main.js        |   5 ++
 share/js/Metadata.js    | 157 ++++++++++++++++++++++++++++++++++++++++
 share/js/Navigation.js  | 117 ++++++++++++++++++++++++++++++
 share/js/Remarkable.js  |   8 ++
 share/js/Template.js    |  33 +++++++++
 share/js/domRenderer.js |  94 ------------------------
 share/js/main.js        |  14 ----
 share/js/metadata.js    | 155 ---------------------------------------
 share/js/navigation.js  | 117 ------------------------------
 share/js/template.js    |  35 ---------
 src/DOM.hs              |   1 -
 12 files changed, 418 insertions(+), 416 deletions(-)
 create mode 100644 share/js/DomRenderer.js
 create mode 100644 share/js/Main.js
 create mode 100644 share/js/Metadata.js
 create mode 100644 share/js/Navigation.js
 create mode 100644 share/js/Remarkable.js
 create mode 100644 share/js/Template.js
 delete mode 100644 share/js/domRenderer.js
 delete mode 100644 share/js/main.js
 delete mode 100644 share/js/metadata.js
 delete mode 100644 share/js/navigation.js
 delete mode 100644 share/js/template.js

diff --git a/share/js/DomRenderer.js b/share/js/DomRenderer.js
new file mode 100644
index 0000000..465bc2f
--- /dev/null
+++ b/share/js/DomRenderer.js
@@ -0,0 +1,98 @@
+import * as Dom from UnitJS.Dom;
+import * as Fun from UnitJS.Fun;
+import Metadata;
+import Template;
+import Remarkable;
+
+return {
+  article: article,
+  articlesList: articlesList,
+  replaceMarkdown: replaceMarkdown
+};
+
+function replaceMarkdown() {
+  var div = document.getElementById('contents');
+  if(div.children[0] && div.children[0].tagName.toLowerCase() == 'article') {
+    convertArticle(div.children[0], true);
+  } else {
+    var articles = div.getElementsByClassName('articles')[0];
+    if(articles != undefined) {
+      for(var i = 0; i < articles.children.length; i++) {
+        convertArticle(articles.children[i]);
+      }
+    } else {
+      console.log('No articles found for this page');
+    }
+  }
+}
+
+function convertArticle(article, comments) {
+  var header = article.getElementsByTagName('header')[0];
+  header.appendChild(Metadata.get(article.id));
+  var text = article.getElementsByTagName('pre')[0];
+  if(text != undefined) {
+    article.replaceChild(getDiv(text.innerText), text);
+    if(comments) {
+      Metadata.getComments(article.id)
+        .forEach(article.appendChild.bind(article));
+    }
+  } else {
+    console.log('No content found for this article');
+  }
+}
+
+function getDiv(markdown) {
+  var d= Dom.make('div', {
+    innerHTML: Remarkable.md.render(markdown)
+  });
+  var scripts = d.getElementsByTagName('script');
+  for(var i = 0; i < scripts.length; i++) {
+    var run = Dom.make('script',
+      {type: 'text/javascript', src: scripts[i].src, textContent: scripts[i].textContent}
+    );
+    scripts[i].parentNode.replaceChild(run, scripts[i]);
+  }
+  return d;
+}
+
+function article(key, markdown, limit) {
+  var url = ["", blog.path.articlesPath, key + (limit != undefined ? '.html' : '.md')].join('/');
+  var lines = markdown.split(/\n/).slice(blog.articles[key].bodyOffset);
+  var div = getDiv(lines.slice(0, limit).join('\n'));
+  return Dom.make('article', {}, [
+    Dom.make('header', {}, [
+      Dom.make('a', {href: url}, [
+        Dom.make('h1', {innerText: blog.articles[key].title})
+      ]),
+      Metadata.get(key)
+    ]),
+    div
+  ].concat(limit != undefined ? [] : Metadata.getComments(key)));
+}
+
+function pageTitle(tag, all) {
+  if(tag != undefined) {
+    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'];
+  return '/' + path.filter(Fun.defined).join('/');
+}
+
+function articlesList(tag, all) {
+  return function(articlePreviews) {
+    return [
+      Dom.make('h2', {innerText: pageTitle(tag, all)}),
+      Dom.make('a', {
+        innerText: all ? blog.wording.latestLink : blog.wording.allLink,
+        href: otherUrl(tag, all)
+      }),
+      Dom.make('div', {class: 'articles'}, articlePreviews.filter(Fun.defined))
+    ];
+  };
+}
diff --git a/share/js/Main.js b/share/js/Main.js
new file mode 100644
index 0000000..4384422
--- /dev/null
+++ b/share/js/Main.js
@@ -0,0 +1,5 @@
+import replaceMarkdown from DomRenderer;
+import hijackLinks from Navigation;
+
+replaceMarkdown();
+hijackLinks();
diff --git a/share/js/Metadata.js b/share/js/Metadata.js
new file mode 100644
index 0000000..bec1b72
--- /dev/null
+++ b/share/js/Metadata.js
@@ -0,0 +1,157 @@
+import * as Async from UnitJS.Async;
+import * as Cache from UnitJS.Cache;
+import * as Dom from UnitJS.Dom;
+
+var comments = Cache.make(function(threadId) {
+  return Async.bind(
+    Async.parallel(
+      getJSON(url(threadId)),
+      getJSON(url(threadId) + '/context'),
+    ),
+    Async.map(function(t) {
+      return [renderLink(t[0]), renderAnswers(t[1])];
+    })
+  );
+});
+return {
+  get: get,
+  getComments: getComments
+};
+
+function url(threadId) {
+  return blog.urls.comments + '/api/v1/statuses/' + threadId;
+}
+
+function getJSON(url) {
+  return Async.bind(
+    Async.http({method: 'GET', url: url}),
+    function(queryResult) {
+      if(queryResult.status == 200) {
+        try {
+          return Async.wrap(JSON.parse(queryResult.responseText));
+        } catch(e) {
+          return Async.fail('Server returned invalid JSON for ' + url);
+        }
+      } else {
+        return Async.fail('Could not load page ' + url);
+      }
+    }
+  );
+}
+
+function getComments(articleKey) {
+  var threadId = blog.articles[articleKey].metadata.comments;
+  if(blog.urls.comments != undefined && threadId != undefined) {
+    var ul = Dom.make('ul');
+    var div = emptySection(ul);
+    Async.run(
+      Async.bind(
+        comments.get(threadId), Async.map(populateComments(div, ul))
+      )
+    );
+    return [div];
+  } else {
+    return [];
+  }
+}
+
+function populateComments(div, ul) {
+  return function(apiResults) {
+    var post = apiResults[0], comments = apiResults[1];
+    div.appendChild(post);
+    comments.forEach(function(comment) {ul.appendChild(comment);});
+  };
+}
+
+function emptySection(ul) {
+  return Dom.make('div', {class: 'comments'}, [
+    Dom.make('h2', {innerText: blog.wording.commentsSection}),
+    ul
+  ]);
+}
+
+function renderLink(post) {
+  return Dom.make('a', {
+    href: post.url,
+    innerText: blog.wording.commentsLink
+  });
+}
+
+function getContent(descendant) {
+  return descendant.content.replace(/:([^: ]+):/g, function(pattern, shortcode) {
+    var emoji = descendant.emojis.find(function(e) {return e.shortcode == shortcode;});
+    if(emoji) {
+      return [
+        ', shortcode, '
+      ].join('"');
+    } else {
+      return pattern;
+    }
+  });
+}
+
+function renderAnswers(comments) {
+  return comments.descendants.map(function(descendant) {
+    return Dom.make('li', {}, [
+      Dom.make('a', {href: descendant.account.url}, [
+        Dom.make('img', {
+          src: descendant.account.avatar,
+          alt: descendant.account.username + "'s profile picture"
+        })
+      ]),
+      Dom.make('div', {
+        class: "metadata",
+        innerHTML: modules.template.render('metadata', {
+          author: author(descendant.account.url, descendant.account.username),
+          date: date(descendant.created_at)
+        })
+      }),
+      Dom.make('div', {innerHTML: getContent(descendant)})
+    ]);
+  });
+}
+
+function author(key, name) {
+  var authorUrl = key;
+  if(blog.articles[key] != undefined) {
+    authorUrl = blog.articles[key].metadata.author;
+  }
+  if(authorUrl) {
+    var author = name || authorUrl.replace(/.*\//, '');
+      return '' + author + '';
+    }
+}
+
+function date(key) {
+  if(blog.articles[key] != undefined) {
+    var date = new Date(blog.articles[key].metadata.date * 1000);
+  } else {
+    var date = new Date(key);
+  }
+  var format = blog.wording.dateFormat;
+  if(format[0] != '[') {
+    if(format[0] != '"') {
+      format = '"' + format + '"';
+    }
+    format = '[' + format + ']';
+  }
+  return Date.prototype.toLocaleDateString.apply(date, JSON.parse(format));
+}
+
+function tags(key) {
+  var tags = blog.articles[key].tagged;
+  return tags.length < 1 ? null : tags.map(function(tag) {
+    return '' + tag + '';
+  }).join(', ');
+}
+
+function get(key) {
+  return Dom.make('div', {
+    class: "metadata",
+    innerHTML: modules.template.render('metadata', {
+      author: author(key),
+      date: date(key),
+      tags: tags(key)
+    })
+  });
+}
diff --git a/share/js/Navigation.js b/share/js/Navigation.js
new file mode 100644
index 0000000..7b0c7f3
--- /dev/null
+++ b/share/js/Navigation.js
@@ -0,0 +1,117 @@
+import * as Async from UnitJS.Async;
+import * as Cache from UnitJS.Cache;
+import * as Dom from UnitJS.Dom;
+import * as Fun from UnitJS.Fun;
+import {article, articlesList} from DomRenderer;
+
+var articles = Cache.make(function(key) {
+  var url = ["", blog.path.articlesPath, key + '.md'].join('/');
+  return Async.bind(
+    Async.http({method: 'GET', url: url}),
+    function(queryResult) {
+      if(queryResult.status == 200) {
+        return Async.wrap(queryResult.responseText);
+      } else {
+        return Async.fail(
+          "Could not load article " + url + " (" + queryResult.status + " " + queryResult.statusText + ")"
+        );
+      }
+    }
+  );
+});
+window.addEventListener('popstate', function(e) {
+  if(e.state != undefined) {
+    navigate(e.state.url);
+  }
+});
+history.replaceState({url: window.location.pathname}, 'Blog - title', window.location.pathname);
+return {
+  hijackLinks: hijackLinks
+};
+
+function hijackLinks(domElem) {
+  domElem = domElem || document;
+  var links = domElem.getElementsByTagName('a');
+  for(var i = 0; i < links.length; i++) {
+    var a = links[i];
+    var href = a.getAttribute("href");
+    if((href[0] == "/" && href.slice(-3) != ".md") || href[0] == "#") {
+      a.addEventListener('click', visit(a.getAttribute("href")));
+    }
+  }
+}
+
+function visit(url) {
+  return function(e) {
+    e.preventDefault();
+    if(url[0] == '#') {
+      window.location = url;
+      history.replaceState({url: window.location.pathname}, 'Blog - title', url);
+    } else {
+      navigate(url);
+      history.pushState({url: url}, 'Blog - title', url);
+    }
+  };
+}
+
+function navigate(url) {
+  var path = decodeURI(url).split("/").slice(1);
+  if(blog.tags[path[0]] != undefined) {
+    show(getArticlesList(path[0], path[1] == "all.html"));
+  } else if(path[0] == blog.path.articlesPath) {
+    show(getArticle(path[1].replace(/\.html$/, '')));
+  } else {
+    show(getArticlesList(null, path[0] == "all.html"));
+  }
+}
+
+function getArticle(key) {
+  return Async.bind(
+    articles.get(key),
+    Async.map(
+      function(contents) {return [article(key, contents)];}
+    )
+  );
+}
+
+function preview(key) {
+  return Async.bind(
+    articles.get(key),
+    function(contents) {
+      return Async.wrap(
+        article(key, contents, blog.skin.previewLinesCount)
+      );
+    }
+  );
+}
+
+function articleIds(tag, all) {
+  var ids = tag != undefined ? blog.tags[tag] : Object.keys(blog.articles);
+  var reverseDate = function (id) {return -blog.articles[id].metadata.date;};
+  ids.sort(Fun.compare(reverseDate));
+  return ids.slice(0, all ? undefined : blog.skin.previewArticlesCount);
+}
+
+function getArticlesList(tag, all) {
+  return Async.bind(
+    Async.parallel.apply(null, articleIds(tag, all).map(preview)),
+    Async.map(articlesList(tag, all))
+  );
+}
+
+function show(contents) {
+  Async.run(
+    Async.bind(
+      contents,
+      Async.map(function (domElems) {
+        domElems = domElems.filter(Fun.defined);
+        var div = document.getElementById('contents');
+        Dom.clear(div);
+        for(var i = 0; i < domElems.length; i++) {
+          div.appendChild(domElems[i]);
+        }
+        hijackLinks(div);
+      })
+    )
+  );
+}
diff --git a/share/js/Remarkable.js b/share/js/Remarkable.js
new file mode 100644
index 0000000..d5e6125
--- /dev/null
+++ b/share/js/Remarkable.js
@@ -0,0 +1,8 @@
+import remarkableConfig from Hablo.Config;
+
+var md = new Remarkable(remarkableConfig);
+md.block.ruler.enable(['footnote']);
+
+return {
+  md: md
+};
diff --git a/share/js/Template.js b/share/js/Template.js
new file mode 100644
index 0000000..f13cecd
--- /dev/null
+++ b/share/js/Template.js
@@ -0,0 +1,33 @@
+return {
+  render: render
+};
+
+function render(template, environment) {
+  if(blog.wording[template] != undefined) {
+    var template = blog.wording[template];
+  }
+  template = template.replace(/{\?((?:[^?]|\?[^}])*)\?}/g, renderSub(environment));
+  var failed = [false];
+  var result = template.replace(
+    /([^$]|^)\$(?:{(\w+)}|(\w+)\b)/g,
+    substitute(environment, failed)
+  );
+  return failed[0] ? null : result;
+}
+
+function renderSub(environment) {
+  return function(_, sub) {
+    return render(sub, environment) || '';
+  };
+}
+
+function substitute(environment, failed) {
+  return function(_, before, bracketed, raw) {
+    var replaced = environment[bracketed || raw];
+    if(replaced != undefined) {
+      return before + replaced;
+    } else {
+      failed[0] = true;
+    }
+  }
+}
diff --git a/share/js/domRenderer.js b/share/js/domRenderer.js
deleted file mode 100644
index aa4a57b..0000000
--- a/share/js/domRenderer.js
+++ /dev/null
@@ -1,94 +0,0 @@
-function DomRenderer(modules) {
-	return {
-		article: article,
-		articlesList: articlesList,
-		replaceMarkdown: replaceMarkdown
-	};
-
-	function replaceMarkdown() {
-		var div = document.getElementById('contents');
-		if(div.children[0] && div.children[0].tagName.toLowerCase() == 'article') {
-			convertArticle(div.children[0], true);
-		} else {
-			var articles = div.getElementsByClassName('articles')[0];
-			if(articles != undefined) {
-				for(var i = 0; i < articles.children.length; i++) {
-					convertArticle(articles.children[i]);
-				}
-			} else {
-				console.log('No articles found for this page');
-			}
-		}
-	}
-
-	function convertArticle(article, comments) {
-		var header = article.getElementsByTagName('header')[0];
-		header.appendChild(modules.metadata.get(article.id));
-		var text = article.getElementsByTagName('pre')[0];
-		if(text != undefined) {
-			article.replaceChild(getDiv(text.innerText), text);
-			if(comments) {
-				modules.metadata.getComments(article.id)
-					.forEach(article.appendChild.bind(article));
-			}
-		} else {
-			console.log('No content found for this article');
-		}
-	}
-
-	function getDiv(markdown) {
-		var d= modules.dom.make('div', {
-			innerHTML: modules.md.render(markdown)
-		});
-		var scripts = d.getElementsByTagName('script');
-		for(var i = 0; i < scripts.length; i++) {
-			var run = modules.dom.make('script',
-				{type: 'text/javascript', src: scripts[i].src, textContent: scripts[i].textContent}
-			);
-			scripts[i].parentNode.replaceChild(run, scripts[i]);
-		}
-		return d;
-	}
-
-	function article(key, markdown, limit) {
-		var url = ["", blog.path.articlesPath, key + (limit != undefined ? '.html' : '.md')].join('/');
-		var lines = markdown.split(/\n/).slice(blog.articles[key].bodyOffset);
-		var div = getDiv(lines.slice(0, limit).join('\n'));
-		return modules.dom.make('article', {}, [
-			modules.dom.make('header', {}, [
-				modules.dom.make('a', {href: url}, [
-					modules.dom.make('h1', {innerText: blog.articles[key].title})
-				]),
-				modules.metadata.get(key)
-			]),
-			div
-		].concat(limit != undefined ? [] : modules.metadata.getComments(key)));
-	}
-
-	function pageTitle(tag, all) {
-		if(tag != undefined) {
-			var template = all ? 'allTaggedPage' : 'latestTaggedPage';
-			return modules.template.render(template, {tag: tag});
-		} else {
-			return blog.wording[all ? 'allPage' : 'latestPage'];
-		}
-	}
-
-	function otherUrl(tag, all) {
-		var path = [tag, all ? null : 'all.html'];
-		return '/' + path.filter(modules.fun.defined).join('/');
-	}
-
-	function articlesList(tag, all) {
-		return function(articlePreviews) {
-			return [
-				modules.dom.make('h2', {innerText: pageTitle(tag, all)}),
-				modules.dom.make('a', {
-					innerText: all ? blog.wording.latestLink : blog.wording.allLink,
-					href: otherUrl(tag, all)
-				}),
-				modules.dom.make('div', {class: 'articles'}, articlePreviews.filter(modules.fun.defined))
-			];
-		};
-	}
-}
diff --git a/share/js/main.js b/share/js/main.js
deleted file mode 100644
index d9fd9d1..0000000
--- a/share/js/main.js
+++ /dev/null
@@ -1,14 +0,0 @@
-window.addEventListener('load', function() {
-	var async = unitJS.Async();
-	var cache = unitJS.Cache();
-	var dom = unitJS.Dom();
-	var fun = unitJS.Fun();
-	var md = new Remarkable(remarkableConfig);
-	md.block.ruler.enable(['footnote']);
-	var template = Template();
-	var metadata = Metadata({async: async, cache: cache, dom: dom, fun:fun, template: template});
-	var domRenderer = DomRenderer({dom: dom, fun: fun, md: md, metadata: metadata, template: template});
-	var navigation = Navigation({async: async, cache: cache, dom: dom, domRenderer: domRenderer, fun: fun, md: md});
-	domRenderer.replaceMarkdown();
-	navigation.hijackLinks();
-});
diff --git a/share/js/metadata.js b/share/js/metadata.js
deleted file mode 100644
index c37c2f3..0000000
--- a/share/js/metadata.js
+++ /dev/null
@@ -1,155 +0,0 @@
-function Metadata(modules) {
-	var comments = modules.cache.make(function(threadId) {
-		return modules.async.bind(
-			modules.async.parallel(
-				getJSON(url(threadId)),
-				getJSON(url(threadId) + '/context'),
-			),
-			modules.async.map(function(t) {
-				return [renderLink(t[0]), renderAnswers(t[1])];
-			})
-		);
-	});
-	return {
-		get: get,
-		getComments: getComments
-	};
-
-	function url(threadId) {
-		return blog.urls.comments + '/api/v1/statuses/' + threadId;
-	}
-
-	function getJSON(url) {
-		return modules.async.bind(
-			modules.async.http({method: 'GET', url: url}),
-			function(queryResult) {
-				if(queryResult.status == 200) {
-					try {
-						return modules.async.wrap(JSON.parse(queryResult.responseText));
-					} catch(e) {
-						return modules.async.fail('Server returned invalid JSON for ' + url);
-					}
-				} else {
-					return modules.async.fail('Could not load page ' + url);
-				}
-			}
-		);
-	}
-
-	function getComments(articleKey) {
-		var threadId = blog.articles[articleKey].metadata.comments;
-		if(blog.urls.comments != undefined && threadId != undefined) {
-			var ul = modules.dom.make('ul');
-			var div = emptySection(ul);
-			modules.async.run(
-				modules.async.bind(
-					comments.get(threadId), modules.async.map(populateComments(div, ul))
-				)
-			);
-			return [div];
-		} else {
-			return [];
-		}
-	}
-
-	function populateComments(div, ul) {
-		return function(apiResults) {
-			var post = apiResults[0], comments = apiResults[1];
-			div.appendChild(post);
-			comments.forEach(function(comment) {ul.appendChild(comment);});
-		};
-	}
-
-	function emptySection(ul) {
-		return modules.dom.make('div', {class: 'comments'}, [
-			modules.dom.make('h2', {innerText: blog.wording.commentsSection}),
-			ul
-		]);
-	}
-
-	function renderLink(post) {
-		return modules.dom.make('a', {
-			href: post.url,
-			innerText: blog.wording.commentsLink
-		});
-	}
-
-	function getContent(descendant) {
-		return descendant.content.replace(/:([^: ]+):/g, function(pattern, shortcode) {
-			var emoji = descendant.emojis.find(function(e) {return e.shortcode == shortcode;});
-			if(emoji) {
-				return [
-					', shortcode, '
-				].join('"');
-			} else {
-				return pattern;
-			}
-		});
-	}
-
-	function renderAnswers(comments) {
-		return comments.descendants.map(function(descendant) {
-			return modules.dom.make('li', {}, [
-				modules.dom.make('a', {href: descendant.account.url}, [
-					modules.dom.make('img', {
-						src: descendant.account.avatar,
-						alt: descendant.account.username + "'s profile picture"
-					})
-				]),
-				modules.dom.make('div', {
-					class: "metadata",
-					innerHTML: modules.template.render('metadata', {
-						author: author(descendant.account.url, descendant.account.username),
-						date: date(descendant.created_at)
-					})
-				}),
-				modules.dom.make('div', {innerHTML: getContent(descendant)})
-			]);
-		});
-	}
-
-	function author(key, name) {
-		var authorUrl = key;
-		if(blog.articles[key] != undefined) {
-			authorUrl = blog.articles[key].metadata.author;
-		}
-		if(authorUrl) {
-			var author = name || authorUrl.replace(/.*\//, '');
-				return '' + author + '';
-			}
-	}
-
-	function date(key) {
-		if(blog.articles[key] != undefined) {
-			var date = new Date(blog.articles[key].metadata.date * 1000);
-		} else {
-			var date = new Date(key);
-		}
-		var format = blog.wording.dateFormat;
-		if(format[0] != '[') {
-			if(format[0] != '"') {
-				format = '"' + format + '"';
-			}
-			format = '[' + format + ']';
-		}
-		return Date.prototype.toLocaleDateString.apply(date, JSON.parse(format));
-	}
-
-	function tags(key) {
-		var tags = blog.articles[key].tagged;
-		return tags.length < 1 ? null : tags.map(function(tag) {
-			return '' + tag + '';
-		}).join(', ');
-	}
-
-	function get(key) {
-		return modules.dom.make('div', {
-			class: "metadata",
-			innerHTML: modules.template.render('metadata', {
-				author: author(key),
-				date: date(key),
-				tags: tags(key)
-			})
-		});
-	}
-}
diff --git a/share/js/navigation.js b/share/js/navigation.js
deleted file mode 100644
index b48c34e..0000000
--- a/share/js/navigation.js
+++ /dev/null
@@ -1,117 +0,0 @@
-function Navigation(modules) {
-	var articles = modules.cache.make(function(key) {
-		var url = ["", blog.path.articlesPath, key + '.md'].join('/');
-		return modules.async.bind(
-			modules.async.http({method: 'GET', url: url}),
-			function(queryResult) {
-				if(queryResult.status == 200) {
-					return modules.async.wrap(queryResult.responseText);
-				} else {
-					return modules.async.fail(
-						"Could not load article " + url + " (" + queryResult.status + " " + queryResult.statusText + ")"
-					);
-				}
-			}
-		);
-	});
-	window.addEventListener('popstate', function(e) {
-		if(e.state != undefined) {
-			navigate(e.state.url);
-		}
-	});
-	history.replaceState({url: window.location.pathname}, 'Blog - title', window.location.pathname);
-	return {
-		hijackLinks: hijackLinks
-	};
-
-	function hijackLinks(domElem) {
-		domElem = domElem || document;
-		var links = domElem.getElementsByTagName('a');
-		for(var i = 0; i < links.length; i++) {
-			var a = links[i];
-			var href = a.getAttribute("href");
-			if((href[0] == "/" && href.slice(-3) != ".md") || href[0] == "#") {
-				a.addEventListener('click', visit(a.getAttribute("href")));
-			}
-		}
-	}
-
-	function visit(url) {
-		return function(e) {
-			e.preventDefault();
-			if(url[0] == '#') {
-				window.location = url;
-				history.replaceState({url: window.location.pathname}, 'Blog - title', url);
-			} else {
-				navigate(url);
-				history.pushState({url: url}, 'Blog - title', url);
-			}
-		};
-	}
-
-	function navigate(url) {
-		var path = decodeURI(url).split("/").slice(1);
-		if(blog.tags[path[0]] != undefined) {
-			show(getArticlesList(path[0], path[1] == "all.html"));
-		} else if(path[0] == blog.path.articlesPath) {
-			show(getArticle(path[1].replace(/\.html$/, '')));
-		} else {
-			show(getArticlesList(null, path[0] == "all.html"));
-		}
-	}
-
-	function getArticle(key) {
-		return modules.async.bind(
-			articles.get(key),
-			modules.async.map(
-				function(contents) {return [modules.domRenderer.article(key, contents)];}
-			)
-		);
-	}
-
-	function preview(key) {
-		return modules.async.bind(
-			articles.get(key),
-			function(contents) {
-				return modules.async.wrap(
-					modules.domRenderer.article(
-						key,
-						contents,
-						blog.skin.previewLinesCount
-					)
-				);
-			}
-		);
-	}
-
-	function articleIds(tag, all) {
-		var ids = tag != undefined ? blog.tags[tag] : Object.keys(blog.articles);
-		var reverseDate = function (id) {return -blog.articles[id].metadata.date;};
-		ids.sort(modules.fun.compare(reverseDate));
-		return ids.slice(0, all ? undefined : blog.skin.previewArticlesCount);
-	}
-
-	function getArticlesList(tag, all) {
-		return modules.async.bind(
-			modules.async.parallel.apply(null, articleIds(tag, all).map(preview)),
-			modules.async.map(modules.domRenderer.articlesList(tag, all))
-		);
-	}
-
-	function show(contents) {
-		modules.async.run(
-			modules.async.bind(
-				contents,
-				modules.async.map(function (domElems) {
-					domElems = domElems.filter(modules.fun.defined);
-					var div = document.getElementById('contents');
-					modules.dom.clear(div);
-					for(var i = 0; i < domElems.length; i++) {
-						div.appendChild(domElems[i]);
-					}
-					hijackLinks(div);
-				})
-			)
-		);
-	}
-}
diff --git a/share/js/template.js b/share/js/template.js
deleted file mode 100644
index 1bac571..0000000
--- a/share/js/template.js
+++ /dev/null
@@ -1,35 +0,0 @@
-function Template() {
-	return {
-		render: render
-	};
-
-	function render(template, environment) {
-		if(blog.wording[template] != undefined) {
-			var template = blog.wording[template];
-		}
-		template = template.replace(/{\?((?:[^?]|\?[^}])*)\?}/g, renderSub(environment));
-		var failed = [false];
-		var result = template.replace(
-			/([^$]|^)\$(?:{(\w+)}|(\w+)\b)/g,
-			substitute(environment, failed)
-		);
-		return failed[0] ? null : result;
-	}
-
-	function renderSub(environment) {
-		return function(_, sub) {
-			return render(sub, environment) || '';
-		};
-	}
-
-	function substitute(environment, failed) {
-		return function(_, before, bracketed, raw) {
-			var replaced = environment[bracketed || raw];
-			if(replaced != undefined) {
-				return before + replaced;
-			} else {
-				failed[0] = true;
-			}
-		}
-	}
-}
diff --git a/src/DOM.hs b/src/DOM.hs
index 4955f53..a5c8bff 100644
--- a/src/DOM.hs
+++ b/src/DOM.hs
@@ -77,7 +77,6 @@ page aPage =
       head_ (do
           meta_ [charset_ "utf-8"]
           title_ . toHtml =<< Blog.get name
-          script_ [src_ "/js/unit.js"] empty
           script_ [src_ "/js/remarkable.min.js"] empty
           script_ [src_ "/js/hablo.js"] empty
           optional faviconLink =<< (Blog.get $skin.$favicon)

From fd714e93ff0f4f8a43f15713cca566d208d54285 Mon Sep 17 00:00:00 2001
From: Tissevert 
Date: Fri, 10 Jan 2020 18:58:42 +0100
Subject: [PATCH 3/6] Require SJW, generate blog config as a standalone file
 because it's always nice to have (if you want to expose its content as a
 read-only API) and handle hablo.js compilation with SJW

---
 hablo.cabal |  1 +
 src/JS.hs   | 47 ++++++++++++++++++++++++++++++++---------------
 2 files changed, 33 insertions(+), 15 deletions(-)

diff --git a/hablo.cabal b/hablo.cabal
index b426c5c..5fa20fd 100644
--- a/hablo.cabal
+++ b/hablo.cabal
@@ -59,6 +59,7 @@ executable hablo
                      , template >= 0.2.0 && < 0.3
                      , text >= 1.2.3 && < 1.3
                      , time >= 1.8.0 && < 1.9
+                     , SJW >= 0.1.2 && < 0.2
                      , unix >= 2.7.2 && < 2.8
   ghc-options:         -Wall -dynamic
   hs-source-dirs:      src
diff --git a/src/JS.hs b/src/JS.hs
index 22f6372..e5148e1 100644
--- a/src/JS.hs
+++ b/src/JS.hs
@@ -7,34 +7,51 @@ import Blog (Blog(..), Path(..))
 import qualified Blog (get)
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Reader (ReaderT)
-import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile)
+import Data.ByteString.Lazy (
+    ByteString, concat, intercalate, fromStrict, readFile, writeFile
+  )
 import Data.ByteString.Lazy.Char8 (pack)
-import qualified Files (find)
+import Data.Text.Encoding (encodeUtf8)
 import JSON (exportBlog)
 import Paths_hablo (getDataDir)
 import Pretty ((.$))
+import SJW (compile, source, sourceCode)
 import System.Directory (createDirectoryIfMissing)
+import System.Exit (die)
 import System.FilePath (())
 import Prelude hiding (concat, readFile, writeFile)
 
-compile :: [ByteString] -> ByteString
-compile sources = concat (header:sources ++ [footer])
+object :: [ByteString] -> ByteString
+object sources = concat [header, intercalate ",\n" sources, footer]
   where
-    header = "(function() {\n"
-    footer = "})();"
+    header = "return {\n"
+    footer = "\n};"
 
 var :: (String, ByteString) -> ByteString
-var (varName, content) = concat ["var ", pack varName, " = ", content, ";\n"]
+var (varName, content) = concat ["\t", pack varName, " : ", content]
 
-generate :: ReaderT Blog IO ()
-generate = do
-  destinationDir <- ( "js") <$> (Blog.get $path.$root)
+generateConfig :: FilePath -> ReaderT Blog IO ()
+generateConfig destinationDir = do
   blogJSON <- exportBlog
   remarkablePath <- Blog.get $path.$remarkableConfig
   liftIO $ do
     remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
-    let jsVars = var <$> [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
-    jsFiles <- ( "js") <$> getDataDir >>= Files.find
-    jsCode <- mapM readFile jsFiles
-    createDirectoryIfMissing False destinationDir
-    writeFile (destinationDir  "hablo.js") $ compile (jsVars ++ jsCode )
+    let jsVars = [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
+    writeFile configModule . object $ var <$> jsVars
+  where
+    configModule = destinationDir  "Hablo"  "Config.js"
+
+generateMain :: FilePath -> IO ()
+generateMain destinationDir = do
+  habloSources <- ( "js") <$> getDataDir
+  result <- compile $ source [destinationDir, "unitJS", habloSources]
+  maybe (die "JS compilation failed\n") output =<< sourceCode result
+  where
+    output = writeFile (destinationDir  "hablo.js") . fromStrict . encodeUtf8
+
+generate :: ReaderT Blog IO ()
+generate = do
+  destinationDir <- ( "js") <$> (Blog.get $path.$root)
+  liftIO . createDirectoryIfMissing True $ destinationDir  "Hablo"
+  generateConfig destinationDir
+  liftIO $ generateMain destinationDir

From 7ef89ae93d067d10d1c2fdf4d12c92e3352a2f73 Mon Sep 17 00:00:00 2001
From: Tissevert 
Date: Sat, 11 Jan 2020 09:05:32 +0100
Subject: [PATCH 4/6] Add missing imports, reorder them alphabetically

---
 share/js/DomRenderer.js | 7 ++++---
 share/js/Metadata.js    | 6 ++++--
 share/js/Navigation.js  | 3 ++-
 share/js/Template.js    | 2 ++
 4 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/share/js/DomRenderer.js b/share/js/DomRenderer.js
index 465bc2f..1b26eae 100644
--- a/share/js/DomRenderer.js
+++ b/share/js/DomRenderer.js
@@ -1,8 +1,9 @@
+import blog from Hablo.Config;
+import Metadata;
+import Remarkable;
+import Template;
 import * as Dom from UnitJS.Dom;
 import * as Fun from UnitJS.Fun;
-import Metadata;
-import Template;
-import Remarkable;
 
 return {
   article: article,
diff --git a/share/js/Metadata.js b/share/js/Metadata.js
index bec1b72..d207da6 100644
--- a/share/js/Metadata.js
+++ b/share/js/Metadata.js
@@ -1,3 +1,5 @@
+import blog from Hablo.Config;
+import Template;
 import * as Async from UnitJS.Async;
 import * as Cache from UnitJS.Cache;
 import * as Dom from UnitJS.Dom;
@@ -101,7 +103,7 @@ function renderAnswers(comments) {
       ]),
       Dom.make('div', {
         class: "metadata",
-        innerHTML: modules.template.render('metadata', {
+        innerHTML: Template.render('metadata', {
           author: author(descendant.account.url, descendant.account.username),
           date: date(descendant.created_at)
         })
@@ -148,7 +150,7 @@ function tags(key) {
 function get(key) {
   return Dom.make('div', {
     class: "metadata",
-    innerHTML: modules.template.render('metadata', {
+    innerHTML: Template.render('metadata', {
       author: author(key),
       date: date(key),
       tags: tags(key)
diff --git a/share/js/Navigation.js b/share/js/Navigation.js
index 7b0c7f3..8309249 100644
--- a/share/js/Navigation.js
+++ b/share/js/Navigation.js
@@ -1,8 +1,9 @@
+import {article, articlesList} from DomRenderer;
+import blog from Hablo.Config;
 import * as Async from UnitJS.Async;
 import * as Cache from UnitJS.Cache;
 import * as Dom from UnitJS.Dom;
 import * as Fun from UnitJS.Fun;
-import {article, articlesList} from DomRenderer;
 
 var articles = Cache.make(function(key) {
   var url = ["", blog.path.articlesPath, key + '.md'].join('/');
diff --git a/share/js/Template.js b/share/js/Template.js
index f13cecd..5e00c9a 100644
--- a/share/js/Template.js
+++ b/share/js/Template.js
@@ -1,3 +1,5 @@
+import blog from Hablo.Config;
+
 return {
   render: render
 };

From 4e402174b14e7ac82bf0497d0f0b8de2bea8f66f Mon Sep 17 00:00:00 2001
From: Tissevert 
Date: Wed, 25 Mar 2020 19:47:28 +0100
Subject: [PATCH 5/6] Implement RSS feeds generation

---
 doc/Command-line.md | 20 ++++++++--
 doc/Metadata.md     |  4 +-
 hablo.cabal         |  2 +
 src/Arguments.hs    |  9 ++++-
 src/ArticlesList.hs | 25 +++++++-----
 src/Blog/URL.hs     | 25 ++++++++++--
 src/Collection.hs   | 47 ++++++++++++++++++++++
 src/DOM.hs          | 12 ++++--
 src/DOM/Card.hs     |  8 ++--
 src/HTML.hs         | 51 ++++++------------------
 src/Main.hs         |  2 +
 src/RSS.hs          | 96 +++++++++++++++++++++++++++++++++++++++++++++
 12 files changed, 234 insertions(+), 67 deletions(-)
 create mode 100644 src/Collection.hs
 create mode 100644 src/RSS.hs

diff --git a/doc/Command-line.md b/doc/Command-line.md
index fe57384..b531604 100644
--- a/doc/Command-line.md
+++ b/doc/Command-line.md
@@ -110,6 +110,12 @@ You can use this option if you want to override this behaviour and provide a dif
 hablo --name "Turtles/Paradize"
 ```
 
+## Open Graph cards
+
+`-O, --open-graph-cards`
+
+Enables Open Graph cards in pages to display a pretty preview of them instead of the raw URL in links posted to social media. Note that this feature requires setting your site URL with [`--site-url`](#site-url).
+
 ## Pages
 
 `-p, --pages`
@@ -126,7 +132,7 @@ On the page that [lists](https://git.marvid.fr/Tissevert/hablo/wiki/Architectura
 hablo --preview-articles 5
 ```
 
-will make all your short pages display 5 articles.
+will make all your short pages display 5 articles. This number of articles per short page is also used in the RSS feeds if you enable them with [`--rss`](#rss).
 
 ## Number of lines preview for articles
 
@@ -144,13 +150,21 @@ Hablo uses [remarkable](https://github.com/jonschlinkert/remarkable) to render y
 
 The file is read by hablo when the blog is generated and its content gets included into the client JS code so it can be located absolutely anywhere, even outside your blog's directory.
 
+## RSS
+
+`-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.
+
+Note that this feature requires setting your site URL with [`--site-url`](#site-url).
+
 ## Site URL
 
 `-u, --site-url`
 
-To enable Open Graph cards and display a pretty preview of the page instead of the raw URL in links posted to social media, you need to tell Hablo about the URL where the website is going to be deployed. This used to work without but apparently Pleroma no longer considers valid cards with an image path local to the website.
+All the default content generated by hablo is independent from any host because it doesn't use any full URL with a host name. Enabling [Open Graph cards](#open-graph-cards) or [RSS feeds](#rss) requires to know this information though, which is achieved by setting this option to the desired value.
 
-Note that this is purely optional and you don't have to use this option if you don't care about Open Graph cards. They will simply disappear instead of being generated without the absolute URL. This means that option now works as a switch to enable Open Graph cards or not.
+Note that this is purely optional and you don't have to use this option if you don't care about Open Graph cards or RSS feeds. Setting it for no reason will trigger a warning.
 
 ## Wording
 
diff --git a/doc/Metadata.md b/doc/Metadata.md
index c771ef3..8ee66fa 100644
--- a/doc/Metadata.md
+++ b/doc/Metadata.md
@@ -45,7 +45,7 @@ You can override this behaviour by setting a `date` metadata. It can contain a d
 
 ### Featured image
 
-Every article can contain as many pictures as you like, anywhere you like in it. But you can choose one of them (or even one that doesn't appear in your article) to appear in the [Open Graph](http://ogp.me/) card of your article if you've [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#site-url) them, so that it is displayed and «represents» your article when you paste links to it on social media. The exact name of the metadata is `featuredImage`, camel-case, and it expects the site-root relative link of the picture (so the path as seen from your blog by a client accessing it).
+Every article can contain as many pictures as you like, anywhere you like in it. But you can choose one of them (or even one that doesn't appear in your article) to appear in the [Open Graph](http://ogp.me/) card of your article if you've [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#open-graph-cards) them, so that it is displayed and «represents» your article when you paste links to it on social media. The exact name of the metadata is `featuredImage`, camel-case, and it expects the site-root relative link of the picture (so the path as seen from your blog by a client accessing it).
 
 ```YAML
 featuredImage: /media/turtles/olive-ridley.jpg
@@ -53,7 +53,7 @@ featuredImage: /media/turtles/olive-ridley.jpg
 
 ### Summary
 
-You can write a short description of your article and use it as the value of its `summary` metadata and this text will be used in the Open Graph [description](http://ogp.me/#optional) of the card generated for the article (like above for the featured image, if they're [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#site-url))
+You can write a short description of your article and use it as the value of its `summary` metadata and this text will be used in the Open Graph [description](http://ogp.me/#optional) of the card generated for the article (like above for the featured image, if they're [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#open-graph-cards))
 
 ```YAML
 summary: This week, I'm gonna tell you everything about the olive ridley sea turtle !
diff --git a/hablo.cabal b/hablo.cabal
index b426c5c..9e23312 100644
--- a/hablo.cabal
+++ b/hablo.cabal
@@ -37,6 +37,7 @@ executable hablo
                      , Blog.Skin
                      , Blog.URL
                      , Blog.Wording
+                     , Collection
                      , DOM
                      , DOM.Card
                      , Files
@@ -45,6 +46,7 @@ executable hablo
                      , JSON
                      , Paths_hablo
                      , Pretty
+                     , RSS
   -- other-extensions:
   build-depends:       aeson >= 1.4.0 && < 1.5
                      , base >= 4.9.1 && < 4.13
diff --git a/src/Arguments.hs b/src/Arguments.hs
index f7b6a4e..45b9bb6 100644
--- a/src/Arguments.hs
+++ b/src/Arguments.hs
@@ -6,7 +6,10 @@ module Arguments (
 import Data.Monoid ((<>))
 import Data.Version (showVersion)
 import Control.Applicative ((<|>), (<**>), optional)
-import Options.Applicative (Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc, header, help, helper, info, long, metavar, short, str, value)
+import Options.Applicative (
+      Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc
+    , header, help, helper, info, long, metavar, short, str, switch, value
+  )
 import qualified Options.Applicative as Optparse (option)
 import qualified Paths_hablo as Hablo (version)
 import System.FilePath (dropTrailingPathSeparator, isValid)
@@ -20,10 +23,12 @@ data Arguments = BlogConfig {
     , favicon :: Maybe FilePath
     , headPath :: Maybe FilePath
     , name :: Maybe String
+    , openGraphCards :: Bool
     , pagesPath :: Maybe FilePath
     , previewArticlesCount :: Int
     , previewLinesCount :: Int
     , remarkableConfig :: Maybe FilePath
+    , rss :: Bool
     , siteURL :: Maybe String
     , wording :: Maybe FilePath
   }
@@ -55,6 +60,7 @@ blogConfig = BlogConfig
   <*> option filePath 'f' "favicon" "FILE" "path to the image to use for the blog's favicon"
   <*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head"
   <*> option str 'n' "name" "BLOG_NAME" "name of the blog"
+  <*> switch (short 'O' <> long "open-graph-cards" <> help "enable Open Graph cards")
   <*> option filePath 'p' "pages"
         "DIRECTORY" "relative path to the directory containing the pages within INPUT_DIR"
   <*> Optparse.option auto (
@@ -73,6 +79,7 @@ blogConfig = BlogConfig
       )
   <*> option filePath 'r' "remarkable-config" "FILE"
         "path to a file containing a custom RemarkableJS configuration"
+  <*> switch (short 'R' <> long "rss" <> help "enable RSS feeds generation")
   <*> option filePath 'u' "site-url" "URL" "URL where the blog is published"
   <*> option filePath 'w' "wording" "FILE" "path to the file containing the wording to use"
 
diff --git a/src/ArticlesList.hs b/src/ArticlesList.hs
index 0b71b6a..4f5f564 100644
--- a/src/ArticlesList.hs
+++ b/src/ArticlesList.hs
@@ -3,14 +3,15 @@
 {-# LANGUAGE FlexibleContexts #-}
 module ArticlesList (
       ArticlesList(..)
+    , description
     , otherUrl
-    , pageTitle
+    , title
   ) where
 
 import Article (Article)
-import Blog (Blog(..), get)
+import Blog (Blog(..))
 import Blog.Wording (render)
-import Control.Monad.Reader (MonadReader)
+import Control.Monad.Reader (MonadReader, asks)
 import Data.Text (Text, pack)
 import Files (absoluteLink)
 import System.FilePath.Posix (())
@@ -25,13 +26,19 @@ 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}) = title (full, tagged) <$> Blog.get wording
+title :: MonadReader Blog m => ArticlesList -> m String
+title (ArticlesList {tagged}) = do
+  asks $ (\name -> maybe name ((name ++ " - ") ++) tagged) . name
+
+description :: MonadReader Blog m => ArticlesList -> m Text
+description (ArticlesList {full, tagged}) =
+  getDescription (full, tagged) <$> asks wording
   where
-    title (True, Nothing) = render "allPage" []
-    title (True, Just tag) = render "allTaggedPage" [("tag", pack tag)]
-    title (False, Nothing) = render "latestPage" []
-    title (False, Just tag) = render "latestTaggedPage" [("tag", pack tag)]
+    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)]
     
     
     
diff --git a/src/Blog/URL.hs b/src/Blog/URL.hs
index 4e56d64..359faae 100644
--- a/src/Blog/URL.hs
+++ b/src/Blog/URL.hs
@@ -10,10 +10,14 @@ import Arguments (Arguments)
 import qualified Arguments as Arguments (Arguments(..))
 import Data.Aeson (ToJSON(..), (.=), pairs)
 import GHC.Generics (Generic)
+import System.Exit (die)
+import System.IO (hPutStrLn, stderr)
+import Text.Printf (printf)
 
 data URL = URL {
-      comments :: Maybe String
-    , site :: Maybe String
+      cards :: Maybe String
+    , comments :: Maybe String
+    , rss :: Maybe String
   } deriving Generic
 
 instance ToJSON URL where
@@ -22,7 +26,20 @@ instance ToJSON URL where
     )
 
 build :: Arguments -> IO URL
-build arguments = return $ URL {comments, site}
+build arguments = do
+  cards <- getSiteURL argOGCards "Open Graph cards"
+  rss <- getSiteURL argRSS "RSS feeds"
+  checksUsed (argOGCards || argRSS) siteURL
+  return $ URL {cards, comments, rss}
   where
     comments = Arguments.commentsURL arguments
-    site = Arguments.siteURL arguments
+    siteURL = Arguments.siteURL arguments
+    argOGCards = Arguments.openGraphCards arguments
+    argRSS = Arguments.rss arguments
+    errorMsg :: String -> String
+    errorMsg = printf "Enabling %s requires setting the site url with --site-url"
+    getSiteURL False _ = return Nothing
+    getSiteURL True name = maybe (die $ errorMsg name) (return . Just) siteURL
+    checksUsed False (Just _) =
+      hPutStrLn stderr "Site url is set but not used, did you forget --open-graph-cards or --rss ?"
+    checksUsed _ _ = return ()
diff --git a/src/Collection.hs b/src/Collection.hs
new file mode 100644
index 0000000..ae2c5c2
--- /dev/null
+++ b/src/Collection.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE NamedFieldPuns #-}
+module Collection (
+      Collection(..)
+    , getAll
+  ) where
+
+import Article(Article(..))
+import Blog (Blog(..), Path(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (MonadReader(..), ReaderT, asks)
+import Data.List (sortOn)
+import Data.Map ((!))
+import qualified Data.Map as Map (elems, filterWithKey, toList)
+import Data.Ord (Down(..))
+import qualified Data.Set as Set (member)
+import Pretty ((.$))
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath.Posix (())
+
+data Collection = Collection {
+      articlesFeatured :: [Article]
+    , basePath :: FilePath
+    , tag :: Maybe String
+  }
+
+build :: MonadIO m => [Article] -> Maybe String -> ReaderT Blog m Collection
+build articlesFeatured tag = do
+  root <- asks $path.$root
+  let basePath = maybe root (root ) tag
+  liftIO $ createDirectoryIfMissing False basePath
+  return $ Collection {
+      articlesFeatured = sortByDate articlesFeatured, basePath, tag
+    }
+  where
+    sortByDate = sortOn (Down . (! "date") . metadata)
+
+getAll :: ReaderT Blog IO [Collection]
+getAll = do
+  Blog {articles, tags} <- ask
+  (:)
+    <$> (build (Map.elems articles) Nothing)
+    <*> (flip mapM (Map.toList tags) $ 
+            \(tag, tagged) -> build (getArticles tagged articles) $ Just tag
+          )
+  where
+    getArticles tagged =
+      Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged)
diff --git a/src/DOM.hs b/src/DOM.hs
index 4955f53..00c976c 100644
--- a/src/DOM.hs
+++ b/src/DOM.hs
@@ -6,7 +6,7 @@ module DOM (
 
 import Article (Article(..))
 import qualified Article (preview)
-import ArticlesList (ArticlesList(..), otherUrl, pageTitle)
+import ArticlesList (ArticlesList(..), otherUrl, description)
 import Blog (Blog(..), Path(..), Skin(..), URL(..))
 import qualified Blog (get)
 import Blog.Wording (render)
@@ -16,7 +16,11 @@ import Data.Text (pack, empty)
 import DOM.Card (HasCard)
 import qualified DOM.Card as Card (make)
 import Files (absoluteLink)
-import Lucid
+import Lucid (
+      HtmlT, a_, article_, body_, charset_, class_, div_, doctypehtml_, h1_, h2_
+    , head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_
+    , title_, toHtml, toHtmlRaw, type_, ul_
+  )
 import Prelude hiding (head, lookup)
 import Pretty ((.$))
 import System.FilePath.Posix ((), (<.>))
@@ -32,7 +36,7 @@ instance Page Article where
 instance Page ArticlesList where
   content al@(ArticlesList {featured, full}) = do
     preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
-    h2_ . toHtml =<< pageTitle al
+    h2_ . toHtml =<< description al
     a_ [href_ . pack $ otherUrl al] . toHtml =<< otherLink
     div_ [class_ "articles"] (
         mapM_ (article False . preview) featured
@@ -81,7 +85,7 @@ page aPage =
           script_ [src_ "/js/remarkable.min.js"] empty
           script_ [src_ "/js/hablo.js"] empty
           optional faviconLink =<< (Blog.get $skin.$favicon)
-          optional (Card.make aPage) =<< (Blog.get $urls.$site)
+          optional (Card.make aPage) =<< (Blog.get $urls.$cards)
           (Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
         )
       body_ (do
diff --git a/src/DOM/Card.hs b/src/DOM/Card.hs
index b84a598..41e9399 100644
--- a/src/DOM/Card.hs
+++ b/src/DOM/Card.hs
@@ -8,7 +8,8 @@ module DOM.Card (
   ) where
 
 import qualified Article (Article(..))
-import ArticlesList (ArticlesList(..), pageTitle)
+import ArticlesList (ArticlesList(..))
+import qualified ArticlesList (description, title)
 import Blog (Blog(..), Skin(..))
 import qualified Blog (get)
 import Control.Applicative ((<|>))
@@ -64,8 +65,8 @@ instance HasCard Article.Article where
 
 instance HasCard ArticlesList where
   getCard al = do
-    cardTitle <- getTitle <$> Blog.get name
-    description <- pageTitle al
+    cardTitle <- ArticlesList.title al
+    description <- ArticlesList.description al
     return $ Card {
           cardType = "website"
         , description
@@ -74,5 +75,4 @@ instance HasCard ArticlesList where
         , urlPath = maybe "" ('/':) (tagged al) ++ file
       }
     where
-      getTitle name = maybe name ((name ++ " - ") ++) $ tagged al
       file = '/' : (if full al then "all" else "index") ++ ".html"
diff --git a/src/HTML.hs b/src/HTML.hs
index ea1d90f..c2d5fed 100644
--- a/src/HTML.hs
+++ b/src/HTML.hs
@@ -7,49 +7,27 @@ module HTML (
 import Article(Article(..))
 import ArticlesList (ArticlesList(..))
 import Blog (Blog(..), Path(..), Skin(..))
-import qualified Blog (get)
-import Control.Monad (forM)
+import Collection (Collection(..))
+import qualified Collection (getAll)
 import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Reader (MonadReader(..), ReaderT)
-import Data.List (sortOn)
-import Data.Map ((!))
-import qualified Data.Map as Map (elems, filterWithKey, toList)
-import Data.Ord (Down(..))
-import qualified Data.Set as Set (member)
+import Control.Monad.Reader (ReaderT, asks)
+import qualified Data.Map as Map (elems)
 import qualified Data.Text.Lazy.IO as TextIO (writeFile)
 import DOM (page)
-import Lucid
+import Lucid (renderTextT)
 import Pretty ((.$))
-import System.Directory (createDirectoryIfMissing)
 import System.FilePath.Posix ((), (<.>))
 
-data Collection = Collection {
-      articlesFeatured :: [Article]
-    , basePath :: FilePath
-    , tag :: Maybe String
-  }
-
-collection :: Monad m => [Article] -> Maybe String -> ReaderT Blog m Collection
-collection articlesFeatured tag = do
-  root <- Blog.get $path.$root
-  return $ Collection {
-        articlesFeatured = sortByDate articlesFeatured
-      , basePath = maybe root (root ) tag
-      , tag
-    }
-  where
-    sortByDate = sortOn (Down . (! "date") . metadata)
-
 articlesLists :: Monad m => Collection -> ReaderT Blog m [(FilePath, ArticlesList)]
 articlesLists (Collection {articlesFeatured, basePath, tag}) = do
-  limit <- take <$> (Blog.get $skin.$previewArticlesCount)
+  limit <- take <$> (asks $skin.$previewArticlesCount)
   return [
-        (basePath  "index.html", ArticlesList {
+        (basePath  "index" <.> "html", ArticlesList {
               tagged = tag
             , full = False
             , featured = limit articlesFeatured
           })
-      , (basePath  "all.html", ArticlesList {
+      , (basePath  "all" <.> "html", ArticlesList {
               tagged = tag
             , full = True
             , featured = articlesFeatured
@@ -58,14 +36,13 @@ articlesLists (Collection {articlesFeatured, basePath, tag}) = do
 
 generateArticles :: [Article] -> ReaderT Blog IO ()
 generateArticles = mapM_ $ \article -> do
-  baseDir <- () <$> (Blog.get $path.$root) <*> (Blog.get $path.$articlesPath)
+  baseDir <- () <$> (asks $path.$root) <*> (asks $path.$articlesPath)
   (renderTextT $ page article)
     >>= liftIO . TextIO.writeFile (baseDir  key article <.> "html")
 
 generateCollection :: Collection -> ReaderT Blog IO ()
 generateCollection (Collection {articlesFeatured = []}) = return ()
 generateCollection aCollection = do
-  liftIO . createDirectoryIfMissing False $ basePath aCollection
   articlesLists aCollection
   >>= (mapM_ $ \(filePath, articlesList) ->
     (renderTextT $ page articlesList)
@@ -74,11 +51,5 @@ generateCollection aCollection = do
 
 generate :: ReaderT Blog IO ()
 generate = do
-  Blog {articles, tags} <- ask
-  generateArticles $ Map.elems articles
-  collection (Map.elems articles) Nothing >>= generateCollection
-  forM  (Map.toList tags) $
-    \(tag, tagged) -> collection (getArticles tagged articles) $ Just tag
-  >>= mapM_ generateCollection
-  where
-    getArticles tagged = Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged)
+  asks articles >>= generateArticles . Map.elems
+  Collection.getAll >>= mapM_ generateCollection
diff --git a/src/Main.hs b/src/Main.hs
index bc3ae64..4856b1f 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -8,6 +8,7 @@ import Data.Version (showVersion)
 import qualified HTML (generate)
 import qualified JS (generate)
 import qualified Paths_hablo as Hablo (version)
+import qualified RSS (generate)
 import System.Exit (exitSuccess)
 
 main :: IO ()
@@ -18,4 +19,5 @@ main = do
     config@(BlogConfig {}) -> Blog.build config >>= runReaderT (do
         HTML.generate
         JS.generate
+        RSS.generate
       )
diff --git a/src/RSS.hs b/src/RSS.hs
new file mode 100644
index 0000000..4751fbd
--- /dev/null
+++ b/src/RSS.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+module RSS (
+    generate
+  ) where
+
+import Article (Article(..))
+import ArticlesList (ArticlesList(..))
+import qualified ArticlesList (description, title)
+import Blog (Blog(..), Path(..), Skin(..), URL(..))
+import Collection (Collection(..), getAll)
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (MonadReader, ReaderT, asks)
+import Data.Text (Text)
+import Data.Map ((!))
+import qualified Data.Text.Lazy.IO as TextIO (writeFile)
+import Data.Time (defaultTimeLocale, formatTime, rfc822DateFormat)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Lucid (Attribute, HtmlT, Term, ToHtml(..), term, renderTextT)
+import Lucid.Base (makeAttribute)
+import Pretty ((.$))
+import System.FilePath.Posix ((), (<.>))
+
+prolog :: Monad m => HtmlT m ()
+prolog = toHtmlRaw ("" :: String)
+
+version_ :: Text -> Attribute
+version_ = makeAttribute "version"
+
+xmlns_content_ :: Text -> Attribute
+xmlns_content_ = makeAttribute "xmlns:content"
+
+xmlns_atom_ :: Text -> Attribute
+xmlns_atom_ = makeAttribute "xmlns:atom"
+
+rss_ :: Term arg result => arg -> result
+rss_ = term "rss"
+
+channel_ :: Term arg result => arg -> result
+channel_ = term "channel"
+
+title_ :: Term arg result => arg -> result
+title_ = term "title"
+
+link_ :: Term arg result => arg -> result
+link_ = term "link"
+
+description_ :: Term arg result => arg -> result
+description_ = term "description"
+
+item_ :: Term arg result => arg -> result
+item_ = term "item"
+
+pubDate_ :: Term arg result => arg -> result
+pubDate_ = term "pubDate"
+
+articleItem :: MonadReader Blog m => String -> Article -> HtmlT m ()
+articleItem siteURL (Article {key, metadata, title}) =
+  item_ $ do
+    title_ $ toHtml title
+    link_ . toHtml =<< link <$> (asks $path.$articlesPath)
+    pubDate_ . toHtml . rfc822Date $ metadata ! "date"
+  where
+    link path = siteURL  path  key <.> "html"
+    rfc822Date =
+        formatTime defaultTimeLocale rfc822DateFormat
+      . posixSecondsToUTCTime . fromIntegral . (read :: String -> Int)
+
+feed :: MonadReader Blog m => String -> ArticlesList -> HtmlT m ()
+feed siteURL al@(ArticlesList {tagged, featured}) = do
+  prolog
+  rss_ [version, content, atom] $ do
+    channel_ $ do
+      title_ . toHtml =<< ArticlesList.title al
+      link_ . toHtml $ siteURL  maybe "" id tagged
+      description_ . toHtml =<< ArticlesList.description al
+      mapM_ (articleItem siteURL) featured
+  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
+  limit <- take <$> (asks $skin.$previewArticlesCount)
+  let articlesList = ArticlesList {
+      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
+  where
+    generateAll siteURL = Collection.getAll >>= mapM_ (generateCollection siteURL)

From f19331bf11f6be1bd22a57f8d0d90dc66ac075be Mon Sep 17 00:00:00 2001
From: Tissevert 
Date: Fri, 8 May 2020 15:51:25 +0200
Subject: [PATCH 6/6] Generate links to RSS feeds generated, generalize
 conditional blocks for static templating thus simplifying some variables and
 clarify some data structures for Collections and ArticleLists

---
 doc/Command-line.md       |  2 +-
 doc/Template-variables.md | 56 ++++++++++++++++++-------------
 hablo.cabal               |  1 +
 share/defaultWording.conf |  8 ++---
 share/js/domRenderer.js   | 38 +++++++++++++--------
 src/ArticlesList.hs       | 53 ++++++++++++++++--------------
 src/Blog.hs               | 24 +++++++++++---
 src/Blog/Template.hs      | 69 +++++++++++++++++++++++++++++++++++++++
 src/Blog/Wording.hs       | 56 ++++++++-----------------------
 src/Collection.hs         | 16 ++++++---
 src/DOM.hs                | 53 +++++++++++++++++-------------
 src/DOM/Card.hs           | 25 +++++++-------
 src/HTML.hs               | 35 +++++++-------------
 src/JS.hs                 |  7 ++--
 src/JSON.hs               |  2 ++
 src/RSS.hs                | 27 +++++++--------
 16 files changed, 277 insertions(+), 195 deletions(-)
 create mode 100644 src/Blog/Template.hs

diff --git a/doc/Command-line.md b/doc/Command-line.md
index b531604..26cb826 100644
--- a/doc/Command-line.md
+++ b/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).
 
diff --git a/doc/Template-variables.md b/doc/Template-variables.md
index 270b753..9873bec 100644
--- a/doc/Template-variables.md
+++ b/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 `

` title used on the [full page for all the articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). +The `

` 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 `

` 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). - -It of course expects one variable named `$tag` : the name of the tag for the given page. - -## commentsLink +### 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 `

` 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 `

` 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 `

` 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 `

` 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). - -It of course expects one variable named `$tag` : the name of the tag for the given page. - -## metadata +### 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 », otherwise it will directly start with «on ». 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 `

` element in the navigation `
` that lists all the tags of your blog. diff --git a/hablo.cabal b/hablo.cabal index 9e23312..01c480c 100644 --- a/hablo.cabal +++ b/hablo.cabal @@ -34,6 +34,7 @@ executable hablo , ArticlesList , Blog , Blog.Path + , Blog.Template , Blog.Skin , Blog.URL , Blog.Wording diff --git a/share/defaultWording.conf b/share/defaultWording.conf index 0fd4281..21b431b 100644 --- a/share/defaultWording.conf +++ b/share/defaultWording.conf @@ -1,11 +1,11 @@ allLink = See all -allPage = All articles -allTaggedPage = All articles tagged ${tag} +allPage = All articles{? tagged ${tag}?} commentsLink = Comment on the fediverse commentsSection = Comments dateFormat = en-US latestLink = See only latest -latestPage = Latest articles -latestTaggedPage = Latest articles tagged ${tag} +latestPage = Latest articles{? tagged ${tag}?} metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?} +rssLink = Subscribe +rssTitle = Follow all articles{? tagged ${tag}?} tagsList = Tags diff --git a/share/js/domRenderer.js b/share/js/domRenderer.js index aa4a57b..8c688e7 100644 --- a/share/js/domRenderer.js +++ b/share/js/domRenderer.js @@ -66,29 +66,41 @@ function DomRenderer(modules) { } function pageTitle(tag, all) { - if(tag != undefined) { - var template = all ? 'allTaggedPage' : 'latestTaggedPage'; - return modules.template.render(template, {tag: tag}); - } else { - return blog.wording[all ? 'allPage' : 'latestPage']; - } + return modules.template.render(all ? 'allPage' : 'latestPage', {tag: tag}); } function otherUrl(tag, all) { - var path = [tag, all ? null : 'all.html']; - return '/' + path.filter(modules.fun.defined).join('/'); + return '/' + (tag || '') + (all ? '/' : '/all.html'); } function articlesList(tag, all) { return function(articlePreviews) { return [ modules.dom.make('h2', {innerText: pageTitle(tag, all)}), - modules.dom.make('a', { - innerText: all ? blog.wording.latestLink : blog.wording.allLink, - href: otherUrl(tag, all) - }), - modules.dom.make('div', {class: 'articles'}, articlePreviews.filter(modules.fun.defined)) + modules.dom.make('ul', {}, articlesListLinks(tag, all)), + modules.dom.make('div', {class: 'articles'}, + articlePreviews.filter(modules.fun.defined) + ) ]; }; } + + function articlesListLinks(tag, all) { + var links = [ + modules.dom.make('a', { + innerText: all ? blog.wording.latestLink : blog.wording.allLink, + href: otherUrl(tag, all), + class: 'other' + }) + ]; + if(blog.hasRSS) { + links.unshift(modules.dom.make('a', { + innerText: blog.wording.rssLink, + href: 'rss.xml', + class: 'RSS', + title: modules.template.render('rssTitle', {tag: tag}) + })); + } + return links.map(function(e) {return modules.dom.make('li', {}, [e]);}); + } } diff --git a/src/ArticlesList.hs b/src/ArticlesList.hs index 4f5f564..c111be0 100644 --- a/src/ArticlesList.hs +++ b/src/ArticlesList.hs @@ -4,42 +4,45 @@ module ArticlesList ( ArticlesList(..) , description - , otherUrl - , title + , getArticles + , otherURL + , rssLinkTexts ) where import Article (Article) -import Blog (Blog(..)) -import Blog.Wording (render) +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 { - tagged :: Maybe String - , full :: Bool - , featured :: [Article] + full :: Bool + , collection :: Collection } -otherUrl :: ArticlesList -> String -otherUrl (ArticlesList {full, tagged}) = absoluteLink $ - (if full then id else ( "all.html")) $ maybe "" id tagged +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 -title :: MonadReader Blog m => ArticlesList -> m String -title (ArticlesList {tagged}) = do - asks $ (\name -> maybe name ((name ++ " - ") ++) tagged) . name +otherURL :: ArticlesList -> String +otherURL (ArticlesList {full, collection}) = absoluteLink $ + (if full then id else ( "all.html")) . maybe "" id $ tag collection -description :: MonadReader Blog m => ArticlesList -> m Text -description (ArticlesList {full, tagged}) = - getDescription (full, tagged) <$> asks wording +description :: Renderer m => ArticlesList -> m Text +description (ArticlesList {full, collection}) = + template page . environment $ tag collection 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)] - - - - + 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 diff --git a/src/Blog.hs b/src/Blog.hs index a2e6915..188e983 100644 --- a/src/Blog.hs +++ b/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 -get = (<$> ask) +type Renderer m = (MonadIO m, MonadReader Blog m) + +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 + } diff --git a/src/Blog/Template.hs b/src/Blog/Template.hs new file mode 100644 index 0000000..e9ee71a --- /dev/null +++ b/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 diff --git a/src/Blog/Wording.hs b/src/Blog/Wording.hs index e20e2d9..e393db8 100644 --- a/src/Blog/Wording.hs +++ b/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 qualified Data.Map as Map (empty, fromList, insert, keys, map, union) +import Data.Map (Map) +import qualified Data.Map as Map (empty, fromList, keys, map, union) import Data.Text (Text) -import qualified Data.Text as Text (pack, unpack) -import Data.Text.Lazy (toStrict) -import Data.Text.Template (Template, renderA, showTemplate, templateSafe) -import qualified Data.Text.Template as Template (render) +import qualified Data.Text as Text (pack) 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", []) - , ("allTaggedPage", ["tag"]) + , ("allPage", ["tag"]) , ("commentsLink", []) , ("commentsSection", []) , ("dateFormat", []) , ("latestLink", []) - , ("latestPage", []) - , ("latestTaggedPage", ["tag"]) + , ("latestPage", ["tag"]) , ("metadata", ["author", "date", "tags"]) + , ("rssLink", []) + , ("rssTitle", ["tag"]) , ("tagsList", []) ] - instance ToJSON Wording where - toJSON (Wording m) = toJSON (showTemplate <$> m) - toEncoding (Wording m) = toEncoding (showTemplate <$> m) - -render :: String -> [(Text, Text)] -> Wording -> Text -render key env (Wording wMap) = - toStrict $ Template.render (wMap ! key) (Map.fromList env !) + toJSON (Wording m) = toJSON m + toEncoding (Wording m) = toEncoding m 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 ( - \templated key -> flip (Map.insert key) templated <$> makeTemplate key wordindMap - ) Map.empty (Map.keys variables) + Wording <$> foldM addWording Map.empty wordingFiles diff --git a/src/Collection.hs b/src/Collection.hs index ae2c5c2..0a73798 100644 --- a/src/Collection.hs +++ b/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 diff --git a/src/DOM.hs b/src/DOM.hs index 00c976c..66f83ac 100644 --- a/src/DOM.hs +++ b/src/DOM.hs @@ -6,11 +6,11 @@ module DOM ( import Article (Article(..)) import qualified Article (preview) -import ArticlesList (ArticlesList(..), otherUrl, description) -import Blog (Blog(..), Path(..), Skin(..), URL(..)) -import qualified Blog (get) -import Blog.Wording (render) -import Control.Monad.Reader (ReaderT) +import ArticlesList ( + ArticlesList(..), description, getArticles, otherURL, rssLinkTexts + ) +import Blog (Blog(..), Path(..), Skin(..), URL(..), template) +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 - preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount) + content al@(ArticlesList {full}) = do + 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 = Blog.get $wording.$(link) + otherLink = + 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_ ( - a_ [href_ . pack $ absoluteLink tagName, class_ "tag"] $ toHtml tagName +tag name = li_ ( + 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,19 +87,19 @@ page aPage = doctypehtml_ (do head_ (do meta_ [charset_ "utf-8"] - title_ . toHtml =<< Blog.get name + title_ . toHtml =<< asks name script_ [src_ "/js/unit.js"] empty script_ [src_ "/js/remarkable.min.js"] empty script_ [src_ "/js/hablo.js"] empty - optional faviconLink =<< (Blog.get $skin.$favicon) - optional (Card.make aPage) =<< (Blog.get $urls.$cards) - (Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw + optional faviconLink =<< (asks $skin.$favicon) + optional (Card.make aPage) =<< (asks $urls.$cards) + 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) - ul_ . mapM_ tag . Map.keys =<< Blog.get tags + h2_ . toHtml =<< template "tagsList" [] + ul_ . mapM_ tag . Map.keys =<< asks tags ) div_ [id_ "contents"] $ content aPage ) diff --git a/src/DOM/Card.hs b/src/DOM/Card.hs index 41e9399..55334cc 100644 --- a/src/DOM/Card.hs +++ b/src/DOM/Card.hs @@ -9,11 +9,12 @@ module DOM.Card ( import qualified Article (Article(..)) import ArticlesList (ArticlesList(..)) -import qualified ArticlesList (description, title) -import Blog (Blog(..), Skin(..)) -import qualified Blog (get) +import qualified ArticlesList (description) +import Blog (Blog(..), Renderer, Skin(..)) +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)) - og "site_name" =<< (Blog.get $name.$pack) + maybeImage =<< ((image <|>) <$> (asks $skin.$cardImage)) + 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 - cardTitle <- ArticlesList.title al + getCard al@(ArticlesList {collection}) = do + 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" diff --git a/src/HTML.hs b/src/HTML.hs index c2d5fed..9818d13 100644 --- a/src/HTML.hs +++ b/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 {articlesFeatured, basePath, tag}) = do - limit <- take <$> (asks $skin.$previewArticlesCount) - return [ - (basePath "index" <.> "html", ArticlesList { - tagged = tag - , full = False - , featured = limit articlesFeatured - }) - , (basePath "all" <.> "html", ArticlesList { - tagged = tag - , full = True - , featured = articlesFeatured - }) - ] +articlesLists :: Collection -> [(FilePath, ArticlesList)] +articlesLists collection@(Collection {basePath}) = [ + (path full, ArticlesList {collection, full}) | full <- [False, True] + ] + 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 aCollection = do - articlesLists aCollection - >>= (mapM_ $ \(filePath, articlesList) -> - (renderTextT $ page articlesList) - >>= liftIO . TextIO.writeFile filePath - ) +generateCollection (Collection {featured = []}) = return () +generateCollection collection = + flip mapM_ (articlesLists collection) $ \(filePath, articlesList) -> + (renderTextT $ page articlesList) >>= liftIO . TextIO.writeFile filePath generate :: ReaderT Blog IO () generate = do diff --git a/src/JS.hs b/src/JS.hs index 22f6372..5cd1ad1 100644 --- a/src/JS.hs +++ b/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, readFile, writeFile) import Data.ByteString.Lazy.Char8 (pack) import qualified Files (find) @@ -28,9 +27,9 @@ var (varName, content) = concat ["var ", pack varName, " = ", content, ";\n"] generate :: ReaderT Blog IO () generate = do - destinationDir <- ( "js") <$> (Blog.get $path.$root) + destinationDir <- ( "js") <$> (asks $path.$root) blogJSON <- exportBlog - remarkablePath <- Blog.get $path.$remarkableConfig + remarkablePath <- asks $path.$remarkableConfig liftIO $ do remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath let jsVars = var <$> [("blog", blogJSON), ("remarkableConfig", remarkableJSON)] diff --git a/src/JSON.hs b/src/JSON.hs index 4b8b5bd..3562455 100644 --- a/src/JSON.hs +++ b/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 diff --git a/src/RSS.hs b/src/RSS.hs index 4751fbd..73f8b79 100644 --- a/src/RSS.hs +++ b/src/RSS.hs @@ -6,10 +6,11 @@ module RSS ( ) where import Article (Article(..)) -import ArticlesList (ArticlesList(..)) -import qualified ArticlesList (description, title) -import Blog (Blog(..), Path(..), Skin(..), URL(..)) +import ArticlesList (ArticlesList(..), getArticles) +import qualified ArticlesList (description) +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 siteURL al@(ArticlesList {tagged, featured}) = do +feed :: Renderer m => String -> ArticlesList -> HtmlT m () +feed siteURL al@(ArticlesList {collection}) = do prolog rss_ [version, content, atom] $ do channel_ $ do - title_ . toHtml =<< ArticlesList.title al - link_ . toHtml $ siteURL maybe "" id tagged + title_ . toHtml =<< Collection.title collection + 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 - limit <- take <$> (asks $skin.$previewArticlesCount) - let articlesList = ArticlesList { - tagged = tag, full = False, featured = limit articlesFeatured - } - renderTextT (feed siteURL articlesList) - >>= liftIO . TextIO.writeFile (basePath "rss" <.> "xml") +generateCollection siteURL collection = + renderTextT (feed siteURL $ ArticlesList {full = False, collection}) + >>= liftIO . TextIO.writeFile (basePath collection "rss" <.> "xml") generate :: ReaderT Blog IO () generate = (asks $urls.$rss) >>= maybe (return ()) generateAll