{-# LANGUAGE DeriveLift         #-}
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 qualified Data.List as 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 -> [Char]
(Int -> Scheme -> ShowS)
-> (Scheme -> [Char]) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scheme -> ShowS
showsPrec :: Int -> Scheme -> ShowS
$cshow :: Scheme -> [Char]
show :: Scheme -> [Char]
$cshowList :: [Scheme] -> ShowS
showList :: [Scheme] -> ShowS
Show, Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
/= :: 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
$ccompare :: Scheme -> Scheme -> Ordering
compare :: Scheme -> Scheme -> Ordering
$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
>= :: Scheme -> Scheme -> Bool
$cmax :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
min :: Scheme -> Scheme -> 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
$cfrom :: forall x. Scheme -> Rep Scheme x
from :: forall x. Scheme -> Rep Scheme x
$cto :: forall x. Rep Scheme x -> Scheme
to :: forall x. Rep Scheme x -> Scheme
Generic, (forall (m :: Type -> Type). Quote m => Scheme -> m Exp)
-> (forall (m :: Type -> Type). Quote m => Scheme -> Code m Scheme)
-> Lift Scheme
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (m :: Type -> Type). Quote m => Scheme -> m Exp
forall (m :: Type -> Type). Quote m => Scheme -> Code m Scheme
$clift :: forall (m :: Type -> Type). Quote m => Scheme -> m Exp
lift :: forall (m :: Type -> Type). Quote m => Scheme -> m Exp
$cliftTyped :: forall (m :: Type -> Type). Quote m => Scheme -> Code m Scheme
liftTyped :: forall (m :: Type -> Type). Quote m => Scheme -> Code m Scheme
Lift, Typeable Scheme
Typeable Scheme =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Scheme -> c Scheme)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Scheme)
-> (Scheme -> Constr)
-> (Scheme -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Scheme))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    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 :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> Data Scheme
Scheme -> Constr
Scheme -> DataType
(forall b. Data b => b -> b) -> Scheme -> Scheme
forall a.
Typeable a =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    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 :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    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 :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
$ctoConstr :: Scheme -> Constr
toConstr :: Scheme -> Constr
$cdataTypeOf :: Scheme -> DataType
dataTypeOf :: Scheme -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
$cgmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
gmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m 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 -> [Char]
baseUrlHost   :: String   -- ^ host (eg "haskell.org")
  , BaseUrl -> Int
baseUrlPort   :: Int      -- ^ port (eg 80)
  , BaseUrl -> [Char]
