{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}

#ifdef LIFT_COMPAT
{-# LANGUAGE TemplateHaskell            #-}
#else
{-# LANGUAGE DeriveLift                 #-}
#endif
module URI.ByteString.Types where

-------------------------------------------------------------------------------
import Data.ByteString (ByteString)
import qualified Data.Map.Strict as M
import Data.Monoid
import Data.Semigroup as Semigroup
import Data.Typeable
import GHC.Generics
import Instances.TH.Lift ()
-------------------------------------------------------------------------------
import Prelude

-------------------------------------------------------------------------------
#ifdef LIFT_COMPAT
import           Language.Haskell.TH.Lift
import           Language.Haskell.TH.Syntax ()
#else
import           Language.Haskell.TH.Syntax
#endif

-- | Required first component to referring to a specification for the
-- remainder of the URI's components, e.g. "http" or "https"
newtype Scheme = Scheme {Scheme -> ByteString
schemeBS :: ByteString}
  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
$cshowsPrec :: Int -> Scheme -> ShowS
showsPrec :: Int -> Scheme -> ShowS
$cshow :: Scheme -> String
show :: Scheme -> String
$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, (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, Typeable, 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)

#ifdef LIFT_COMPAT
deriveLift ''Scheme
#else
deriving instance Lift Scheme
#endif

-------------------------------------------------------------------------------
newtype Host = Host {Host -> ByteString
hostBS :: ByteString}
  deriving (Int -> Host -> ShowS
[Host] -> ShowS
Host -> String
(Int -> Host -> ShowS)
-> (Host -> String) -> ([Host] -> ShowS) -> Show Host
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Host -> ShowS
showsPrec :: Int -> Host -> ShowS
$cshow :: Host -> String
show :: Host -> String
$cshowList :: [Host] -> ShowS
showList :: [Host] -> ShowS
Show, Host -> Host -> Bool
(Host -> Host -> Bool) -> (Host -> Host -> Bool) -> Eq Host
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
/= :: Host -> Host -> Bool
Eq, (forall x. Host -> Rep Host x)
-> (forall x. Rep Host x -> Host) -> Generic Host
forall x. Rep Host x -> Host
forall x. Host -> Rep Host x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Host -> Rep Host x
from :: forall x. Host -> Rep Host x
$cto :: forall x. Rep Host x -> Host
to :: forall x. Rep Host x -> Host
Generic, Typeable, Eq Host
Eq Host =>
(Host -> Host -> Ordering)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Host)
-> (Host -> Host -> Host)
-> Ord Host
Host -> Host -> Bool
Host -> Host -> Ordering
Host -> Host -> Host
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 :: Host -> Host -> Ordering
compare :: Host -> Host -> Ordering
$c< :: Host -> Host -> Bool
< :: Host -> Host -> Bool
$c<= :: Host -> Host -> Bool
<= :: Host -> Host -> Bool
$c> :: Host -> Host -> Bool
> :: Host -> Host -> Bool
$c>= :: Host -> Host -> Bool
>= :: Host -> Host -> Bool
$cmax :: Host -> Host -> Host
max :: Host -> Host -> Host
$cmin :: Host -> Host -> Host
min :: Host -> Host -> Host
Ord)

#ifdef LIFT_COMPAT
deriveLift ''Host
#else
deriving instance Lift Host
#endif

-------------------------------------------------------------------------------

-- | While some libraries have chosen to limit this to a Word16, the
-- spec only specifies that the string be comprised of digits.
newtype Port = Port {Port -> Int
portNumber :: Int}
  deriving (Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Port -> ShowS
showsPrec :: Int -> Port -> ShowS
$cshow :: Port -> String
show :: Port -> String
$cshowList :: [Port] -> ShowS
showList :: [Port] -> ShowS
Show, Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
/= :: Port -> Port -> Bool
Eq, (forall x. Port -> Rep Port x)
-> (forall x. Rep Port x -> Port) -> Generic Port
forall x. Rep Port x -> Port
forall x. Port -> Rep Port x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Port -> Rep Port x
from :: forall x. Port -> Rep Port x
$cto :: forall x. Rep Port x -> Port
to :: forall x. Rep Port x -> Port
Generic, Typeable, Eq Port
Eq Port =>
(Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
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 :: Port -> Port -> Ordering
compare :: Port -> Port -> Ordering
$c< :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
>= :: Port -> Port -> Bool
$cmax :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
min :: Port -> Port -> Port
Ord)

#ifdef LIFT_COMPAT
deriveLift ''Port
#else
deriving instance Lift Port
#endif

-------------------------------------------------------------------------------
data UserInfo = UserInfo
  { UserInfo -> ByteString
uiUsername :: ByteString,
    UserInfo -> ByteString
uiPassword :: ByteString
  }
  deriving (Int -> UserInfo -> ShowS
[UserInfo] -> ShowS
UserInfo -> String
(Int -> UserInfo -> ShowS)
-> (UserInfo -> String) -> ([UserInfo] -> ShowS) -> Show UserInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserInfo -> ShowS
showsPrec :: Int -> UserInfo -> ShowS
$cshow :: UserInfo -> String
show :: UserInfo -> String
$cshowList :: [UserInfo] -> ShowS
showList :: [UserInfo] -> ShowS
Show, UserInfo -> UserInfo -> Bool
(UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool) -> Eq UserInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserInfo -> UserInfo -> Bool
== :: UserInfo -> UserInfo -> Bool
$c/= :: UserInfo -> UserInfo -> Bool
/= :: UserInfo -> UserInfo -> Bool
Eq, (forall x. UserInfo -> Rep UserInfo x)
-> (forall x. Rep UserInfo x -> UserInfo) -> Generic UserInfo
forall x. Rep UserInfo x -> UserInfo
forall x. UserInfo -> Rep UserInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserInfo -> Rep UserInfo x
from :: forall x. UserInfo -> Rep UserInfo x
$cto :: forall x. Rep UserInfo x -> UserInfo
to :: forall x. Rep UserInfo x -> UserInfo
Generic, Typeable, Eq UserInfo
Eq UserInfo =>
(UserInfo -> UserInfo -> Ordering)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> UserInfo)
-> (UserInfo -> UserInfo -> UserInfo)
-> Ord UserInfo
UserInfo -> UserInfo -> Bool
UserInfo -> UserInfo -> Ordering
UserInfo -> UserInfo -> UserInfo
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 :: UserInfo -> UserInfo -> Ordering
compare :: UserInfo -> UserInfo -> Ordering
$c< :: UserInfo -> UserInfo -> Bool
< :: UserInfo -> UserInfo -> Bool
$c<= :: UserInfo -> UserInfo -> Bool
<= :: UserInfo -> UserInfo -> Bool
$c> :: UserInfo -> UserInfo -> Bool
> :: UserInfo -> UserInfo -> Bool
$c>= :: UserInfo -> UserInfo -> Bool
>= :: UserInfo -> UserInfo -> Bool
$cmax :: UserInfo -> UserInfo -> UserInfo
max :: UserInfo -> UserInfo -> UserInfo
$cmin :: UserInfo -> UserInfo -> UserInfo
min :: UserInfo -> UserInfo -> UserInfo
Ord)

#ifdef LIFT_COMPAT
deriveLift ''UserInfo
#else
deriving instance Lift UserInfo
#endif

-------------------------------------------------------------------------------
data Authority = Authority
  { Authority -> Maybe UserInfo
authorityUserInfo :: Maybe UserInfo,
    Authority -> Host
authorityHost :: Host,
    Authority -> Maybe Port
authorityPort :: Maybe Port
  }
  deriving (Int -> Authority -> ShowS
[Authority] -> ShowS
Authority -> String
(Int -> Authority -> ShowS)
-> (Authority -> String)
-> ([Authority] -> ShowS)
-> Show Authority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Authority -> ShowS
showsPrec :: Int -> Authority -> ShowS
$cshow :: Authority -> String
show :: Authority -> String
$cshowList :: [Authority] -> ShowS
showList :: [Authority] -> ShowS
Show, Authority -> Authority -> Bool
(Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool) -> Eq Authority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Authority -> Authority -> Bool
== :: Authority -> Authority -> Bool
$c/= :: Authority -> Authority -> Bool
/= :: Authority -> Authority -> Bool
Eq, (forall x. Authority -> Rep Authority x)
-> (forall x. Rep Authority x -> Authority) -> Generic Authority
forall x. Rep Authority x -> Authority
forall x. Authority -> Rep Authority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Authority -> Rep Authority x
from :: forall x. Authority -> Rep Authority x
$cto :: forall x. Rep Authority x -> Authority
to :: forall x. Rep Authority x -> Authority
Generic, Typeable, Eq Authority
Eq Authority =>
(Authority -> Authority -> Ordering)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Authority)
-> (Authority -> Authority -> Authority)
-> Ord Authority
Authority -> Authority -> Bool
Authority -> Authority -> Ordering
Authority -> Authority -> Authority
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 :: Authority -> Authority -> Ordering
compare :: Authority -> Authority -> Ordering
$c< :: Authority -> Authority -> Bool
< :: Authority -> Authority -> Bool
$c<= :: Authority -> Authority -> Bool
<= :: Authority -> Authority -> Bool
$c> :: Authority -> Authority -> Bool
> :: Authority -> Authority -> Bool
$c>= :: Authority -> Authority -> Bool
>= :: Authority -> Authority -> Bool
$cmax :: Authority -> Authority -> Authority
max :: Authority -> Authority -> Authority
$cmin :: Authority -> Authority -> Authority
min :: Authority -> Authority -> Authority
Ord)

