Merge branch 'main' into goSJW

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
 

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 !

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

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"
 

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
+title :: MonadReader Blog m => ArticlesList -> m String
-pageTitle (ArticlesList {full, tagged}) = title (full, tagged) <$> Blog.get wording
+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" []
+    getDescription (True, Nothing) = render "allPage" []
-    title (True, Just tag) = render "allTaggedPage" [("tag", pack tag)]
+    getDescription (True, Just tag) = render "allTaggedPage" [("tag", pack tag)]
-    title (False, Nothing) = render "latestPage" []
+    getDescription (False, Nothing) = render "latestPage" []
-    title (False, Just tag) = render "latestTaggedPage" [("tag", pack tag)]
+    getDescription (False, Just tag) =
+      render "latestTaggedPage" [("tag", pack tag)]
     
     
     

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
+      cards :: Maybe String
-    , site :: 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 ()

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)

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
@@ -80,7 +84,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

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
+    cardTitle <- ArticlesList.title al
-    description <- pageTitle 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"

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 Collection (Collection(..))
-import Control.Monad (forM)
+import qualified Collection (getAll)
 import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Reader (MonadReader(..), ReaderT)
+import Control.Monad.Reader (ReaderT, asks)
-import Data.List (sortOn)
+import qualified Data.Map as Map (elems)
-import Data.Map ((!))
-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 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
+  asks articles >>= generateArticles . Map.elems
-  generateArticles $ Map.elems articles
+  Collection.getAll >>= mapM_ generateCollection
-  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)

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
       )

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 ("<?xml  version=\"1.0\" encoding=\"UTF-8\" ?>" :: 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)