hablo/src/Blog/URL.hs

46 lines
1.4 KiB
Haskell

{-# 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)
import System.Exit (die)
import System.IO (hPutStrLn, stderr)
import Text.Printf (printf)
data URL = URL {
cards :: Maybe String
, comments :: Maybe String
, rss :: Maybe String
} deriving Generic
instance ToJSON URL where
toEncoding (URL {comments}) = pairs (
"comments" .= comments
)
build :: Arguments -> IO URL
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
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 ()