Fix Open Graph cards by adding a new option to provide the site's URL

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 :

doc/Architectural-choices.md

@@ -24,7 +24,7 @@ Pages include a banner, a navigation `<div>` 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 `<pre>` 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.

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).
+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.
 
 ```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`

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.

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 !

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

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(

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

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}

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 {
+  return $ Path {articlesPath, pagesPath, remarkableConfig, root}
-      articlesPath, commentsAt, pagesPath, remarkableConfig, root
-    }
-  where
-    commentsAt = Arguments.commentsAt arguments

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

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 qualified Data.Map as Map (keys)
-import Data.Monoid ((<>))
+import Data.Text (pack, empty)
-import Data.Text (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
+class HasCard a => Page a where
-  card :: a -> HtmlGenerator ()
   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)
+          optional faviconLink =<< (Blog.get $skin.$favicon)
-          card aPage
+          optional (Card.make aPage) =<< (Blog.get $urls.$site)
           (Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
         )
       body_ (do

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"

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)

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
     }