39 lines
1.1 KiB
Haskell
39 lines
1.1 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 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 (Arguments.openGraphCards arguments) "Open Graph cards"
|
|
rss <- getSiteURL (Arguments.rss arguments) "RSS feeds"
|
|
return $ URL {cards, comments, rss}
|
|
where
|
|
comments = Arguments.commentsURL 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
|