{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DeriveLift         #-}
{-# LANGUAGE ViewPatterns       #-}
module Servant.Client.Core.BaseUrl (
    BaseUrl (..),
    Scheme (..),
    showBaseUrl,
    parseBaseUrl,
    InvalidBaseUrlException (..),
    ) where

import           Control.DeepSeq
                 (NFData (..))
import           Control.Monad.Catch
                 (Exception, MonadThrow, throwM)
import           Data.Aeson
                 (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))
import           Data.Aeson.Types
                 (FromJSONKeyFunction (..), contramapToJSONKeyFunction,
                 withText)
import           Data.Data
                 (Data)
import           Data.List
import qualified Data.Text                  as T
import           GHC.Generics
import           Language.Haskell.TH.Syntax
                 (Lift)
import           Network.URI                hiding
                 (path)
import           Safe
import           Text.Read

-- | URI scheme to use
data Scheme =
    Http  -- ^ http://
  | Https -- ^ https://
  deriving (Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scheme] -> ShowS
$cshowList :: [Scheme] -> ShowS
show :: Scheme -> String
$cshow :: Scheme -> String
showsPrec :: Int -> Scheme -> ShowS
$cshowsPrec :: Int -> Scheme -> ShowS
Show, Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c== :: Scheme -> Scheme -> Bool
Eq, Eq Scheme
Eq Scheme
-> (Scheme -> Scheme -> Ordering)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Scheme)
-> (Scheme -> Scheme -> Scheme)
-> Ord Scheme
Scheme -> Scheme -> Bool
Scheme -> Scheme -> Ordering
Scheme -> Scheme -> Scheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmax :: Scheme -> Scheme -> Scheme
>= :: Scheme -> Scheme -> Bool
$c>= :: Scheme -> Scheme -> Bool
> :: Scheme -> Scheme -> Bool
$c> :: Scheme -> Scheme -> Bool
<= :: Scheme -> Scheme -> Bool
$c<= :: Scheme -> Scheme -> Bool
< :: Scheme -> Scheme -> Bool
$c< :: Scheme -> Scheme -> Bool
compare :: Scheme -> Scheme -> Ordering
$ccompare :: Scheme -> Scheme -> Ordering
$cp1Ord :: Eq Scheme
Ord, (forall x. Scheme -> Rep Scheme x)
-> (forall x. Rep Scheme x -> Scheme) -> Generic Scheme
forall x. Rep Scheme x -> Scheme
forall x. Scheme -> Rep Scheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scheme x -> Scheme
$cfrom :: forall x. Scheme -> Rep Scheme x
Generic, Scheme -> Q Exp
Scheme -> Q (TExp Scheme)
(Scheme -> Q Exp) -> (Scheme -> Q (TExp Scheme)) -> Lift Scheme
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Scheme -> Q (TExp Scheme)
$cliftTyped :: Scheme -> Q (TExp Scheme)
lift :: Scheme -> Q Exp
$clift :: Scheme -> Q Exp
Lift, Typeable Scheme
DataType
Constr
Typeable Scheme
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Scheme -> c Scheme)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Scheme)
-> (Scheme -> Constr)
-> (Scheme -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Scheme))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme))
-> ((forall b. Data b => b -> b) -> Scheme -> Scheme)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Scheme -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Scheme -> r)
-> (forall u. (forall d. Data d => d -> u) -> Scheme -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> Data Scheme
Scheme -> DataType
Scheme -> Constr
(forall b. Data b => b -> b) -> Scheme -> Scheme
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
$cHttps :: Constr
$cHttp :: Constr
$tScheme :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapMp :: (forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapM :: (forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapQi :: Int -> (forall d. Data d => d -> u) -> Scheme -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
gmapQ :: (forall d. Data d => d -> u) -> Scheme -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
gmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
$cgmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Scheme)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
dataTypeOf :: Scheme -> DataType
$cdataTypeOf :: Scheme -> DataType
toConstr :: Scheme -> Constr
$ctoConstr :: Scheme -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
$cp1Data :: Typeable Scheme
Data)

-- | Simple data type to represent the target of HTTP requests
--   for servant's automatically-generated clients.
data BaseUrl = BaseUrl
  { BaseUrl -> Scheme
baseUrlScheme :: Scheme   -- ^ URI scheme to use
  , BaseUrl -> String
baseUrlHost   :: String   -- ^ host (eg "haskell.org")
  , BaseUrl -> Int
baseUrlPort   :: Int      -- ^ port (eg 80)
  , BaseUrl -> String
baseUrlPath   :: String   -- ^ path (eg "/a/b/c")
  } deriving (Int -> BaseUrl -> ShowS
[BaseUrl] -> ShowS
BaseUrl -> String
(Int -> BaseUrl -> ShowS)
-> (BaseUrl -> String) -> ([BaseUrl] -> ShowS) -> Show BaseUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseUrl] -> ShowS
$cshowList :: [BaseUrl] -> ShowS
show :: BaseUrl -> String
$cshow :: BaseUrl -> String
showsPrec :: Int -> BaseUrl -> ShowS
$cshowsPrec :: Int -> BaseUrl -> ShowS
Show, Eq BaseUrl
Eq BaseUrl
-> (BaseUrl -> BaseUrl -> Ordering)
-> (BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> Bool)
-> (BaseUrl -> BaseUrl -> BaseUrl)
-> (BaseUrl -> BaseUrl -> BaseUrl)
-> Ord BaseUrl
BaseUrl -> BaseUrl -> Bool
BaseUrl -> BaseUrl -> Ordering
BaseUrl -> BaseUrl -> BaseUrl
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BaseUrl -> BaseUrl -> BaseUrl
$cmin :: BaseUrl -> BaseUrl -> BaseUrl
max :: BaseUrl -> BaseUrl -> BaseUrl
$cmax :: BaseUrl -> BaseUrl -> BaseUrl
>= :: BaseUrl -> BaseUrl -> Bool
$c>= :: BaseUrl -> BaseUrl -> Bool
> :: BaseUrl -> BaseUrl -> Bool
$c> :: BaseUrl -> BaseUrl -> Bool
<= :: BaseUrl -> BaseUrl -> Bool
$c<= :: BaseUrl -> BaseUrl -> Bool
< :: BaseUrl -> BaseUrl -> Bool
$c< :: BaseUrl -> BaseUrl -> Bool
compare :: BaseUrl -> BaseUrl -> Ordering
$ccompare :: BaseUrl -> BaseUrl -> Ordering
$cp1Ord :: Eq BaseUrl
Ord, (forall x. BaseUrl -> Rep BaseUrl x)
-> (forall x. Rep BaseUrl x -> BaseUrl) -> Generic BaseUrl
forall x. Rep BaseUrl x -> BaseUrl
forall x. BaseUrl -> Rep BaseUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BaseUrl x -> BaseUrl
$cfrom :: forall x. BaseUrl -> Rep BaseUrl x
Generic, BaseUrl -> Q Exp
BaseUrl -> Q (TExp BaseUrl)
(BaseUrl -> Q Exp) -> (BaseUrl -> Q (TExp BaseUrl)) -> Lift BaseUrl
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: BaseUrl -> Q (TExp BaseUrl)
$cliftTyped :: BaseUrl -> Q (TExp BaseUrl)
lift :: BaseUrl -> Q Exp
$clift :: BaseUrl -> Q Exp
Lift, Typeable BaseUrl
DataType
Constr
Typeable BaseUrl
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BaseUrl -> c BaseUrl)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BaseUrl)
-> (BaseUrl -> Constr)
-> (BaseUrl -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BaseUrl))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseUrl))
-> ((forall b. Data b => b -> b) -> BaseUrl -> BaseUrl)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BaseUrl -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BaseUrl -> r)
-> (forall u. (forall d. Data d => d -> u) -> BaseUrl -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> BaseUrl -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl)
-> Data BaseUrl
BaseUrl -> DataType
BaseUrl -> Constr
(forall b. Data b => b -> b) -> BaseUrl -> BaseUrl
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseUrl -> c BaseUrl
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseUrl
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BaseUrl -> u
forall u. (forall d. Data d => d -> u) -> BaseUrl -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BaseUrl -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BaseUrl -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseUrl
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseUrl -> c BaseUrl
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BaseUrl)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseUrl)
$cBaseUrl :: Constr
$tBaseUrl :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
gmapMp :: (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
gmapM :: (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
gmapQi :: Int -> (forall d. Data d => d -> u) -> BaseUrl -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BaseUrl -> u
gmapQ :: (forall d. Data d => d -> u) -> BaseUrl -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BaseUrl -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BaseUrl -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BaseUrl -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BaseUrl -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BaseUrl -> r
gmapT :: (forall b. Data b => b -> b) -> BaseUrl -> BaseUrl
$cgmapT :: (forall b. Data b => b -> b) -> BaseUrl -> BaseUrl
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseUrl)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseUrl)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BaseUrl)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BaseUrl)
dataTypeOf :: BaseUrl -> DataType
$cdataTypeOf :: BaseUrl -> DataType
toConstr :: BaseUrl -> Constr
$ctoConstr :: BaseUrl -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseUrl
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseUrl
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseUrl -> c BaseUrl
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseUrl -> c BaseUrl
$cp1Data :: Typeable BaseUrl
Data)
-- TODO: Ord is more precise than Eq
-- TODO: Add Hashable instance?
--
instance NFData BaseUrl where
  rnf :: BaseUrl -> ()
