{-# 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 ()