baseUrlPath   :: String   -- ^ path (eg "/a/b/c")
  } deriving (Int -> BaseUrl -> ShowS
[BaseUrl] -> ShowS
BaseUrl -> [Char]
(Int -> BaseUrl -> ShowS)
-> (BaseUrl -> [Char]) -> ([BaseUrl] -> ShowS) -> Show BaseUrl
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BaseUrl -> ShowS
showsPrec :: Int -> BaseUrl -> ShowS
$cshow :: BaseUrl -> [Char]
show :: BaseUrl -> [Char]
$cshowList :: [BaseUrl] -> ShowS
showList :: [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
$ccompare :: BaseUrl -> BaseUrl -> Ordering
compare :: BaseUrl -> BaseUrl -> Ordering
$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
>= :: BaseUrl -> BaseUrl -> Bool
$cmax :: BaseUrl -> BaseUrl -> BaseUrl
max :: BaseUrl -> BaseUrl -> BaseUrl
$cmin :: BaseUrl -> BaseUrl -> BaseUrl
min :: BaseUrl -> BaseUrl -> 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
$cfrom :: forall x. BaseUrl -> Rep BaseUrl x
from :: forall x. BaseUrl -> Rep BaseUrl x
$cto :: forall x. Rep BaseUrl x -> BaseUrl
to :: forall x. Rep BaseUrl x -> BaseUrl
Generic, (forall (m :: Type -> Type). Quote m => BaseUrl -> m Exp)
-> (forall (m :: Type -> Type).
    Quote m =>
    BaseUrl -> Code m BaseUrl)
-> Lift BaseUrl
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (m :: Type -> Type). Quote m => BaseUrl -> m Exp
forall (m :: Type -> Type). Quote m => BaseUrl -> Code m BaseUrl
$clift :: forall (m :: Type -> Type). Quote m => BaseUrl -> m Exp
lift :: forall (m :: Type -> Type). Quote m => BaseUrl -> m Exp
$cliftTyped :: forall (m :: Type -> Type). Quote m => BaseUrl -> Code m BaseUrl
liftTyped :: forall (m :: Type -> Type). Quote m => BaseUrl -> Code m BaseUrl
Lift, Typeable BaseUrl
Typeable BaseUrl =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BaseUrl -> c BaseUrl)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BaseUrl)
-> (BaseUrl -> Constr)
-> (BaseUrl -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BaseUrl))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    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 :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl)
-> Data BaseUrl
BaseUrl -> Constr
BaseUrl -> DataType
(forall b. Data b => b -> b) -> BaseUrl -> BaseUrl
forall a.
Typeable a =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    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 :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    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 :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseUrl
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseUrl -> c BaseUrl
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BaseUrl)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseUrl)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseUrl -> c BaseUrl
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseUrl -> c BaseUrl
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseUrl
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseUrl
$ctoConstr :: BaseUrl -> Constr
toConstr :: BaseUrl -> Constr
$cdataTypeOf :: BaseUrl -> DataType
dataTypeOf :: BaseUrl -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BaseUrl)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BaseUrl)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseUrl)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseUrl)
$cgmapT :: (forall b. Data b => b -> b) -> BaseUrl -> BaseUrl
gmapT :: (forall b. Data b => b -> b) -> BaseUrl -> BaseUrl
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BaseUrl -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BaseUrl -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BaseUrl -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BaseUrl -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BaseUrl -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BaseUrl -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl
Data)
-- TODO: Ord is more precise than Eq
-- TODO: Add Hashable instance?
--
instance NFData BaseUrl where
  rnf :: BaseUrl -> ()
rnf (BaseUrl Scheme
a [Char]
b Int
c [Char]
d) = Scheme
a Scheme -> () -> ()
forall a b. a -> b -> b
`seq` [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
b () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
c () -> () -> ()
forall a b. a -> b -> b
`seq` [Char] -> ()
forall a. NFData a => a -> ()
rnf [Char]
d

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

-- | >>> traverse_ (LBS8.putStrLn . encode) (parseBaseUrl "api.example.com" :: [BaseUrl])
-- "http://api.example.com"
instance ToJSON BaseUrl where
    toJSON :: BaseUrl -> Value
toJSON     = [Char] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Char] -> Value) -> (BaseUrl -> [Char]) -> BaseUrl -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> [Char]
showBaseUrl
    toEncoding :: BaseUrl -> Encoding
toEncoding = [Char] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding ([Char] -> Encoding) -> (BaseUrl -> [Char]) -> BaseUrl -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> [Char]
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 = [Char] -> (Text -> Parser BaseUrl) -> Value -> Parser BaseUrl
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"BaseUrl" ((Text -> Parser BaseUrl) -> Value -> Parser BaseUrl)
-> (Text -> Parser BaseUrl) -> Value -> Parser BaseUrl
forall a b. (a -> b) -> a -> b
$ \Text
t -> case [Char] -> Maybe BaseUrl
forall (m :: Type -> Type). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl (Text -> [Char]
T.unpack Text
t) of
        Just BaseUrl
u  -> BaseUrl -> Parser BaseUrl
forall a. a -> Parser a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BaseUrl
u
        Maybe BaseUrl
Nothing -> [Char] -> Parser BaseUrl
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser BaseUrl) -> [Char] -> Parser BaseUrl
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid base url: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t