rnf (BaseUrl Scheme
a String
b Int
c String
d) = Scheme
a Scheme -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
b () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
c () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
d

instance Eq BaseUrl where
    BaseUrl Scheme
a String
b Int
c String
path == :: BaseUrl -> BaseUrl -> Bool
== BaseUrl Scheme
a' String
b' Int
c' String
path'
        = Scheme
a Scheme -> Scheme -> Bool
forall a. Eq a => a -> a -> Bool
== Scheme
a' Bool -> Bool -> Bool
&& String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b' Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c' Bool -> Bool -> Bool
&& ShowS
s String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ShowS
s String
path'
        where s :: ShowS
s (Char
'/':String
x) = String
x
              s String
x       = String
x

-- | >>> traverse_ (LBS8.putStrLn . encode) $ parseBaseUrl "api.example.com"
-- "http://api.example.com"
instance ToJSON BaseUrl where
    toJSON :: BaseUrl -> Value
toJSON     = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (BaseUrl -> String) -> BaseUrl -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> String
showBaseUrl
    toEncoding :: BaseUrl -> Encoding
toEncoding = String -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (String -> Encoding) -> (BaseUrl -> String) -> BaseUrl -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> String
showBaseUrl

-- | >>> parseBaseUrl "api.example.com" >>= decode . encode :: Maybe BaseUrl
-- Just (BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""})
instance FromJSON BaseUrl where
    parseJSON :: Value -> Parser BaseUrl