#ifdef LIFT_COMPAT
deriveLift ''Authority
#else
deriving instance Lift Authority
#endif

-------------------------------------------------------------------------------
newtype Query = Query {Query -> [(ByteString, ByteString)]
queryPairs :: [(ByteString, ByteString)]}
  deriving (Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Query -> ShowS
showsPrec :: Int -> Query -> ShowS
$cshow :: Query -> String
show :: Query -> String
$cshowList :: [Query] -> ShowS
showList :: [Query] -> ShowS
Show, Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
/= :: Query -> Query -> Bool
Eq, NonEmpty Query -> Query
Query -> Query -> Query
(Query -> Query -> Query)
-> (NonEmpty Query -> Query)
-> (forall b. Integral b => b -> Query -> Query)
-> Semigroup Query
forall b. Integral b => b -> Query -> Query
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Query -> Query -> Query
<> :: Query -> Query -> Query
$csconcat :: NonEmpty Query -> Query
sconcat :: NonEmpty Query -> Query
$cstimes :: forall b. Integral b => b -> Query -> Query
stimes :: forall b. Integral b => b -> Query -> Query
Semigroup.Semigroup, Semigroup Query
Query
Semigroup Query =>
Query
-> (Query -> Query -> Query) -> ([Query] -> Query) -> Monoid Query
[Query] -> Query
Query -> Query -> Query
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Query
mempty :: Query
$cmappend :: Query -> Query -> Query
mappend :: Query -> Query -> Query
$cmconcat :: [Query] -> Query
mconcat :: [Query] -> Query
Monoid, (forall x. Query -> Rep Query x)
-> (forall x. Rep Query x -> Query) -> Generic Query
forall x. Rep Query x -> Query
forall x. Query -> Rep Query x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Query -> Rep Query x
from :: forall x. Query -> Rep Query x
$cto :: forall x. Rep Query x -> Query
to :: forall x. Rep Query x -> Query
Generic, Typeable, Eq Query
Eq Query =>
(Query -> Query -> Ordering)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Query)
-> (Query -> Query -> Query)
-> Ord Query
Query -> Query -> Bool
Query -> Query -> Ordering
Query -> Query -> Query
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 :: Query -> Query -> Ordering
compare :: Query -> Query -> Ordering
$c< :: Query -> Query -> Bool
< :: Query -> Query -> Bool
$c<= :: Query -> Query -> Bool
<= :: Query -> Query -> Bool
$c> :: Query -> Query -> Bool
> :: Query -> Query -> Bool
$c>= :: Query -> Query -> Bool
>= :: Query -> Query -> Bool
$cmax :: Query -> Query -> Query
max :: Query -> Query -> Query
$cmin :: Query -> Query -> Query
min :: Query -> Query -> Query
Ord)

