Require separate RSS and Open Graph cards flags instead of an implicit '--site-url' triggering cards

This commit is contained in:
Tissevert 2020-03-23 16:10:44 +01:00
parent 77fc715294
commit dfd3a78b79
3 changed files with 18 additions and 10 deletions

View File

@ -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"

View File

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

View File

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