parseJSON = String -> (Text -> Parser BaseUrl) -> Value -> Parser BaseUrl
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"BaseUrl" ((Text -> Parser BaseUrl) -> Value -> Parser BaseUrl)
-> (Text -> Parser BaseUrl) -> Value -> Parser BaseUrl
forall a b. (a -> b) -> a -> b
$ \Text
t -> case String -> Maybe BaseUrl
forall (m :: * -> *). MonadThrow m => String -> m BaseUrl
parseBaseUrl (Text -> String
T.unpack Text
t) of
        Just BaseUrl
u  -> BaseUrl -> Parser BaseUrl
forall (m :: * -> *) a. Monad m => a -> m a
return BaseUrl
u
        Maybe BaseUrl
Nothing -> String -> Parser BaseUrl
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser BaseUrl) -> String -> Parser BaseUrl
forall a b. (a -> b) -> a -> b
$ String
"Invalid base url: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t

-- | >>> :{
-- traverse_ (LBS8.putStrLn . encode) $ do
--   u1 <- parseBaseUrl "api.example.com"
--   u2 <- parseBaseUrl "example.com"
--   return $ Map.fromList [(u1, 'x'), (u2, 'y')]
-- :}
-- {"http://api.example.com":"x","http://example.com":"y"}
instance ToJSONKey BaseUrl where
    toJSONKey :: ToJSONKeyFunction BaseUrl
toJSONKey = (BaseUrl -> String)
-> ToJSONKeyFunction String -> ToJSONKeyFunction BaseUrl
forall b a. (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
contramapToJSONKeyFunction BaseUrl -> String
showBaseUrl ToJSONKeyFunction String
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey

instance FromJSONKey BaseUrl where
    fromJSONKey :: FromJSONKeyFunction BaseUrl
fromJSONKey = (Text -> Parser BaseUrl) -> FromJSONKeyFunction BaseUrl
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser BaseUrl) -> FromJSONKeyFunction BaseUrl)
-> (Text -> Parser BaseUrl) -> FromJSONKeyFunction BaseUrl
forall a b. (a -> b) -> a -> b
$ \Text
t -> case String -> Maybe BaseUrl
forall (m :: * -> *). MonadThrow m => String -> m BaseUrl
parseBaseUrl (Text -> String
T.unpack Text
t) of
        Just BaseUrl
u  -> BaseUrl -> Parser BaseUrl
forall (m :: * -> *) a. Monad m => a -> m a
return BaseUrl
u
        Maybe BaseUrl
Nothing -> String -> Parser BaseUrl
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser BaseUrl) -> String -> Parser BaseUrl
forall a b. (a -> b) -> a -> b
$ String
"Invalid base url: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t