#ifdef LIFT_COMPAT
deriveLift ''Query
#else
deriving instance Lift Query
#endif

-------------------------------------------------------------------------------
data Absolute deriving (Typeable)

#ifdef LIFT_COMPAT
deriveLift ''Absolute
#else
deriving instance Lift Absolute
#endif

-------------------------------------------------------------------------------
data Relative deriving (Typeable)

#ifdef LIFT_COMPAT
deriveLift ''Relative
#else
deriving instance Lift Relative
#endif

-------------------------------------------------------------------------------

-- | Note: URI fragment does not include the #
data URIRef a where
  URI ::
    { URIRef Absolute -> Scheme
uriScheme :: Scheme,
      URIRef Absolute -> Maybe Authority
uriAuthority :: Maybe Authority,
      URIRef Absolute -> ByteString
uriPath :: ByteString,
      URIRef Absolute -> Query
uriQuery :: Query,
      URIRef Absolute -> Maybe ByteString
uriFragment :: Maybe ByteString
    } ->
    URIRef Absolute
  RelativeRef ::
    { URIRef Relative -> Maybe Authority
rrAuthority :: Maybe Authority,
      URIRef Relative -> ByteString
rrPath :: ByteString,
      URIRef Relative -> Query
rrQuery :: Query,
      URIRef Relative -> Maybe ByteString
rrFragment :: Maybe ByteString
    } ->
    URIRef Relative

