{-# 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 {
URL -> Maybe String
cards :: Maybe String
, :: Maybe String
, :: Maybe String
} deriving (forall x. URL -> Rep URL x)
-> (forall x. Rep URL x -> URL) -> Generic URL
forall x. Rep URL x -> URL
forall x. URL -> Rep URL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URL x -> URL
$cfrom :: forall x. URL -> Rep URL x
Generic
instance ToJSON URL where
toEncoding :: URL -> Encoding
toEncoding (URL {Maybe String
comments :: Maybe String
comments :: URL -> Maybe String
comments}) = Series -> Encoding
pairs (
Text
"comments" Text -> Maybe String -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
comments
)
build :: Arguments -> IO URL
build :: Arguments -> IO URL
build Arguments
arguments = do
Maybe String
cards <- Bool -> String -> IO (Maybe String)
getSiteURL Bool
argOGCards String
"Open Graph cards"
Maybe String
rss <- Bool -> String -> IO (Maybe String)
getSiteURL Bool
argRSS String
"RSS feeds"
Bool -> Maybe String -> IO ()
forall a. Bool -> Maybe a -> IO ()
checksUsed (Bool
argOGCards Bool -> Bool -> Bool
|| Bool
argRSS) Maybe String
siteURL
URL -> IO URL
forall (m :: * -> *) a. Monad m => a -> m a
return (URL -> IO URL) -> URL -> IO URL
forall a b. (a -> b) -> a -> b
$ URL :: Maybe String -> Maybe String -> Maybe String -> URL
URL {Maybe String
cards :: Maybe String
cards :: Maybe String
cards, Maybe String
comments :: Maybe String
comments :: Maybe String
comments, Maybe String
rss :: Maybe String
rss :: Maybe String
rss}
where
comments :: Maybe String
comments = Arguments -> Maybe String
Arguments.commentsURL Arguments
arguments
siteURL :: Maybe String
siteURL = Arguments -> Maybe String
Arguments.siteURL Arguments
arguments
argOGCards :: Bool
argOGCards = Arguments -> Bool
Arguments.openGraphCards Arguments
arguments
argRSS :: Bool
argRSS = Arguments -> Bool
Arguments.rss Arguments
arguments
errorMsg :: String -> String
errorMsg :: String -> String
errorMsg = String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Enabling %s requires setting the site url with --site-url"
getSiteURL :: Bool -> String -> IO (Maybe String)
getSiteURL Bool
False String
_ = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
getSiteURL Bool
True String
name = IO (Maybe String)
-> (String -> IO (Maybe String))
-> Maybe String
-> IO (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO (Maybe String)
forall a. String -> IO a
die (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> String
errorMsg String
name) (Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> (String -> Maybe String) -> String -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just) Maybe String
siteURL
checksUsed :: Bool -> Maybe a -> IO ()
checksUsed Bool
False (Just a
_) =
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Site url is set but not used, did you forget --open-graph-cards or --rss ?"
checksUsed Bool
_ Maybe a
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()