-- | >>> showBaseUrl <$> parseBaseUrl "api.example.com"
-- "http://api.example.com"
showBaseUrl :: BaseUrl -> String
showBaseUrl :: BaseUrl -> String
showBaseUrl (BaseUrl Scheme
urlscheme String
host Int
port String
path) =
  String
schemeString String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"//" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String
portString String -> ShowS
</> String
path)
    where
      String
a </> :: String -> ShowS
</> String
b = if String
"/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b then String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b else String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:String
b
      schemeString :: String
schemeString = case Scheme
urlscheme of
        Scheme
Http  -> String
"http:"
        Scheme
Https -> String
"https:"
      portString :: String
portString = case (Scheme
urlscheme, Int
port) of
        (Scheme
Http, Int
80) -> String
""
        (Scheme
Https, Int
443) -> String
""
        (Scheme, Int)
_ -> String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
port

newtype InvalidBaseUrlException = InvalidBaseUrlException String deriving (Int -> InvalidBaseUrlException -> ShowS
[InvalidBaseUrlException] -> ShowS
InvalidBaseUrlException -> String
(Int -> InvalidBaseUrlException -> ShowS)
-> (InvalidBaseUrlException -> String)
-> ([InvalidBaseUrlException] -> ShowS)
-> Show InvalidBaseUrlException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidBaseUrlException] -> ShowS
$cshowList :: [InvalidBaseUrlException] -> ShowS
show :: InvalidBaseUrlException -> String
$cshow :: InvalidBaseUrlException -> String
showsPrec :: Int -> InvalidBaseUrlException -> ShowS
$cshowsPrec :: Int -> InvalidBaseUrlException -> ShowS
Show)
instance Exception InvalidBaseUrlException

-- |
--
-- >>> parseBaseUrl "api.example.com"
-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}
--
-- /Note:/ trailing slash is removed
--
-- >>> parseBaseUrl "api.example.com/"
-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}
--
-- >>> parseBaseUrl "api.example.com/dir/"
-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = "/dir"}
--
parseBaseUrl :: MonadThrow m => String -> m BaseUrl
parseBaseUrl :: String -> m BaseUrl
parseBaseUrl String
s = case String -> Maybe URI
parseURI (ShowS
removeTrailingSlash String
s) of
  -- This is a rather hacky implementation and should be replaced with something
  -- implemented in attoparsec (which is already a dependency anyhow (via aeson)).
  Just (URI String
"http:" (Just (URIAuth String
"" String
host (Char
':' : (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe -> Just Int
port)))) String
path String
"" String
"") ->
    BaseUrl -> m BaseUrl
forall (m :: * -> *) a. Monad m => a -> m a
return (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Http String
host Int
port String
path)
  Just (URI String
"http:" (Just (URIAuth String
"" String
host String
"")) String
path String
"" String
"") ->
    BaseUrl -> m BaseUrl
forall (m :: * -> *) a. Monad m => a -> m a
return (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Http String
host Int
80 String
path)
  Just (URI String
"https:" (Just (URIAuth String
"" String
host (Char
':' : (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe -> Just Int
port)))) String
path String
"" String
"") ->
    BaseUrl -> m BaseUrl
forall (m :: * -> *) a. Monad m => a -> m a
return (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
host Int
port String
path)
  Just (URI String
"https:" (Just (URIAuth String
"" String
host String
"")) String
path String
"" String
"") ->
    BaseUrl -> m BaseUrl
forall (m :: * -> *) a. Monad m => a -> m a
return (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
host Int
443 String
path)
  Maybe URI
_ -> if String
"://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s
    then InvalidBaseUrlException -> m BaseUrl
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> InvalidBaseUrlException
InvalidBaseUrlException (String -> InvalidBaseUrlException)
-> String -> InvalidBaseUrlException
forall a b. (a -> b) -> a -> b
$ String
"Invalid base URL: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
    else String -> m BaseUrl
forall (m :: * -> *). MonadThrow m => String -> m BaseUrl
parseBaseUrl (String
"http://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
 where
  removeTrailingSlash :: ShowS
removeTrailingSlash String
str = case String -> Maybe Char
forall a. [a] -> Maybe a
lastMay String
str of
    Just Char
'/' -> ShowS
forall a. [a] -> [a]
init String
str
    Maybe Char
_ -> String
str

-- $setup
--
-- >>> import Data.Aeson
-- >>> import Data.Foldable (traverse_)
-- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8
-- >>> import qualified Data.Map.Strict as Map