deriving instance Show (URIRef a)

deriving instance Eq (URIRef a)

-- deriving instance Generic (URIRef a)
deriving instance Ord (URIRef a)

#ifdef LIFT_COMPAT
deriveLift ''URIRef
#else
deriving instance Lift (URIRef a)
#endif

#ifdef WITH_TYPEABLE
deriving instance Typeable URIRef
#endif

-------------------------------------------------------------------------------
type URI = URIRef Absolute

-------------------------------------------------------------------------------
type RelativeRef = URIRef Relative

-------------------------------------------------------------------------------

-- | Options for the parser. You will probably want to use either
-- "strictURIParserOptions" or "laxURIParserOptions"
data URIParserOptions = URIParserOptions
  { URIParserOptions -> Bool
upoLaxQueryParsing :: Bool
  }

-------------------------------------------------------------------------------
data URINormalizationOptions = URINormalizationOptions
  { -- | hTtP -> http
    URINormalizationOptions -> Bool
unoDowncaseScheme :: Bool,
    -- | eXaMpLe.org -> example.org
    URINormalizationOptions -> Bool
unoDowncaseHost :: Bool,
    -- | If the scheme is known and the port is the default (e.g. 80 for http) it is removed.
    URINormalizationOptions -> Bool
unoDropDefPort :: Bool,
    -- | If the path is empty, set it to \/
    URINormalizationOptions -> Bool
unoSlashEmptyPath :: Bool,
    -- | Rewrite path from \/foo\/\/bar\/\/\/baz to \/foo\/bar\/baz
    URINormalizationOptions -> Bool
unoDropExtraSlashes :: Bool,
    -- | Sorts parameters by parameter name
    URINormalizationOptions -> Bool
unoSortParameters :: Bool,
    -- | Remove dot segments as per <https://tools.ietf.org/html/rfc3986#section-5.2.4 RFC3986 Section 5.2.4>
    URINormalizationOptions -> Bool
unoRemoveDotSegments :: Bool,
    -- | Map of known schemes to their default ports. Used when 'unoDropDefPort' is enabled.
    URINormalizationOptions -> Map Scheme Port
unoDefaultPorts :: M.Map Scheme Port
  }
  deriving (Int -> URINormalizationOptions -> ShowS
[URINormalizationOptions] -> ShowS
URINormalizationOptions -> String
(Int -> URINormalizationOptions -> ShowS)
-> (URINormalizationOptions -> String)
-> ([URINormalizationOptions] -> ShowS)
-> Show URINormalizationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URINormalizationOptions -> ShowS
showsPrec :: Int -> URINormalizationOptions -> ShowS
$cshow :: URINormalizationOptions -> String
show :: URINormalizationOptions -> String
$cshowList :: [URINormalizationOptions] -> ShowS
showList :: [URINormalizationOptions] -> ShowS
Show, URINormalizationOptions -> URINormalizationOptions -> Bool
(URINormalizationOptions -> URINormalizationOptions -> Bool)
-> (URINormalizationOptions -> URINormalizationOptions -> Bool)
-> Eq URINormalizationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URINormalizationOptions -> URINormalizationOptions -> Bool
== :: URINormalizationOptions -> URINormalizationOptions -> Bool
$c/= :: URINormalizationOptions -> URINormalizationOptions -> Bool
/= :: URINormalizationOptions -> URINormalizationOptions -> Bool
Eq)