-- | >>> :{
-- traverse_ (LBS8.putStrLn . encode) $ do
--   u1 <- parseBaseUrl "api.example.com" :: [BaseUrl]
--   u2 <- parseBaseUrl "example.com" :: [BaseUrl]
--   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 -> [Char])
-> ToJSONKeyFunction [Char] -> ToJSONKeyFunction BaseUrl
forall b a. (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
contramapToJSONKeyFunction BaseUrl -> [Char]
showBaseUrl ToJSONKeyFunction [Char]
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 [Char] -> Maybe BaseUrl
forall (m :: Type -> Type). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl (Text -> [Char]
T.unpack Text
t) of
        Just BaseUrl
u  -> BaseUrl -> Parser BaseUrl
forall a. a -> Parser a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BaseUrl
u
        Maybe BaseUrl
Nothing -> [Char] -> Parser BaseUrl
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser BaseUrl) -> [Char] -> Parser BaseUrl
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid base url: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t

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

newtype InvalidBaseUrlException = InvalidBaseUrlException String deriving (Int -> InvalidBaseUrlException -> ShowS
[InvalidBaseUrlException] -> ShowS
InvalidBaseUrlException -> [Char]
(Int -> InvalidBaseUrlException -> ShowS)
-> (InvalidBaseUrlException -> [Char])
-> ([InvalidBaseUrlException] -> ShowS)
-> Show InvalidBaseUrlException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidBaseUrlException -> ShowS
showsPrec :: Int -> InvalidBaseUrlException -> ShowS
$cshow :: InvalidBaseUrlException -> [Char]
show :: InvalidBaseUrlException -> [Char]
$cshowList :: [InvalidBaseUrlException] -> ShowS
showList :: [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 :: forall (m :: Type -> Type). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl [Char]
s = case [Char] -> Maybe URI
parseURI (ShowS
removeTrailingSlash [Char]
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 [Char]
"http:" (Just (URIAuth [Char]
"" [Char]
host (Char
':' : ([Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe -> Just Int
port)))) [Char]
path [Char]
"" [Char]
"") ->
    BaseUrl -> m BaseUrl
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Scheme -> [Char] -> Int -> [Char] -> BaseUrl
BaseUrl Scheme
Http [Char]
host Int
port [Char]
path)
  Just (URI [Char]
"http:" (Just (URIAuth [Char]
"" [Char]
host [Char]
"")) [Char]
path [Char]
"" [Char]
"") ->
    BaseUrl -> m BaseUrl
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Scheme -> [Char] -> Int -> [Char] -> BaseUrl
BaseUrl Scheme
Http [Char]
host Int
80 [Char]
path)
  Just (URI [Char]
"https:" (Just (URIAuth [Char]
"" [Char]
host (Char
':' : ([Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe -> Just Int
port)))) [Char]
path [Char]
"" [Char]
"") ->
    BaseUrl -> m BaseUrl
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Scheme -> [Char] -> Int -> [Char] -> BaseUrl
BaseUrl Scheme
Https [Char]
host Int
port [Char]
path)
  Just (URI [Char]
"https:" (Just (URIAuth [Char]
"" [Char]
host [Char]
"")) [Char]
path [Char]
"" [Char]
"") ->
    BaseUrl -> m BaseUrl
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Scheme -> [Char] -> Int -> [Char] -> BaseUrl
BaseUrl Scheme
Https [Char]
host Int
443 [Char]
path)
  Maybe URI
_ -> if [Char]
"://" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` [Char]
s
    then InvalidBaseUrlException -> m BaseUrl
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM ([Char] -> InvalidBaseUrlException
InvalidBaseUrlException ([Char] -> InvalidBaseUrlException)
-> [Char] -> InvalidBaseUrlException
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid base URL: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s)
    else [Char] -> m BaseUrl
forall (m :: Type -> Type). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl ([Char]
"http://" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s)
 where
  removeTrailingSlash :: ShowS
removeTrailingSlash [Char]
str = case [Char] -> Maybe Char
forall a. [a] -> Maybe a
lastMay [Char]
str of
    Just Char
'/' -> ShowS
forall a. HasCallStack => [a] -> [a]
init [Char]
str
    Maybe Char
_ -> [Char]
str

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