47 lines
1.4 KiB
Haskell
47 lines
1.4 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Blog.URL (
|
|
URLs(..)
|
|
, 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)
|
|
|
|
type URL = String
|
|
data URLs = URLs {
|
|
cards :: Maybe URL
|
|
, comments :: Maybe URL
|
|
, rss :: Maybe URL
|
|
} deriving Generic
|
|
|
|
instance ToJSON URLs where
|
|
toEncoding (URLs {comments}) = pairs (
|
|
"comments" .= comments
|
|
)
|
|
|
|
build :: Arguments -> IO URLs
|
|
build arguments = do
|
|
cards <- getSiteURL argOGCards "Open Graph cards"
|
|
rss <- getSiteURL argRSS "RSS feeds"
|
|
checksUsed (argOGCards || argRSS) siteURL
|
|
return $ URLs {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 ()
|