-------------------------------------------------------------------------------

-- | URI Parser Types

-------------------------------------------------------------------------------

data SchemaError
  = -- | Scheme must start with an alphabet character
    NonAlphaLeading
  | -- | Subsequent characters in the schema were invalid
    InvalidChars
  | -- | Schemas must be followed by a colon
    MissingColon
  deriving (Int -> SchemaError -> ShowS
[SchemaError] -> ShowS
SchemaError -> String
(Int -> SchemaError -> ShowS)
-> (SchemaError -> String)
-> ([SchemaError] -> ShowS)
-> Show SchemaError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaError -> ShowS
showsPrec :: Int -> SchemaError -> ShowS
$cshow :: SchemaError -> String
show :: SchemaError -> String
$cshowList :: [SchemaError] -> ShowS
showList :: [SchemaError] -> ShowS
Show, SchemaError -> SchemaError -> Bool
(SchemaError -> SchemaError -> Bool)
-> (SchemaError -> SchemaError -> Bool) -> Eq SchemaError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaError -> SchemaError -> Bool
== :: SchemaError -> SchemaError -> Bool
$c/= :: SchemaError -> SchemaError -> Bool
/= :: SchemaError -> SchemaError -> Bool
Eq, ReadPrec [SchemaError]
ReadPrec SchemaError
Int -> ReadS SchemaError
ReadS [SchemaError]
(Int -> ReadS SchemaError)
-> ReadS [SchemaError]
-> ReadPrec SchemaError
-> ReadPrec [SchemaError]
-> Read SchemaError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SchemaError
readsPrec :: Int -> ReadS SchemaError
$creadList :: ReadS [SchemaError]
readList :: ReadS [SchemaError]
$creadPrec :: ReadPrec SchemaError
readPrec :: ReadPrec SchemaError
$creadListPrec :: ReadPrec [SchemaError]
readListPrec :: ReadPrec [SchemaError]
Read, (forall x. SchemaError -> Rep SchemaError x)
-> (forall x. Rep SchemaError x -> SchemaError)
-> Generic SchemaError
forall x. Rep SchemaError x -> SchemaError
forall x. SchemaError -> Rep SchemaError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaError -> Rep SchemaError x
from :: forall x. SchemaError -> Rep SchemaError x
$cto :: forall x. Rep SchemaError x -> SchemaError
to :: forall x. Rep SchemaError x -> SchemaError
Generic, Typeable, Int -> SchemaError
SchemaError -> Int
SchemaError -> [SchemaError]
SchemaError -> SchemaError
SchemaError -> SchemaError -> [SchemaError]
SchemaError -> SchemaError -> SchemaError -> [SchemaError]
(SchemaError -> SchemaError)
-> (SchemaError -> SchemaError)
-> (Int -> SchemaError)
-> (SchemaError -> Int)
-> (SchemaError -> [SchemaError])
-> (SchemaError -> SchemaError -> [SchemaError])
-> (SchemaError -> SchemaError -> [SchemaError])
-> (SchemaError -> SchemaError -> SchemaError -> [SchemaError])
-> Enum SchemaError
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SchemaError -> SchemaError
succ :: SchemaError -> SchemaError
$cpred :: SchemaError -> SchemaError
pred :: SchemaError -> SchemaError
$ctoEnum :: Int -> SchemaError
toEnum :: Int -> SchemaError
$cfromEnum :: SchemaError -> Int
fromEnum :: SchemaError -> Int
$cenumFrom :: SchemaError -> [SchemaError]
enumFrom :: SchemaError -> [SchemaError]
$cenumFromThen :: SchemaError -> SchemaError -> [SchemaError]
enumFromThen :: SchemaError -> SchemaError -> [SchemaError]
$cenumFromTo :: SchemaError -> SchemaError -> [SchemaError]
enumFromTo :: SchemaError -> SchemaError -> [SchemaError]
$cenumFromThenTo :: SchemaError -> SchemaError -> SchemaError -> [SchemaError]
enumFromThenTo :: SchemaError -> SchemaError -> SchemaError -> [SchemaError]
Enum, SchemaError
SchemaError -> SchemaError -> Bounded SchemaError
forall a. a -> a -> Bounded a
$cminBound :: SchemaError
minBound :: SchemaError
$cmaxBound :: SchemaError
maxBound :: SchemaError
Bounded)

