URL.hs

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