From dfd3a78b79d6c8833008aa1416a006778cb4c541 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Mon, 23 Mar 2020 16:10:44 +0100
Subject: [PATCH] Require separate RSS and Open Graph cards flags instead of an
 implicit '--site-url' triggering cards

---
 src/Arguments.hs |  8 +++-----
 src/Blog/URL.hs  | 18 ++++++++++++++----
 src/DOM.hs       |  2 +-
 3 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/src/Arguments.hs b/src/Arguments.hs
index 4733555..81b86b6 100644
--- a/src/Arguments.hs
+++ b/src/Arguments.hs
@@ -23,6 +23,7 @@ data Arguments = BlogConfig {
     , favicon :: Maybe FilePath
     , headPath :: Maybe FilePath
     , name :: Maybe String
+    , openGraphCards :: Bool
     , pagesPath :: Maybe FilePath
     , previewArticlesCount :: Int
     , previewLinesCount :: Int
@@ -59,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 "openGraphCards" <> help "enable Open Graph cards")
   <*> option filePath 'p' "pages"
         "DIRECTORY" "relative path to the directory containing the pages within INPUT_DIR"
   <*> Optparse.option auto (
@@ -77,11 +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"
-      )
+  <*> 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/Blog/URL.hs b/src/Blog/URL.hs
index 4e56d64..1271734 100644
--- a/src/Blog/URL.hs
+++ b/src/Blog/URL.hs
@@ -10,10 +10,13 @@ import Arguments (Arguments)
 import qualified Arguments as Arguments (Arguments(..))
 import Data.Aeson (ToJSON(..), (.=), pairs)
 import GHC.Generics (Generic)
+import System.Exit (die)
+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 +25,14 @@ instance ToJSON URL where
     )
 
 build :: Arguments -> IO URL
-build arguments = return $ URL {comments, site}
+build arguments = do
+  cards <- getSiteURL (Arguments.openGraphCards arguments) "Open Graph cards"
+  rss <- getSiteURL (Arguments.rss arguments) "RSS feeds"
+  return $ URL {cards, comments, rss}
   where
     comments = Arguments.commentsURL arguments
-    site = Arguments.siteURL arguments
+    siteURL = Arguments.siteURL 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
diff --git a/src/DOM.hs b/src/DOM.hs
index 4955f53..4c9979a 100644
--- a/src/DOM.hs
+++ b/src/DOM.hs
@@ -81,7 +81,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