-------------------------------------------------------------------------------
data URIParseError
  = MalformedScheme SchemaError
  | MalformedUserInfo
  | MalformedQuery
  | MalformedFragment
  | MalformedHost
  | MalformedPort
  | MalformedPath
  | -- | Catchall for unpredictable errors
    OtherError String
  deriving (Int -> URIParseError -> ShowS
[URIParseError] -> ShowS
URIParseError -> String
(Int -> URIParseError -> ShowS)
-> (URIParseError -> String)
-> ([URIParseError] -> ShowS)
-> Show URIParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URIParseError -> ShowS
showsPrec :: Int -> URIParseError -> ShowS
$cshow :: URIParseError -> String
show :: URIParseError -> String
$cshowList :: [URIParseError] -> ShowS
showList :: [URIParseError] -> ShowS
Show, URIParseError -> URIParseError -> Bool
(URIParseError -> URIParseError -> Bool)
-> (URIParseError -> URIParseError -> Bool) -> Eq URIParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URIParseError -> URIParseError -> Bool
== :: URIParseError -> URIParseError -> Bool
$c/= :: URIParseError -> URIParseError -> Bool
/= :: URIParseError -> URIParseError -> Bool
Eq, (forall x. URIParseError -> Rep URIParseError x)
-> (forall x. Rep URIParseError x -> URIParseError)
-> Generic URIParseError
forall x. Rep URIParseError x -> URIParseError
forall x. URIParseError -> Rep URIParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. URIParseError -> Rep URIParseError x
from :: forall x. URIParseError -> Rep URIParseError x
$cto :: forall x. Rep URIParseError x -> URIParseError
to :: forall x. Rep URIParseError x -> URIParseError
Generic, ReadPrec [URIParseError]
ReadPrec URIParseError
Int -> ReadS URIParseError
ReadS [URIParseError]
(Int -> ReadS URIParseError)
-> ReadS [URIParseError]
-> ReadPrec URIParseError
-> ReadPrec [URIParseError]
-> Read URIParseError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS URIParseError
readsPrec :: Int -> ReadS URIParseError
$creadList :: ReadS [URIParseError]
readList :: ReadS [URIParseError]
$creadPrec :: ReadPrec URIParseError
readPrec :: ReadPrec URIParseError
$creadListPrec :: ReadPrec [URIParseError]
readListPrec :: ReadPrec [URIParseError]
Read, Typeable)