{-# LANGUAGE RecordWildCards, CPP #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE DeriveLift, StandaloneDeriving #-}
#else
{-# LANGUAGE TemplateHaskell #-}
#endif
#if MIN_VERSION_template_haskell(2,12,0) && MIN_VERSION_parsec(3,13,0)
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

--------------------------------------------------------------------------------
-- |
--  Module      :  Network.URI
--  Copyright   :  (c) 2004, Graham Klyne
--  License     :  BSD-style (see end of this file)
--
--  Maintainer  :  Graham Klyne <gk@ninebynine.org>
--  Stability   :  provisional
--  Portability :  portable
--
--  This module defines functions for handling URIs.  It presents
--  substantially the same interface as the older GHC Network.URI module, but
--  is implemented using Parsec rather than a Regex library that is not
--  available with Hugs.  The internal representation of URI has been changed
--  so that URI strings are more completely preserved when round-tripping to a
--  URI value and back.
--
--  In addition, four methods are provided for parsing different
--  kinds of URI string (as noted in RFC3986):
--      'parseURI',
--      'parseURIReference',
--      'parseRelativeReference' and
--      'parseAbsoluteURI'.
--
--  Further, four methods are provided for classifying different
--  kinds of URI string (as noted in RFC3986):
--      'isURI',
--      'isURIReference',
--      'isRelativeReference' and
--      'isAbsoluteURI'.
--
--  The long-standing official reference for URI handling was RFC2396 [1],
--  as updated by RFC 2732 [2], but this was replaced by a new specification,
--  RFC3986 [3] in January 2005.  This latter specification has been used
--  as the primary reference for constructing the URI parser implemented
--  here, and it is intended that there is a direct relationship between
--  the syntax definition in that document and this parser implementation.
--
--  RFC 1808 [4] contains a number of test cases for relative URI handling.
--  Dan Connolly's Python module @uripath.py@ [5] also contains useful details
--  and test cases.
--
--  Some of the code has been copied from the previous GHC implementation,
--  but the parser is replaced with one that performs more complete
--  syntax checking of the URI itself, according to RFC3986 [3].
--
--  References
--
--  (1) <http://www.ietf.org/rfc/rfc2396.txt>
--
--  (2) <http://www.ietf.org/rfc/rfc2732.txt>
--
--  (3) <http://www.ietf.org/rfc/rfc3986.txt>
--
--  (4) <http://www.ietf.org/rfc/rfc1808.txt>
--
--  (5) <http://www.w3.org/2000/10/swap/uripath.py>
--
--------------------------------------------------------------------------------

module Network.URI
    (
    -- * The URI type
      URI(..)
    , URIAuth(..)
    , nullURI
    , nullURIAuth

    , rectify, rectifyAuth

    -- * Parsing
    , parseURI
    , parseURIReference
    , parseRelativeReference
    , parseAbsoluteURI

    -- * Test for strings containing various kinds of URI
    , isURI
    , isURIReference
    , isRelativeReference
    , isAbsoluteURI
    , isIPv6address
    , isIPv4address

    -- * Predicates
    , uriIsAbsolute
    , uriIsRelative

    -- * Relative URIs
    , relativeTo
    , nonStrictRelativeTo
    , relativeFrom

    -- * Operations on URI strings
    -- | Support for putting strings into URI-friendly
    --   escaped format and getting them back again.
    --   This can't be done transparently in all cases, because certain
    --   characters have different meanings in different kinds of URI.
    --   The URI spec [3], section 2.4, indicates that all URI components
    --   should be escaped before they are assembled as a URI:
    --   \"Once produced, a URI is always in its percent-encoded form\"
    , uriToString, uriAuthToString
    , isReserved, isUnreserved
    , isAllowedInURI, isUnescapedInURI
    , isUnescapedInURIComponent
    , escapeURIChar
    , escapeURIString
    , unEscapeString
    , pathSegments

    -- * URI Normalization functions
    , normalizeCase
    , normalizeEscape
    , normalizePathSegments

    -- * Deprecated functions
    , parseabsoluteURI
    , escapeString
    , reserved, unreserved
    , scheme, authority, path, query, fragment
    ) where

import Text.ParserCombinators.Parsec
    ( GenParser, ParseError
    , parse, (<?>), try
    , option, many1, count, notFollowedBy
    , char, satisfy, oneOf, string, eof
    , unexpected
    )

import Control.Applicative
import Control.Monad (MonadPlus(..))
import Control.DeepSeq (NFData(rnf), deepseq)
import Data.Char (ord, chr, isHexDigit, toLower, toUpper, digitToInt)
import Data.Bits ((.|.),(.&.),shiftL,shiftR)
import Data.List (unfoldr, isPrefixOf, isSuffixOf)
import Numeric (showIntAtBase)

import Language.Haskell.TH.Syntax (Lift(..))

#if !MIN_VERSION_base(4,8,0)
import Data.Traversable (sequenceA)
#endif

import Data.Typeable (Typeable)
#if MIN_VERSION_base(4,0,0)
import Data.Data (Data)
#else
import Data.Generics (Data)
#endif

#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics (Generic)
#endif

------------------------------------------------------------
--  The URI datatype
------------------------------------------------------------

-- |Represents a general universal resource identifier using
--  its component parts.
--
--  For example, for the URI
--
--  >   foo://anonymous@www.haskell.org:42/ghc?query#frag
--
--  the components are:
--
data URI = URI
    { URI -> String
uriScheme     :: String           -- ^ @foo:@
    , URI -> Maybe URIAuth
uriAuthority  :: Maybe URIAuth    -- ^ @\/\/anonymous\@www.haskell.org:42@
    , URI -> String
uriPath       :: String           -- ^ @\/ghc@
    , URI -> String
uriQuery      :: String           -- ^ @?query@
    , URI -> String
uriFragment   :: String           -- ^ @#frag@
#if __GLASGOW_HASKELL__ >= 702
    } deriving (URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c== :: URI -> URI -> Bool
Eq, Eq URI
Eq URI
-> (URI -> URI -> Ordering)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> URI)
-> (URI -> URI -> URI)
-> Ord URI
URI -> URI -> Bool
URI -> URI -> Ordering
URI -> URI -> URI
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 :: URI -> URI -> URI
$cmin :: URI -> URI -> URI
max :: URI -> URI -> URI
$cmax :: URI -> URI -> URI
>= :: URI -> URI -> Bool
$c>= :: URI -> URI -> Bool
> :: URI -> URI -> Bool
$c> :: URI -> URI -> Bool
<= :: URI -> URI -> Bool
$c<= :: URI -> URI -> Bool
< :: URI -> URI -> Bool
$c< :: URI -> URI -> Bool
compare :: URI -> URI -> Ordering
$ccompare :: URI -> URI -> Ordering
$cp1Ord :: Eq URI
Ord, Typeable, Typeable URI
DataType
Constr
Typeable URI
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> URI -> c URI)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c URI)
-> (URI -> Constr)
-> (URI -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c URI))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI))
-> ((forall b. Data b => b -> b) -> URI -> URI)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r)
-> (forall u. (forall d. Data d => d -> u) -> URI -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> URI -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> URI -> m URI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> URI -> m URI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> URI -> m URI)
-> Data URI
URI -> DataType
URI -> Constr
(forall b. Data b => b -> b) -> URI -> URI
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URI -> c URI
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URI
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) -> URI -> u
forall u. (forall d. Data d => d -> u) -> URI -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URI -> m URI
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URI -> m URI
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URI
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URI -> c URI
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URI)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI)
$cURI :: Constr
$tURI :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> URI -> m URI
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URI -> m URI
gmapMp :: (forall d. Data d => d -> m d) -> URI -> m URI
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URI -> m URI
gmapM :: (forall d. Data d => d -> m d) -> URI -> m URI
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URI -> m URI
gmapQi :: Int -> (forall d. Data d => d -> u) -> URI -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> URI -> u
gmapQ :: (forall d. Data d => d -> u) -> URI -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> URI -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
gmapT :: (forall b. Data b => b -> b) -> URI -> URI
$cgmapT :: (forall b. Data b => b -> b) -> URI -> URI
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c URI)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URI)
dataTypeOf :: URI -> DataType
$cdataTypeOf :: URI -> DataType
toConstr :: URI -> Constr
$ctoConstr :: URI -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URI
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URI
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URI -> c URI
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URI -> c URI
$cp1Data :: Typeable URI
Data, (forall x. URI -> Rep URI x)
-> (forall x. Rep URI x -> URI) -> Generic URI
forall x. Rep URI x -> URI
forall x. URI -> Rep URI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URI x -> URI
$cfrom :: forall x. URI -> Rep URI x
Generic)
#else
    } deriving (Eq, Ord, Typeable, Data)
#endif

-- | Add a prefix to a string, unless it already has it.
ensurePrefix :: String -> String -> String
ensurePrefix :: String -> String -> String
ensurePrefix String
p String
s = if String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
p String
s then String
s else String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

-- | Add a suffix to a string, unless it already has it.
ensureSuffix :: String -> String -> String
ensureSuffix :: String -> String -> String
ensureSuffix String
p String
s = if String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
p String
s then String
s else String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p

-- | Given a URIAuth in "nonstandard" form (lacking required separator characters),
-- return one that is standard.
rectifyAuth :: URIAuth -> URIAuth
rectifyAuth :: URIAuth -> URIAuth
rectifyAuth URIAuth
a = URIAuth :: String -> String -> String -> URIAuth
URIAuth {
  uriUserInfo :: String
uriUserInfo = (String -> String) -> String -> String
forall a. ([a] -> [a]) -> [a] -> [a]
unlessEmpty (String -> String -> String
ensureSuffix String
"@") (URIAuth -> String
uriUserInfo URIAuth
a),
  uriRegName :: String
uriRegName = URIAuth -> String
uriRegName URIAuth
a,
  uriPort :: String
uriPort = (String -> String) -> String -> String
forall a. ([a] -> [a]) -> [a] -> [a]
unlessEmpty (String -> String -> String
ensurePrefix String
":") (URIAuth -> String
uriPort URIAuth
a)
  }

-- | Given a URI in "nonstandard" form (lacking required separator characters),
-- return one that is standard.
rectify :: URI -> URI
rectify :: URI -> URI
rectify URI
u = URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI {
  uriScheme :: String
uriScheme = String -> String -> String
ensureSuffix String
":" (URI -> String
uriScheme URI
u),
  uriAuthority :: Maybe URIAuth
uriAuthority = (URIAuth -> URIAuth) -> Maybe URIAuth -> Maybe URIAuth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap URIAuth -> URIAuth
rectifyAuth (URI -> Maybe URIAuth
uriAuthority URI
u),
  uriPath :: String
uriPath = URI -> String
uriPath URI
u,
  uriQuery :: String
uriQuery = (String -> String) -> String -> String
forall a. ([a] -> [a]) -> [a] -> [a]
unlessEmpty (String -> String -> String
ensurePrefix String
"?") (URI -> String
uriQuery URI
u),
  uriFragment :: String
uriFragment = (String -> String) -> String -> String
forall a. ([a] -> [a]) -> [a] -> [a]
unlessEmpty (String -> String -> String
ensurePrefix String
"#") (URI -> String
uriFragment URI
u)
  }

-- | Apply the function to the list, unless that list is empty, in
-- which case leave it alone.
unlessEmpty :: ([a] -> [a]) -> [a] -> [a]
unlessEmpty :: ([a] -> [a]) -> [a] -> [a]
unlessEmpty [a] -> [a]
_f [] = []
unlessEmpty  [a] -> [a]
f  [a]
x = [a] -> [a]
f [a]
x

instance NFData URI where
    rnf :: URI -> ()
rnf (URI String
s Maybe URIAuth
a String
p String
q String
f)
        = String
s String -> Maybe URIAuth -> Maybe URIAuth
forall a b. NFData a => a -> b -> b
`deepseq` Maybe URIAuth
a Maybe URIAuth -> String -> String
forall a b. NFData a => a -> b -> b
`deepseq` String
p String -> String -> String
forall a b. NFData a => a -> b -> b
`deepseq` String
q String -> String -> String
forall a b. NFData a => a -> b -> b
`deepseq` String
f String -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()

-- |Type for authority value within a URI
data URIAuth = URIAuth
    { URIAuth -> String
uriUserInfo   :: String           -- ^ @anonymous\@@
    , URIAuth -> String
uriRegName    :: String           -- ^ @www.haskell.org@
    , URIAuth -> String
uriPort       :: String           -- ^ @:42@
#if __GLASGOW_HASKELL__ >= 702
    } deriving (URIAuth -> URIAuth -> Bool
(URIAuth -> URIAuth -> Bool)
-> (URIAuth -> URIAuth -> Bool) -> Eq URIAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URIAuth -> URIAuth -> Bool
$c/= :: URIAuth -> URIAuth -> Bool
== :: URIAuth -> URIAuth -> Bool
$c== :: URIAuth -> URIAuth -> Bool
Eq, Eq URIAuth
Eq URIAuth
-> (URIAuth -> URIAuth -> Ordering)
-> (URIAuth -> URIAuth -> Bool)
-> (URIAuth -> URIAuth -> Bool)
-> (URIAuth -> URIAuth -> Bool)
-> (URIAuth -> URIAuth -> Bool)
-> (URIAuth -> URIAuth -> URIAuth)
-> (URIAuth -> URIAuth -> URIAuth)
-> Ord URIAuth
URIAuth -> URIAuth -> Bool
URIAuth -> URIAuth -> Ordering
URIAuth -> URIAuth -> URIAuth
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 :: URIAuth -> URIAuth -> URIAuth
$cmin :: URIAuth -> URIAuth -> URIAuth
max :: URIAuth -> URIAuth -> URIAuth
$cmax :: URIAuth -> URIAuth -> URIAuth
>= :: URIAuth -> URIAuth -> Bool
$c>= :: URIAuth -> URIAuth -> Bool
> :: URIAuth -> URIAuth -> Bool
$c> :: URIAuth -> URIAuth -> Bool
<= :: URIAuth -> URIAuth -> Bool
$c<= :: URIAuth -> URIAuth -> Bool
< :: URIAuth -> URIAuth -> Bool
$c< :: URIAuth -> URIAuth -> Bool
compare :: URIAuth -> URIAuth -> Ordering
$ccompare :: URIAuth -> URIAuth -> Ordering
$cp1Ord :: Eq URIAuth
Ord, Int -> URIAuth -> String -> String
[URIAuth] -> String -> String
URIAuth -> String
(Int -> URIAuth -> String -> String)
-> (URIAuth -> String)
-> ([URIAuth] -> String -> String)
-> Show URIAuth
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [URIAuth] -> String -> String
$cshowList :: [URIAuth] -> String -> String
show :: URIAuth -> String
$cshow :: URIAuth -> String
showsPrec :: Int -> URIAuth -> String -> String
$cshowsPrec :: Int -> URIAuth -> String -> String
Show, Typeable, Typeable URIAuth
DataType
Constr
Typeable URIAuth
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> URIAuth -> c URIAuth)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c URIAuth)
-> (URIAuth -> Constr)
-> (URIAuth -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c URIAuth))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URIAuth))
-> ((forall b. Data b => b -> b) -> URIAuth -> URIAuth)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> URIAuth -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> URIAuth -> r)
-> (forall u. (forall d. Data d => d -> u) -> URIAuth -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> URIAuth -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth)
-> Data URIAuth
URIAuth -> DataType
URIAuth -> Constr
(forall b. Data b => b -> b) -> URIAuth -> URIAuth
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URIAuth -> c URIAuth
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URIAuth
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) -> URIAuth -> u
forall u. (forall d. Data d => d -> u) -> URIAuth -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> URIAuth -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> URIAuth -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URIAuth -> m URIAuth
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URIAuth -> m URIAuth
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URIAuth
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URIAuth -> c URIAuth
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URIAuth)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URIAuth)
$cURIAuth :: Constr
$tURIAuth :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URIAuth -> m URIAuth
gmapMp :: (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URIAuth -> m URIAuth
gmapM :: (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URIAuth -> m URIAuth
gmapQi :: Int -> (forall d. Data d => d -> u) -> URIAuth -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> URIAuth -> u
gmapQ :: (forall d. Data d => d -> u) -> URIAuth -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> URIAuth -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> URIAuth -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> URIAuth -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> URIAuth -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> URIAuth -> r
gmapT :: (forall b. Data b => b -> b) -> URIAuth -> URIAuth
$cgmapT :: (forall b. Data b => b -> b) -> URIAuth -> URIAuth
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URIAuth)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URIAuth)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c URIAuth)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URIAuth)
dataTypeOf :: URIAuth -> DataType
$cdataTypeOf :: URIAuth -> DataType
toConstr :: URIAuth -> Constr
$ctoConstr :: URIAuth -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URIAuth
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URIAuth
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URIAuth -> c URIAuth
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URIAuth -> c URIAuth
$cp1Data :: Typeable URIAuth
Data, (forall x. URIAuth -> Rep URIAuth x)
-> (forall x. Rep URIAuth x -> URIAuth) -> Generic URIAuth
forall x. Rep URIAuth x -> URIAuth
forall x. URIAuth -> Rep URIAuth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URIAuth x -> URIAuth
$cfrom :: forall x. URIAuth -> Rep URIAuth x
Generic)
#else
    } deriving (Eq, Ord, Show, Typeable, Data)
#endif

instance NFData URIAuth where
    rnf :: URIAuth -> ()
rnf (URIAuth String
ui String
rn String
p) = String
ui String -> String -> String
forall a b. NFData a => a -> b -> b
`deepseq` String
rn String -> String -> String
forall a b. NFData a => a -> b -> b
`deepseq` String
p String -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()

-- |Blank URI
nullURI :: URI
nullURI :: URI
nullURI = URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI
    { uriScheme :: String
uriScheme     = String
""
    , uriAuthority :: Maybe URIAuth
uriAuthority  = Maybe URIAuth
forall a. Maybe a
Nothing
    , uriPath :: String
uriPath       = String
""
    , uriQuery :: String
uriQuery      = String
""
    , uriFragment :: String
uriFragment   = String
""
    }

-- |Blank URIAuth.
nullURIAuth :: URIAuth
nullURIAuth :: URIAuth
nullURIAuth = URIAuth :: String -> String -> String -> URIAuth
URIAuth
    { uriUserInfo :: String
uriUserInfo   = String
""
    , uriRegName :: String
uriRegName    = String
""
    , uriPort :: String
uriPort       = String
""
    }

--  URI as instance of Show.  Note that for security reasons, the default
--  behaviour is to suppress any userinfo field (see RFC3986, section 7.5).
--  This can be overridden by using uriToString directly with first
--  argument @id@ (noting that this returns a ShowS value rather than a string).
--
--  [[[Another design would be to embed the userinfo mapping function in
--  the URIAuth value, with the default value suppressing userinfo formatting,
--  but providing a function to return a new URI value with userinfo
--  data exposed by show.]]]
--
instance Show URI where
    showsPrec :: Int -> URI -> String -> String
showsPrec Int
_ = (String -> String) -> URI -> String -> String
uriToString String -> String
defaultUserInfoMap

defaultUserInfoMap :: String -> String
defaultUserInfoMap :: String -> String
defaultUserInfoMap String
uinf = String
userString -> String -> String
forall a. [a] -> [a] -> [a]
++String
newpass
    where
        (String
user,String
pass) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') String
uinf
        newpass :: String
newpass     = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pass Bool -> Bool -> Bool
|| (String
pass String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"@")
                                   Bool -> Bool -> Bool
|| (String
pass String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
":@")
                        then String
pass
                        else String
":...@"

------------------------------------------------------------
--  Parse a URI
------------------------------------------------------------

-- |Turn a string containing a URI into a 'URI'.
--  Returns 'Nothing' if the string is not a valid URI;
--  (an absolute URI with optional fragment identifier).
--
--  NOTE: this is different from the previous network.URI,
--  whose @parseURI@ function works like 'parseURIReference'
--  in this module.
--
parseURI :: String -> Maybe URI
parseURI :: String -> Maybe URI
parseURI = URIParser URI -> String -> Maybe URI
parseURIAny URIParser URI
uri

-- |Parse a URI reference to a 'URI' value.
--  Returns 'Nothing' if the string is not a valid URI reference.
--  (an absolute or relative URI with optional fragment identifier).
--
parseURIReference :: String -> Maybe URI
parseURIReference :: String -> Maybe URI
parseURIReference = URIParser URI -> String -> Maybe URI
parseURIAny URIParser URI
uriReference

-- |Parse a relative URI to a 'URI' value.
--  Returns 'Nothing' if the string is not a valid relative URI.
--  (a relative URI with optional fragment identifier).
--
parseRelativeReference :: String -> Maybe URI
parseRelativeReference :: String -> Maybe URI
parseRelativeReference = URIParser URI -> String -> Maybe URI
parseURIAny URIParser URI
relativeRef

-- |Parse an absolute URI to a 'URI' value.
--  Returns 'Nothing' if the string is not a valid absolute URI.
--  (an absolute URI without a fragment identifier).
--
parseAbsoluteURI :: String -> Maybe URI
parseAbsoluteURI :: String -> Maybe URI
parseAbsoluteURI = URIParser URI -> String -> Maybe URI
parseURIAny URIParser URI
absoluteURI

-- |Test if string contains a valid URI
--  (an absolute URI with optional fragment identifier).
--
isURI :: String -> Bool
isURI :: String -> Bool
isURI = URIParser URI -> String -> Bool
forall a. URIParser a -> String -> Bool
isValidParse URIParser URI
uri

-- |Test if string contains a valid URI reference
--  (an absolute or relative URI with optional fragment identifier).
--
isURIReference :: String -> Bool
isURIReference :: String -> Bool
isURIReference = URIParser URI -> String -> Bool
forall a. URIParser a -> String -> Bool
isValidParse URIParser URI
uriReference

-- |Test if string contains a valid relative URI
--  (a relative URI with optional fragment identifier).
--
isRelativeReference :: String -> Bool
isRelativeReference :: String -> Bool
isRelativeReference = URIParser URI -> String -> Bool
forall a. URIParser a -> String -> Bool
isValidParse URIParser URI
relativeRef

-- |Test if string contains a valid absolute URI
--  (an absolute URI without a fragment identifier).
--
isAbsoluteURI :: String -> Bool
isAbsoluteURI :: String -> Bool
isAbsoluteURI = URIParser URI -> String -> Bool
forall a. URIParser a -> String -> Bool
isValidParse URIParser URI
absoluteURI

-- |Test if string contains a valid IPv6 address
--
isIPv6address :: String -> Bool
isIPv6address :: String -> Bool
isIPv6address = URIParser String -> String -> Bool
forall a. URIParser a -> String -> Bool
isValidParse URIParser String
ipv6address

-- |Test if string contains a valid IPv4 address
--
isIPv4address :: String -> Bool
isIPv4address :: String -> Bool
isIPv4address = URIParser String -> String -> Bool
forall a. URIParser a -> String -> Bool
isValidParse URIParser String
ipv4address

--  Helper function for turning a string into a URI
--
parseURIAny :: URIParser URI -> String -> Maybe URI
parseURIAny :: URIParser URI -> String -> Maybe URI
parseURIAny URIParser URI
parser String
uristr = case URIParser URI -> String -> String -> Either ParseError URI
forall a. URIParser a -> String -> String -> Either ParseError a
parseAll URIParser URI
parser String
"" String
uristr of
        Left  ParseError
_ -> Maybe URI
forall a. Maybe a
Nothing
        Right URI
u -> URI -> Maybe URI
forall a. a -> Maybe a
Just URI
u

--  Helper function to test a string match to a parser
--
isValidParse :: URIParser a -> String -> Bool
isValidParse :: URIParser a -> String -> Bool
isValidParse URIParser a
parser String
uristr = case URIParser a -> String -> String -> Either ParseError a
forall a. URIParser a -> String -> String -> Either ParseError a
parseAll URIParser a
parser String
"" String
uristr of
        -- Left  e -> error (show e)
        Left  ParseError
_ -> Bool
False
        Right a
_ -> Bool
True

parseAll :: URIParser a -> String -> String -> Either ParseError a
parseAll :: URIParser a -> String -> String -> Either ParseError a
parseAll URIParser a
parser String
filename String
uristr = URIParser a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse URIParser a
newparser String
filename String
uristr
    where
        newparser :: URIParser a
newparser =
            do  { a
res <- URIParser a
parser
                ; ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
                ; a -> URIParser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
                }

------------------------------------------------------------
--  Predicates
------------------------------------------------------------

uriIsAbsolute :: URI -> Bool
uriIsAbsolute :: URI -> Bool
uriIsAbsolute (URI {uriScheme :: URI -> String
uriScheme = String
scheme'}) = String
scheme' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""

uriIsRelative :: URI -> Bool
uriIsRelative :: URI -> Bool
uriIsRelative = Bool -> Bool
not (Bool -> Bool) -> (URI -> Bool) -> URI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Bool
uriIsAbsolute

------------------------------------------------------------
--  URI parser body based on Parsec elements and combinators
------------------------------------------------------------

--  Parser parser type.
--  Currently
type URIParser a = GenParser Char () a

--  RFC3986, section 2.1
--
--  Parse and return a 'pct-encoded' sequence
--
escaped :: URIParser String
escaped :: URIParser String
escaped = [ParsecT String () Identity Char] -> URIParser String
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%', ParsecT String () Identity Char
hexDigitChar, ParsecT String () Identity Char
hexDigitChar]

--  RFC3986, section 2.2
--
-- |Returns 'True' if the character is a \"reserved\" character in a
--  URI.  To include a literal instance of one of these characters in a
--  component of a URI, it must be escaped.
--
isReserved :: Char -> Bool
isReserved :: Char -> Bool
isReserved Char
c = Char -> Bool
isGenDelims Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSubDelims Char
c

-- As per https://github.com/haskell/network-uri/pull/46, it was found
-- that the explicit case statement was noticably faster than a nicer
-- expression in terms of `elem`.
isGenDelims :: Char -> Bool
isGenDelims :: Char -> Bool
isGenDelims Char
c =
  case Char
c of
    Char
':' -> Bool
True
    Char
'/' -> Bool
True
    Char
'?' -> Bool
True
    Char
'#' -> Bool
True
    Char
'[' -> Bool
True
    Char
']' -> Bool
True
    Char
'@' -> Bool
True
    Char
_ -> Bool
False

-- As per https://github.com/haskell/network-uri/pull/46, it was found
-- that the explicit case statement was noticably faster than a nicer
-- expression in terms of `elem`.
isSubDelims :: Char -> Bool
isSubDelims :: Char -> Bool
isSubDelims Char
c =
  case Char
c of
    Char
'!' -> Bool
True
    Char
'$' -> Bool
True
    Char
'&' -> Bool
True
    Char
'\'' -> Bool
True
    Char
'(' -> Bool
True
    Char
')' -> Bool
True
    Char
'*' -> Bool
True
    Char
'+' -> Bool
True
    Char
',' -> Bool
True
    Char
';' -> Bool
True
    Char
'=' -> Bool
True
    Char
_ -> Bool
False

subDelims :: URIParser String
subDelims :: URIParser String
subDelims = (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String)
-> ParsecT String () Identity Char -> URIParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!$&'()*+,;="

--  RFC3986, section 2.3
--
-- |Returns 'True' if the character is an \"unreserved\" character in
--  a URI.  These characters do not need to be escaped in a URI.  The
--  only characters allowed in a URI are either \"reserved\",
--  \"unreserved\", or an escape sequence (@%@ followed by two hex digits).
--
isUnreserved :: Char -> Bool
isUnreserved :: Char -> Bool
isUnreserved Char
c = Char -> Bool
isAlphaNumChar Char
c Bool -> Bool -> Bool
|| (Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"-_.~")

unreservedChar :: URIParser String
unreservedChar :: URIParser String
unreservedChar = (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String)
-> ParsecT String () Identity Char -> URIParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isUnreserved

--  RFC3986, section 3
--
--   URI         = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
--
--   hier-part   = "//" authority path-abempty
--               / path-abs
--               / path-rootless
--               / path-empty

uri :: URIParser URI
uri :: URIParser URI
uri =
    do  { String
us <- URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try URIParser String
uscheme
        -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } )
        -- ; up <- upath
        ; (Maybe URIAuth
ua,String
up) <- URIParser (Maybe URIAuth, String)
hierPart
        ; String
uq <- String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ( do { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?' ; URIParser String
uquery    } )
        ; String
uf <- String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ( do { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' ; URIParser String
ufragment } )
        ; URI -> URIParser URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> URIParser URI) -> URI -> URIParser URI
forall a b. (a -> b) -> a -> b
$ URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI
            { uriScheme :: String
uriScheme    = String
us
            , uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
ua
            , uriPath :: String
uriPath      = String
up
            , uriQuery :: String
uriQuery     = String
uq
            , uriFragment :: String
uriFragment  = String
uf
            }
        }

hierPart :: URIParser ((Maybe URIAuth),String)
hierPart :: URIParser (Maybe URIAuth, String)
hierPart =
        do  { String
_ <- URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"//")
            ; Maybe URIAuth
ua <- URIParser (Maybe URIAuth)
uauthority
            ; String
up <- URIParser String
pathAbEmpty
            ; (Maybe URIAuth, String) -> URIParser (Maybe URIAuth, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth
ua,String
up)
            }
    URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do  { String
up <- URIParser String
pathAbs
            ; (Maybe URIAuth, String) -> URIParser (Maybe URIAuth, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth
forall a. Maybe a
Nothing,String
up)
            }
    URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do  { String
up <- URIParser String
pathRootLess
            ; (Maybe URIAuth, String) -> URIParser (Maybe URIAuth, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth
forall a. Maybe a
Nothing,String
up)
            }
    URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do  { (Maybe URIAuth, String) -> URIParser (Maybe URIAuth, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth
forall a. Maybe a
Nothing,String
"")
            }

--  RFC3986, section 3.1

uscheme :: URIParser String
uscheme :: URIParser String
uscheme =
    do  { String
s <- ParsecT String () Identity Char
-> ParsecT String () Identity Char -> URIParser String
forall t s a.
GenParser t s a -> GenParser t s a -> GenParser t s [a]
oneThenMany ParsecT String () Identity Char
alphaChar ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSchemeChar)
        ; Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":"
        }

--  RFC3986, section 3.2

uauthority :: URIParser (Maybe URIAuth)
uauthority :: URIParser (Maybe URIAuth)
uauthority =
    do  { String
uu <- String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try URIParser String
userinfo)
        ; String
uh <- URIParser String
host
        ; String
up <- String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" URIParser String
port
        ; Maybe URIAuth -> URIParser (Maybe URIAuth)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth -> URIParser (Maybe URIAuth))
-> Maybe URIAuth -> URIParser (Maybe URIAuth)
forall a b. (a -> b) -> a -> b
$ URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just (URIAuth -> Maybe URIAuth) -> URIAuth -> Maybe URIAuth
forall a b. (a -> b) -> a -> b
$ URIAuth :: String -> String -> String -> URIAuth
URIAuth
            { uriUserInfo :: String
uriUserInfo = String
uu
            , uriRegName :: String
uriRegName  = String
uh
            , uriPort :: String
uriPort     = String
up
            }
        }

--  RFC3986, section 3.2.1

userinfo :: URIParser String
userinfo :: URIParser String
userinfo =
    do  { [String]
uu <- URIParser String -> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> URIParser String
uchar String
";:&=+$,")
        ; Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@'
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
uu String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"@")
        }

--  RFC3986, section 3.2.2
--  RFC6874, section 2

host :: URIParser String
host :: URIParser String
host = URIParser String
ipLiteral URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try URIParser String
ipv4address URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String
regName

ipLiteral :: URIParser String
ipLiteral :: URIParser String
ipLiteral =
    do  { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
        ; String
ua <- ( URIParser String
ipv6addrz URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String
ipvFuture )
        ; Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ua String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
        }
    URIParser String -> String -> URIParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"IP address literal"

ipvFuture :: URIParser String
ipvFuture :: URIParser String
ipvFuture =
    do  { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'v'
        ; Char
h <- ParsecT String () Identity Char
hexDigitChar
        ; Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
        ; String
a <- ParsecT String () Identity Char -> URIParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIpvFutureChar)
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ Char
'v'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
hChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
a
        }

isIpvFutureChar :: Char -> Bool
isIpvFutureChar :: Char -> Bool
isIpvFutureChar Char
c = Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSubDelims Char
c Bool -> Bool -> Bool
|| (Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';')

zoneid :: URIParser String
zoneid :: URIParser String
zoneid = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ParsecT String () Identity [String] -> URIParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URIParser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (URIParser String
unreservedChar URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String
escaped)

ipv6addrz :: URIParser String
ipv6addrz :: URIParser String
ipv6addrz = String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> URIParser String
-> ParsecT String () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URIParser String
ipv6address ParsecT String () Identity (String -> String)
-> URIParser String -> URIParser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (URIParser String -> URIParser String)
-> URIParser String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> URIParser String
-> ParsecT String () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%25" ParsecT String () Identity (String -> String)
-> URIParser String -> URIParser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> URIParser String
zoneid)

ipv6address :: URIParser String
ipv6address :: URIParser String
ipv6address =
        URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { [String]
a2 <- Int -> URIParser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
6 URIParser String
h4c
                ; String
a3 <- URIParser String
ls32
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
a2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a3
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
_ <- String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
                ; [String]
a2 <- Int -> URIParser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
5 URIParser String
h4c
                ; String
a3 <- URIParser String
ls32
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
a2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a3
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
a1 <- Int -> URIParser String
opt_n_h4c_h4 Int
0
                ; String
_ <- String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
                ; [String]
a2 <- Int -> URIParser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
4 URIParser String
h4c
                ; String
a3 <- URIParser String
ls32
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
a2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a3
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
a1 <- Int -> URIParser String
opt_n_h4c_h4 Int
1
                ; String
_ <- String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
                ; [String]
a2 <- Int -> URIParser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
3 URIParser String
h4c
                ; String
a3 <- URIParser String
ls32
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
a2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a3
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
a1 <- Int -> URIParser String
opt_n_h4c_h4 Int
2
                ; String
_ <- String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
                ; [String]
a2 <- Int -> URIParser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
2 URIParser String
h4c
                ; String
a3 <- URIParser String
ls32
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
a2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a3
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
a1 <- Int -> URIParser String
opt_n_h4c_h4 Int
3
                ; String
_ <- String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
                ; String
a2 <- URIParser String
h4c
                ; String
a3 <- URIParser String
ls32
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a3
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
a1 <- Int -> URIParser String
opt_n_h4c_h4 Int
4
                ; String
_ <- String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
                ; String
a3 <- URIParser String
ls32
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a3
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
a1 <- Int -> URIParser String
opt_n_h4c_h4 Int
5
                ; String
_ <- String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
                ; String
a3 <- URIParser String
h4
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a3
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
a1 <- Int -> URIParser String
opt_n_h4c_h4 Int
6
                ; String
_ <- String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::"
                } )
    URIParser String -> String -> URIParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"IPv6 address"

opt_n_h4c_h4 :: Int -> URIParser String
opt_n_h4c_h4 :: Int -> URIParser String
opt_n_h4c_h4 Int
n = String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (URIParser String -> URIParser String)
-> URIParser String -> URIParser String
forall a b. (a -> b) -> a -> b
$
    do  { [String]
a1 <- Int
-> Int -> URIParser String -> ParsecT String () Identity [String]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax Int
0 Int
n URIParser String
h4c
        ; String
a2 <- URIParser String
h4
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a2
        }

ls32 :: URIParser String
ls32 :: URIParser String
ls32 =  URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                { String
a1 <- URIParser String
h4c
                ; String
a2 <- URIParser String
h4
                ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
a1String -> String -> String
forall a. [a] -> [a] -> [a]
++String
a2)
                } )
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String
ipv4address

h4c :: URIParser String
h4c :: URIParser String
h4c = URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (URIParser String -> URIParser String)
-> URIParser String -> URIParser String
forall a b. (a -> b) -> a -> b
$
    do  { String
a1 <- URIParser String
h4
        ; Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
        ; ()
_ <- ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
        }

h4 :: URIParser String
h4 :: URIParser String
h4 = Int -> Int -> ParsecT String () Identity Char -> URIParser String
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax Int
1 Int
4 ParsecT String () Identity Char
hexDigitChar

ipv4address :: URIParser String
ipv4address :: URIParser String
ipv4address =
    do  { String
a1 <- URIParser String
decOctet ; Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
        ; String
a2 <- URIParser String
decOctet ; Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
        ; String
a3 <- URIParser String
decOctet ; Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
        ; String
a4 <- URIParser String
decOctet
        ; ()
_ <- URIParser String -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy URIParser String
nameChar
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ String
a1String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
a2String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
a3String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
a4
        }
    URIParser String -> String -> URIParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"IPv4 Address"

decOctet :: URIParser String
decOctet :: URIParser String
decOctet =
    do  { String
a1 <- Int -> Int -> ParsecT String () Identity Char -> URIParser String
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax Int
1 Int
3 ParsecT String () Identity Char
digitChar
        ; if (String -> Integer
forall a. Read a => String -> a
read String
a1 :: Integer) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
255 then
            String -> URIParser String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Decimal octet value too large"
          else
            String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
a1
        }

regName :: URIParser String
regName :: URIParser String
regName =
    do  { [String]
ss <- Int
-> Int -> URIParser String -> ParsecT String () Identity [String]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax Int
0 Int
255 URIParser String
nameChar
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ss
        }
    URIParser String -> String -> URIParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Registered name"


nameChar :: URIParser String
nameChar :: URIParser String
nameChar = (URIParser String
unreservedChar URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String
escaped URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String
subDelims)
    URIParser String -> String -> URIParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Name character"

--  RFC3986, section 3.2.3

port :: URIParser String
port :: URIParser String
port =
    do  { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
        ; String
p <- ParsecT String () Identity Char -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT String () Identity Char
digitChar
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:String
p)
        }

--
--  RFC3986, section 3.3
--
--   path          = path-abempty    ; begins with "/" or is empty
--                 / path-abs        ; begins with "/" but not "//"
--                 / path-noscheme   ; begins with a non-colon segment
--                 / path-rootless   ; begins with a segment
--                 / path-empty      ; zero characters
--
--   path-abempty  = *( "/" segment )
--   path-abs      = "/" [ segment-nz *( "/" segment ) ]
--   path-noscheme = segment-nzc *( "/" segment )
--   path-rootless = segment-nz *( "/" segment )
--   path-empty    = 0<pchar>
--
--   segment       = *pchar
--   segment-nz    = 1*pchar
--   segment-nzc   = 1*( unreserved / pct-encoded / sub-delims / "@" )
--
--   pchar         = unreserved / pct-encoded / sub-delims / ":" / "@"

{-
upath :: URIParser String
upath = pathAbEmpty
    <|> pathAbs
    <|> pathNoScheme
    <|> pathRootLess
    <|> pathEmpty
-}

pathAbEmpty :: URIParser String
pathAbEmpty :: URIParser String
pathAbEmpty =
    do  { [String]
ss <- URIParser String -> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many URIParser String
slashSegment
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ss
        }

pathAbs :: URIParser String
pathAbs :: URIParser String
pathAbs =
    do  { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
        ; String
ss <- String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" URIParser String
pathRootLess
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ss
        }

pathNoScheme :: URIParser String
pathNoScheme :: URIParser String
pathNoScheme =
    do  { String
s1 <- URIParser String
segmentNzc
        ; [String]
ss <- URIParser String -> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many URIParser String
slashSegment
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
s1String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss)
        }

pathRootLess :: URIParser String
pathRootLess :: URIParser String
pathRootLess =
    do  { String
s1 <- URIParser String
segmentNz
        ; [String]
ss <- URIParser String -> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many URIParser String
slashSegment
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
s1String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss)
        }

slashSegment :: URIParser String
slashSegment :: URIParser String
slashSegment =
    do  { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
        ; String
s <- URIParser String
segment
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s)
        }

segment :: URIParser String
segment :: URIParser String
segment =
    do  { [String]
ps <- URIParser String -> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many URIParser String
pchar
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps
        }

segmentNz :: URIParser String
segmentNz :: URIParser String
segmentNz =
    do  { [String]
ps <- URIParser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 URIParser String
pchar
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps
        }

segmentNzc :: URIParser String
segmentNzc :: URIParser String
segmentNzc =
    do  { [String]
ps <- URIParser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> URIParser String
uchar String
"@")
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps
        }

pchar :: URIParser String
pchar :: URIParser String
pchar = String -> URIParser String
uchar String
":@"

-- helper function for pchar and friends
uchar :: String -> URIParser String
uchar :: String -> URIParser String
uchar String
extras =
        URIParser String
unreservedChar
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String
escaped
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser String
subDelims
    URIParser String -> URIParser String -> URIParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do { Char
c <- String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
extras ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c] }

--  RFC3986, section 3.4

uquery :: URIParser String
uquery :: URIParser String
uquery =
    do  { [String]
ss <- URIParser String -> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (URIParser String -> ParsecT String () Identity [String])
-> URIParser String -> ParsecT String () Identity [String]
forall a b. (a -> b) -> a -> b
$ String -> URIParser String
uchar (String
":@"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/?")
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ Char
'?'Char -> String -> String
forall a. a -> [a] -> [a]
:[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ss
        }

--  RFC3986, section 3.5

ufragment :: URIParser String
ufragment :: URIParser String
ufragment =
    do  { [String]
ss <- URIParser String -> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (URIParser String -> ParsecT String () Identity [String])
-> URIParser String -> ParsecT String () Identity [String]
forall a b. (a -> b) -> a -> b
$ String -> URIParser String
uchar (String
":@"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/?")
        ; String -> URIParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> URIParser String) -> String -> URIParser String
forall a b. (a -> b) -> a -> b
$ Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ss
        }

--  Reference, Relative and Absolute URI forms
--
--  RFC3986, section 4.1

uriReference :: URIParser URI
uriReference :: URIParser URI
uriReference = URIParser URI
uri URIParser URI -> URIParser URI -> URIParser URI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> URIParser URI
relativeRef

--  RFC3986, section 4.2
--
--   relative-URI  = relative-part [ "?" query ] [ "#" fragment ]
--
--   relative-part = "//" authority path-abempty
--                 / path-abs
--                 / path-noscheme
--                 / path-empty

relativeRef :: URIParser URI
relativeRef :: URIParser URI
relativeRef =
    do  { URIParser String -> ParsecT String () Identity ()
forall a tok st.
Show a =>
GenParser tok st a -> GenParser tok st ()
notMatching URIParser String
uscheme
        -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } )
        -- ; up <- upath
        ; (Maybe URIAuth
ua,String
up) <- URIParser (Maybe URIAuth, String)
relativePart
        ; String
uq <- String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ( do { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?' ; URIParser String
uquery    } )
        ; String
uf <- String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ( do { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' ; URIParser String
ufragment } )
        ; URI -> URIParser URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> URIParser URI) -> URI -> URIParser URI
forall a b. (a -> b) -> a -> b
$ URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI
            { uriScheme :: String
uriScheme    = String
""
            , uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
ua
            , uriPath :: String
uriPath      = String
up
            , uriQuery :: String
uriQuery     = String
uq
            , uriFragment :: String
uriFragment  = String
uf
            }
        }

relativePart :: URIParser ((Maybe URIAuth),String)
relativePart :: URIParser (Maybe URIAuth, String)
relativePart =
        do  { String
_ <- URIParser String -> URIParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> URIParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"//")
            ; Maybe URIAuth
ua <- URIParser (Maybe URIAuth)
uauthority
            ; String
up <- URIParser String
pathAbEmpty
            ; (Maybe URIAuth, String) -> URIParser (Maybe URIAuth, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth
ua,String
up)
            }
    URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do  { String
up <- URIParser String
pathAbs
            ; (Maybe URIAuth, String) -> URIParser (Maybe URIAuth, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth
forall a. Maybe a
Nothing,String
up)
            }
    URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do  { String
up <- URIParser String
pathNoScheme
            ; (Maybe URIAuth, String) -> URIParser (Maybe URIAuth, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth
forall a. Maybe a
Nothing,String
up)
            }
    URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
-> URIParser (Maybe URIAuth, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do  { (Maybe URIAuth, String) -> URIParser (Maybe URIAuth, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth
forall a. Maybe a
Nothing,String
"")
            }

--  RFC3986, section 4.3

absoluteURI :: URIParser URI
absoluteURI :: URIParser URI
absoluteURI =
    do  { String
us <- URIParser String
uscheme
        -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } )
        -- ; up <- upath
        ; (Maybe URIAuth
ua,String
up) <- URIParser (Maybe URIAuth, String)
hierPart
        ; String
uq <- String -> URIParser String -> URIParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ( do { Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?' ; URIParser String
uquery    } )
        ; URI -> URIParser URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> URIParser URI) -> URI -> URIParser URI
forall a b. (a -> b) -> a -> b
$ URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI
            { uriScheme :: String
uriScheme    = String
us
            , uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
ua
            , uriPath :: String
uriPath      = String
up
            , uriQuery :: String
uriQuery     = String
uq
            , uriFragment :: String
uriFragment  = String
""
            }
        }

--  Imports from RFC 2234

    -- NOTE: can't use isAlphaNum etc. because these deal with ISO 8859
    -- (and possibly Unicode!) chars.
    -- [[[Above was a comment originally in GHC Network/URI.hs:
    --    when IRIs are introduced then most codepoints above 128(?) should
    --    be treated as unreserved, and higher codepoints for letters should
    --    certainly be allowed.
    -- ]]]

isAlphaChar :: Char -> Bool
isAlphaChar :: Char -> Bool
isAlphaChar Char
c    = (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z')

isDigitChar :: Char -> Bool
isDigitChar :: Char -> Bool
isDigitChar Char
c    = (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')

isAlphaNumChar :: Char -> Bool
isAlphaNumChar :: Char -> Bool
isAlphaNumChar Char
c = Char -> Bool
isAlphaChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigitChar Char
c

isHexDigitChar :: Char -> Bool
isHexDigitChar :: Char -> Bool
isHexDigitChar Char
c = Char -> Bool
isHexDigit Char
c

isSchemeChar :: Char -> Bool
isSchemeChar :: Char -> Bool
isSchemeChar Char
c   = (Char -> Bool
isAlphaNumChar Char
c) Bool -> Bool -> Bool
|| (Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"+-.")

alphaChar :: URIParser Char
alphaChar :: ParsecT String () Identity Char
alphaChar = (Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAlphaChar         -- or: Parsec.letter ?

digitChar :: URIParser Char
digitChar :: ParsecT String () Identity Char
digitChar = (Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDigitChar         -- or: Parsec.digit ?

hexDigitChar :: URIParser Char
hexDigitChar :: ParsecT String () Identity Char
hexDigitChar = (Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isHexDigitChar   -- or: Parsec.hexDigit ?

--  Additional parser combinators for common patterns

oneThenMany :: GenParser t s a -> GenParser t s a -> GenParser t s [a]
oneThenMany :: GenParser t s a -> GenParser t s a -> GenParser t s [a]
oneThenMany GenParser t s a
p1 GenParser t s a
pr =
    do  { a
a1 <- GenParser t s a
p1
        ; [a]
ar <- GenParser t s a -> GenParser t s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many GenParser t s a
pr
        ; [a] -> GenParser t s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ar)
        }

countMinMax :: Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax :: Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax Int
m Int
n GenParser t s a
p | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
    do  { a
a1 <- GenParser t s a
p
        ; [a]
ar <- Int -> Int -> GenParser t s a -> GenParser t s [a]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) GenParser t s a
p
        ; [a] -> GenParser t s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ar)
        }
countMinMax Int
_ Int
n GenParser t s a
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [a] -> GenParser t s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
countMinMax Int
_ Int
n GenParser t s a
p = [a] -> GenParser t s [a] -> GenParser t s [a]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (GenParser t s [a] -> GenParser t s [a])
-> GenParser t s [a] -> GenParser t s [a]
forall a b. (a -> b) -> a -> b
$
    do  { a
a1 <- GenParser t s a
p
        ; [a]
ar <- Int -> Int -> GenParser t s a -> GenParser t s [a]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax Int
0 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) GenParser t s a
p
        ; [a] -> GenParser t s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ar)
        }

notMatching :: Show a => GenParser tok st a -> GenParser tok st ()
notMatching :: GenParser tok st a -> GenParser tok st ()
notMatching GenParser tok st a
p = do { a
a <- GenParser tok st a -> GenParser tok st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser tok st a
p ; String -> GenParser tok st ()
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (a -> String
forall a. Show a => a -> String
show a
a) } GenParser tok st () -> GenParser tok st () -> GenParser tok st ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> GenParser tok st ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

------------------------------------------------------------
--  Reconstruct a URI string
------------------------------------------------------------
--
-- |Turn a 'URI' into a string.
--
--  Uses a supplied function to map the userinfo part of the URI.
--
--  The Show instance for URI uses a mapping that hides any password
--  that may be present in the URI.  Use this function with argument @id@
--  to preserve the password in the formatted output.
--
uriToString :: (String->String) -> URI -> ShowS
uriToString :: (String -> String) -> URI -> String -> String
uriToString String -> String
userinfomap URI { uriScheme :: URI -> String
uriScheme=String
myscheme
                            , uriAuthority :: URI -> Maybe URIAuth
uriAuthority=Maybe URIAuth
myauthority
                            , uriPath :: URI -> String
uriPath=String
mypath
                            , uriQuery :: URI -> String
uriQuery=String
myquery
                            , uriFragment :: URI -> String
uriFragment=String
myfragment
                            } =
    (String
myschemeString -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> String) -> Maybe URIAuth -> String -> String
uriAuthToString String -> String
userinfomap Maybe URIAuth
myauthority)
               (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
mypathString -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
myqueryString -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
myfragmentString -> String -> String
forall a. [a] -> [a] -> [a]
++)

uriAuthToString :: (String->String) -> (Maybe URIAuth) -> ShowS
uriAuthToString :: (String -> String) -> Maybe URIAuth -> String -> String
uriAuthToString String -> String
_           Maybe URIAuth
Nothing   = String -> String
forall a. a -> a
id          -- shows ""
uriAuthToString String -> String
userinfomap
        (Just URIAuth { uriUserInfo :: URIAuth -> String
uriUserInfo = String
myuinfo
                      , uriRegName :: URIAuth -> String
uriRegName  = String
myregname
                      , uriPort :: URIAuth -> String
uriPort     = String
myport
                      } ) =
    (String
"//"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
myuinfo then String -> String
forall a. a -> a
id else ((String -> String
userinfomap String
myuinfo)String -> String -> String
forall a. [a] -> [a] -> [a]
++))
             (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
myregnameString -> String -> String
forall a. [a] -> [a] -> [a]
++)
             (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
myportString -> String -> String
forall a. [a] -> [a] -> [a]
++)

------------------------------------------------------------
--  Character classes
------------------------------------------------------------

-- | Returns 'True' if the character is allowed in a URI.
--
isAllowedInURI :: Char -> Bool
isAllowedInURI :: Char -> Bool
isAllowedInURI Char
c = Char -> Bool
isReserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%' -- escape char

-- | Returns 'True' if the character is allowed unescaped in a URI.
--
-- >>> escapeURIString isUnescapedInURI "http://haskell.org:80?some_param=true&other_param=їґ"
-- "http://haskell.org:80?some_param=true&other_param=%D1%97%D2%91"
isUnescapedInURI :: Char -> Bool
isUnescapedInURI :: Char -> Bool
isUnescapedInURI Char
c = Char -> Bool
isReserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
isUnreserved Char
c

-- | Returns 'True' if the character is allowed unescaped in a URI component.
--
-- >>> escapeURIString isUnescapedInURIComponent "http://haskell.org:80?some_param=true&other_param=їґ"
-- "http%3A%2F%2Fhaskell.org%3A80%3Fsome_param%3Dtrue%26other_param%3D%D1%97%D2%91"
isUnescapedInURIComponent :: Char -> Bool
isUnescapedInURIComponent :: Char -> Bool
isUnescapedInURIComponent Char
c = Bool -> Bool
not (Char -> Bool
isReserved Char
c Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isUnescapedInURI Char
c))

------------------------------------------------------------
--  Escape sequence handling
------------------------------------------------------------

-- |Escape character if supplied predicate is not satisfied,
--  otherwise return character as singleton string.
--
escapeURIChar :: (Char->Bool) -> Char -> String
escapeURIChar :: (Char -> Bool) -> Char -> String
escapeURIChar Char -> Bool
p Char
c
    | Char -> Bool
p Char
c       = [Char
c]
    | Bool
otherwise = (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
i -> Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
myShowHex Int
i String
"") (Char -> [Int]
utf8EncodeChar Char
c)
    where
        myShowHex :: Int -> ShowS
        myShowHex :: Int -> String -> String
myShowHex Int
n String
r =  case Int -> (Int -> Char) -> Int -> String -> String
forall a.
(Integral a, Show a) =>
a -> (Int -> Char) -> a -> String -> String
showIntAtBase Int
16 (Int -> Char
forall a. Integral a => a -> Char
toChrHex) Int
n String
r of
            []  -> String
"00"
            [Char
x] -> [Char
'0',Char
x]
            String
cs  -> String
cs
        toChrHex :: a -> Char
toChrHex a
d
            | a
d a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10    = Int -> Char
chr (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d)
            | Bool
otherwise = Int -> Char
chr (Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
10))

-- From http://hackage.haskell.org/package/utf8-string
-- by Eric Mertens, BSD3
-- Returns [Int] for use with showIntAtBase
utf8EncodeChar :: Char -> [Int]
utf8EncodeChar :: Char -> [Int]
utf8EncodeChar = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Int]) -> (Char -> [Int]) -> Char -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int]
forall a. (Ord a, Num a, Bits a) => a -> [a]
go (Int -> [Int]) -> (Char -> Int) -> Char -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
 where
  go :: a -> [a]
go a
oc
   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7f       = [a
oc]

   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7ff      = [ a
0xc0 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ a
oc a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3f
                        ]

   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0xffff     = [ a
0xe0 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
12)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3f)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ a
oc a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3f
                        ]
   | Bool
otherwise        = [ a
0xf0 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
18)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3f)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3f)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ a
oc a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3f
                        ]

-- |Can be used to make a string valid for use in a URI.
--
escapeURIString
    :: (Char->Bool)     -- ^ a predicate which returns 'False'
                        --   if the character should be escaped
    -> String           -- ^ the string to process
    -> String           -- ^ the resulting URI string
escapeURIString :: (Char -> Bool) -> String -> String
escapeURIString Char -> Bool
p String
s = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> Bool) -> Char -> String
escapeURIChar Char -> Bool
p) String
s

-- |Turns all instances of escaped characters in the string back
--  into literal characters.
--
unEscapeString :: String -> String
unEscapeString :: String -> String
unEscapeString [] = String
""
unEscapeString s :: String
s@(Char
c:String
cs) = case String -> Maybe (Int, String)
unEscapeByte String
s of
    Just (Int
byte, String
rest) -> Int -> String -> String
unEscapeUtf8 Int
byte String
rest
    Maybe (Int, String)
Nothing -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
cs

unEscapeByte :: String -> Maybe (Int, String)
unEscapeByte :: String -> Maybe (Int, String)
unEscapeByte (Char
'%':Char
x1:Char
x2:String
s) | Char -> Bool
isHexDigit Char
x1 Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
x2 =
    (Int, String) -> Maybe (Int, String)
forall a. a -> Maybe a
Just (Char -> Int
digitToInt Char
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
x2, String
s)
unEscapeByte String
_ = Maybe (Int, String)
forall a. Maybe a
Nothing

-- Adapted from http://hackage.haskell.org/package/utf8-string
-- by Eric Mertens, BSD3
unEscapeUtf8 :: Int -> String -> String
unEscapeUtf8 :: Int -> String -> String
unEscapeUtf8 Int
c String
rest
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80 = Int -> Char
chr Int
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
rest
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xc0 = Char
replacement_character Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
rest
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xe0 = String
multi1
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xf0 = Int -> Int -> Int -> String
multi_byte Int
2 Int
0xf Int
0x800
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xf8 = Int -> Int -> Int -> String
multi_byte Int
3 Int
0x7 Int
0x10000
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xfc = Int -> Int -> Int -> String
multi_byte Int
4 Int
0x3 Int
0x200000
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xfe = Int -> Int -> Int -> String
multi_byte Int
5 Int
0x1 Int
0x4000000
    | Bool
otherwise    = Char
replacement_character Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
rest
    where
    replacement_character :: Char
replacement_character = Char
'\xfffd'
    multi1 :: String
multi1 = case String -> Maybe (Int, String)
unEscapeByte String
rest of
      Just (Int
c1, String
ds) | Int
c1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xc0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x80 ->
        let d :: Int
d = ((Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.  Int -> Int
forall a. Enum a => a -> Int
fromEnum (Int
c1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)
        in if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x000080 then Int -> Char
forall a. Enum a => Int -> a
toEnum Int
d Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
ds
                            else Char
replacement_character Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
ds
      Maybe (Int, String)
_ -> Char
replacement_character Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
rest

    multi_byte :: Int -> Int -> Int -> String
    multi_byte :: Int -> Int -> Int -> String
multi_byte Int
i Int
mask Int
overlong =
      Int -> String -> Maybe (Int, String) -> Int -> String
forall t.
(Eq t, Num t) =>
t -> String -> Maybe (Int, String) -> Int -> String
aux Int
i String
rest (String -> Maybe (Int, String)
unEscapeByte String
rest) (Int
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
mask)
      where
        aux :: t -> String -> Maybe (Int, String) -> Int -> String
aux t
0 String
rs Maybe (Int, String)
_ Int
acc
          | Int
overlong Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
acc Bool -> Bool -> Bool
&& Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10ffff Bool -> Bool -> Bool
&&
            (Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xd800 Bool -> Bool -> Bool
|| Int
0xdfff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
acc)     Bool -> Bool -> Bool
&&
            (Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xfffe Bool -> Bool -> Bool
|| Int
0xffff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
acc)      = Int -> Char
chr Int
acc Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
rs
          | Bool
otherwise = Char
replacement_character Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
rs

        aux t
n String
_ (Just (Int
r, String
rs)) Int
acc
          | Int
r Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xc0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x80 = t -> String -> Maybe (Int, String) -> Int -> String
aux (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) String
rs (String -> Maybe (Int, String)
unEscapeByte String
rs)
                               (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
acc Int
6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
r Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)

        aux t
_ String
rs Maybe (Int, String)
_ Int
_ = Char
replacement_character Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unEscapeString String
rs

------------------------------------------------------------
-- Resolving a relative URI relative to a base URI
------------------------------------------------------------

-- |Returns a new 'URI' which represents the value of the
--  first 'URI' interpreted as relative to the second 'URI'.
--  For example:
--
--  > "foo" `relativeTo` "http://bar.org/" = "http://bar.org/foo"
--  > "http:foo" `nonStrictRelativeTo` "http://bar.org/" = "http://bar.org/foo"
--
--  Algorithm from RFC3986 [3], section 5.2.2
--

nonStrictRelativeTo :: URI -> URI -> URI
nonStrictRelativeTo :: URI -> URI -> URI
nonStrictRelativeTo URI
ref URI
base = URI -> URI -> URI
relativeTo URI
ref' URI
base
    where
        ref' :: URI
ref' = if URI -> String
uriScheme URI
ref String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== URI -> String
uriScheme URI
base
               then URI
ref { uriScheme :: String
uriScheme=String
"" }
               else URI
ref

isDefined :: ( MonadPlus m, Eq (m a) ) => m a -> Bool
isDefined :: m a -> Bool
isDefined m a
a = m a
a m a -> m a -> Bool
forall a. Eq a => a -> a -> Bool
/= m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Returns a new 'URI' which represents the value of the first 'URI'
-- interpreted as relative to the second 'URI'.
--
-- Algorithm from RFC3986 [3], section 5.2
relativeTo :: URI -> URI -> URI
relativeTo :: URI -> URI -> URI
relativeTo URI
ref URI
base
    | String -> Bool
forall (m :: * -> *) a. (MonadPlus m, Eq (m a)) => m a -> Bool
isDefined ( URI -> String
uriScheme URI
ref ) =
        URI -> URI
just_segments URI
ref
    | Maybe URIAuth -> Bool
forall (m :: * -> *) a. (MonadPlus m, Eq (m a)) => m a -> Bool
isDefined ( URI -> Maybe URIAuth
uriAuthority URI
ref ) =
        URI -> URI
just_segments URI
ref { uriScheme :: String
uriScheme = URI -> String
uriScheme URI
base }
    | String -> Bool
forall (m :: * -> *) a. (MonadPlus m, Eq (m a)) => m a -> Bool
isDefined ( URI -> String
uriPath URI
ref ) =
        if (String -> Char
forall a. [a] -> a
head (URI -> String
uriPath URI
ref) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') then
            URI -> URI
just_segments URI
ref
                { uriScheme :: String
uriScheme    = URI -> String
uriScheme URI
base
                , uriAuthority :: Maybe URIAuth
uriAuthority = URI -> Maybe URIAuth
uriAuthority URI
base
                }
        else
            URI -> URI
just_segments URI
ref
                { uriScheme :: String
uriScheme    = URI -> String
uriScheme URI
base
                , uriAuthority :: Maybe URIAuth
uriAuthority = URI -> Maybe URIAuth
uriAuthority URI
base
                , uriPath :: String
uriPath      = URI -> URI -> String
mergePaths URI
base URI
ref
                }
    | String -> Bool
forall (m :: * -> *) a. (MonadPlus m, Eq (m a)) => m a -> Bool
isDefined ( URI -> String
uriQuery URI
ref ) =
        URI -> URI
just_segments URI
ref
            { uriScheme :: String
uriScheme    = URI -> String
uriScheme URI
base
            , uriAuthority :: Maybe URIAuth
uriAuthority = URI -> Maybe URIAuth
uriAuthority URI
base
            , uriPath :: String
uriPath      = URI -> String
uriPath URI
base
            }
    | Bool
otherwise =
        URI -> URI
just_segments URI
ref
            { uriScheme :: String
uriScheme    = URI -> String
uriScheme URI
base
            , uriAuthority :: Maybe URIAuth
uriAuthority = URI -> Maybe URIAuth
uriAuthority URI
base
            , uriPath :: String
uriPath      = URI -> String
uriPath URI
base
            , uriQuery :: String
uriQuery     = URI -> String
uriQuery URI
base
            }
    where
        just_segments :: URI -> URI
just_segments URI
u =
            URI
u { uriPath :: String
uriPath = String -> String
removeDotSegments (URI -> String
uriPath URI
u) }
        mergePaths :: URI -> URI -> String
mergePaths URI
b URI
r
            | Maybe URIAuth -> Bool
forall (m :: * -> *) a. (MonadPlus m, Eq (m a)) => m a -> Bool
isDefined (URI -> Maybe URIAuth
uriAuthority URI
b) Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pb = Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
pr
            | Bool
otherwise                             = String -> String
dropLast String
pb String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pr
            where
                pb :: String
pb = URI -> String
uriPath URI
b
                pr :: String
pr = URI -> String
uriPath URI
r
        dropLast :: String -> String
dropLast = (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
splitLast -- reverse . dropWhile (/='/') . reverse

--  Remove dot segments, but protect leading '/' character
removeDotSegments :: String -> String
removeDotSegments :: String -> String
removeDotSegments (Char
'/':String
ps) = Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> [String] -> String
elimDots String
ps []
removeDotSegments String
ps       = String -> [String] -> String
elimDots String
ps []

--  Second arg accumulates segments processed so far in reverse order
elimDots :: String -> [String] -> String
-- elimDots ps rs | traceVal "\nps " ps $ traceVal "rs " rs $ False = error ""
elimDots :: String -> [String] -> String
elimDots [] [] = String
""
elimDots [] [String]
rs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
rs)
elimDots (    Char
'.':Char
'/':String
ps)     [String]
rs = String -> [String] -> String
elimDots String
ps [String]
rs
elimDots (    Char
'.':[]    )     [String]
rs = String -> [String] -> String
elimDots [] [String]
rs
elimDots (    Char
'.':Char
'.':Char
'/':String
ps) [String]
rs = String -> [String] -> String
elimDots String
ps (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
rs)
elimDots (    Char
'.':Char
'.':[]    ) [String]
rs = String -> [String] -> String
elimDots [] (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
rs)
elimDots String
ps [String]
rs = String -> [String] -> String
elimDots String
ps1 (String
rString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
rs)
    where
        (String
r,String
ps1) = String -> (String, String)
nextSegment String
ps

--  Returns the next segment and the rest of the path from a path string.
--  Each segment ends with the next '/' or the end of string.
--
nextSegment :: String -> (String,String)
nextSegment :: String -> (String, String)
nextSegment String
ps =
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') String
ps of
        (String
r,Char
'/':String
ps1) -> (String
rString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/",String
ps1)
        (String
r,String
_)       -> (String
r,[])

-- | The segments of the path component of a URI. E.g.,
segments :: String -> [String]
segments :: String -> [String]
segments String
str = [String] -> [String]
dropLeadingEmpty ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (String, String)) -> String -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr String -> Maybe (String, String)
nextSegmentMaybe String
str
    where
        nextSegmentMaybe :: String -> Maybe (String, String)
nextSegmentMaybe String
"" = Maybe (String, String)
forall a. Maybe a
Nothing
        nextSegmentMaybe String
ps =
            case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') String
ps of
                (String
seg, Char
'/':String
ps1) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
seg, String
ps1)
                (String
seg, String
_)       -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
seg, String
"")
        dropLeadingEmpty :: [String] -> [String]
dropLeadingEmpty (String
"":[String]
xs) = [String]
xs
        dropLeadingEmpty [String]
xs      = [String]
xs

-- | Returns the segments of the path component. E.g.,
--    pathSegments <$> parseURI "http://example.org/foo/bar/baz"
-- == ["foo", "bar", "baz"]
pathSegments :: URI -> [String]
pathSegments :: URI -> [String]
pathSegments = String -> [String]
segments (String -> [String]) -> (URI -> String) -> URI -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
uriPath

-- | Split last (name) segment from path, returning (path,name)
splitLast :: String -> (String,String)
splitLast :: String -> (String, String)
splitLast String
p = (String -> String
forall a. [a] -> [a]
reverse String
revpath,String -> String
forall a. [a] -> [a]
reverse String
revname)
    where
        (String
revname,String
revpath) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
p

------------------------------------------------------------
-- Finding a URI relative to a base URI
------------------------------------------------------------

-- |Returns a new 'URI' which represents the relative location of
--  the first 'URI' with respect to the second 'URI'.  Thus, the
--  values supplied are expected to be absolute URIs, and the result
--  returned may be a relative URI.
--
--  Example:
--
--  > "http://example.com/Root/sub1/name2#frag"
--  >   `relativeFrom` "http://example.com/Root/sub2/name2#frag"
--  >   == "../sub1/name2#frag"
--
--  There is no single correct implementation of this function,
--  but any acceptable implementation must satisfy the following:
--
--  > (uabs `relativeFrom` ubase) `relativeTo` ubase == uabs
--
--  For any valid absolute URI.
--  (cf. <http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html>
--       <http://lists.w3.org/Archives/Public/uri/2003Jan/0005.html>)
--
relativeFrom :: URI -> URI -> URI
relativeFrom :: URI -> URI -> URI
relativeFrom URI
uabs URI
base
    | (URI -> String) -> URI -> URI -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
diff URI -> String
uriScheme    URI
uabs URI
base = URI
uabs
    | (URI -> Maybe URIAuth) -> URI -> URI -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
diff URI -> Maybe URIAuth
uriAuthority URI
uabs URI
base = URI
uabs { uriScheme :: String
uriScheme = String
"" }
    | (URI -> String) -> URI -> URI -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
diff URI -> String
uriPath      URI
uabs URI
base = URI
uabs
        { uriScheme :: String
uriScheme    = String
""
        , uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
forall a. Maybe a
Nothing
        , uriPath :: String
uriPath      = String -> String -> String
relPathFrom (String -> String
removeBodyDotSegments (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ URI -> String
uriPath URI
uabs)
                                     (String -> String
removeBodyDotSegments (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ URI -> String
uriPath URI
base)
        }
    | (URI -> String) -> URI -> URI -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
diff URI -> String
uriQuery     URI
uabs URI
base = URI
uabs
        { uriScheme :: String
uriScheme    = String
""
        , uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
forall a. Maybe a
Nothing
        , uriPath :: String
uriPath      = String
""
        }
    | Bool
otherwise = URI
uabs          -- Always carry fragment from uabs
        { uriScheme :: String
uriScheme    = String
""
        , uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
forall a. Maybe a
Nothing
        , uriPath :: String
uriPath      = String
""
        , uriQuery :: String
uriQuery     = String
""
        }
    where
        diff :: Eq b => (a -> b) -> a -> a -> Bool
        diff :: (a -> b) -> a -> a -> Bool
diff a -> b
sel a
u1 a
u2 = a -> b
sel a
u1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> b
sel a
u2
        -- Remove dot segments except the final segment
        removeBodyDotSegments :: String -> String
removeBodyDotSegments String
p = String -> String
removeDotSegments String
p1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p2
            where
                (String
p1,String
p2) = String -> (String, String)
splitLast String
p

-- | Calculate the path to the first argument, from the second argument.
relPathFrom :: String -> String -> String
relPathFrom :: String -> String -> String
relPathFrom []   String
_    = String
"/"
relPathFrom String
pabs []   = String
pabs
relPathFrom String
pabs String
base =
    if String
sa1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
sb1                       -- If the first segments are equal
        then if (String
sa1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"/")              -- and they're absolute,
            then if (String
sa2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
sb2)            -- then if the 2nd segs are equal,
                then String -> String -> String
relPathFrom1 String
ra2 String
rb2   -- relativize from there.
                else
                   String
pabs                     -- Otherwise it's not worth trying.
            else String -> String -> String
relPathFrom1 String
ra1 String
rb1     -- If same & relative, relativize.
        else String
pabs                       -- If 1st segs not equal, just use pabs.
    where
        (String
sa1,String
ra1) = String -> (String, String)
nextSegment String
pabs
        (String
sb1,String
rb1) = String -> (String, String)
nextSegment String
base
        (String
sa2,String
ra2) = String -> (String, String)
nextSegment String
ra1
        (String
sb2,String
rb2) = String -> (String, String)
nextSegment String
rb1

--  relPathFrom1 strips off trailing names from the supplied paths, and finds
--  the relative path from base to target.
relPathFrom1 :: String -> String -> String
relPathFrom1 :: String -> String -> String
relPathFrom1 String
pabs String
base = String
relName
    where
        -- Relative paths are reckoned without the basename, so split those off.
        (String
sa,String
na) = String -> (String, String)
splitLast String
pabs
        (String
sb,String
nb) = String -> (String, String)
splitLast String
base
        rp :: String
rp      = String -> String -> String
relSegsFrom String
sa String
sb
        relName :: String
relName = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rp then
                      -- If the relative path is empty, and the basenames are
                      -- the same, then the paths must be exactly the same.
                      if (String
na String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nb) then String
""
                      -- If the name is vulnerable to being misinterpreted,
                      -- add a dot segment in advance to protect it.
                      else if String -> Bool
forall (t :: * -> *). Foldable t => t Char -> Bool
protect String
na then String
"./"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
na
                      else String
na
                  else
                      String
rpString -> String -> String
forall a. [a] -> [a] -> [a]
++String
na
        -- If a single-segment path is null or contains a ':', it needs
        -- "protection" from being interpreted as a different kind of URL.
        protect :: t Char -> Bool
protect t Char
s = t Char -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Char
s Bool -> Bool -> Bool
|| Char
':' Char -> t Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
s

--  relSegsFrom discards any equal leading segments from two *directory*
--  paths, then invokes difSegsFrom to calculate a relative path from the end
--  of the base path to the end of the target path.
relSegsFrom :: String -> String -> String
{-
relSegsFrom sabs base
    | traceVal "\nrelSegsFrom\nsabs " sabs $ traceVal "base " base $
      False = error ""
-}
relSegsFrom :: String -> String -> String
relSegsFrom []   []   = String
""      -- paths are identical
relSegsFrom String
sabs String
base =
    if String
sa1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
sb1
        then String -> String -> String
relSegsFrom String
ra1 String
rb1
        else String -> String -> String
difSegsFrom String
sabs String
base
    where
        (String
sa1,String
ra1) = String -> (String, String)
nextSegment String
sabs
        (String
sb1,String
rb1) = String -> (String, String)
nextSegment String
base

-- Given two paths @a@, @b@, count out the necessary number of ".." segments
-- to get from the depth of @b@ to the path @a@.
difSegsFrom :: String -> String -> String
{-
difSegsFrom sabs base
    | traceVal "\ndifSegsFrom\nsabs " sabs $ traceVal "base " base $
      False = error ""
-}
difSegsFrom :: String -> String -> String
difSegsFrom String
sabs String
""   = String
sabs
difSegsFrom String
sabs String
base = String -> String -> String
difSegsFrom (String
"../"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sabs) ((String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
nextSegment String
base)

------------------------------------------------------------
--  Other normalization functions
------------------------------------------------------------

-- |Case normalization; cf. RFC3986 section 6.2.2.1
--  NOTE:  authority case normalization is not performed
--
normalizeCase :: String -> String
normalizeCase :: String -> String
normalizeCase String
uristr = String -> String
ncScheme String
uristr
    where
        ncScheme :: String -> String
ncScheme (Char
':':String
cs)                = Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
ncEscape String
cs
        ncScheme (Char
c:String
cs) | Char -> Bool
isSchemeChar Char
c = Char -> Char
toLower Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
ncScheme String
cs
        ncScheme String
_                       = String -> String
ncEscape String
uristr -- no scheme present
        ncEscape :: String -> String
ncEscape (Char
'%':Char
h1:Char
h2:String
cs) = Char
'%'Char -> String -> String
forall a. a -> [a] -> [a]
:Char -> Char
toUpper Char
h1Char -> String -> String
forall a. a -> [a] -> [a]
:Char -> Char
toUpper Char
h2Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
ncEscape String
cs
        ncEscape (Char
c:String
cs)         = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
ncEscape String
cs
        ncEscape []             = []

-- |Encoding normalization; cf. RFC3986 section 6.2.2.2
--
normalizeEscape :: String -> String
normalizeEscape :: String -> String
normalizeEscape (Char
'%':Char
h1:Char
h2:String
cs)
    | Char -> Bool
isHexDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
h2 Bool -> Bool -> Bool
&& Char -> Bool
isUnreserved Char
escval =
        Char
escvalChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
normalizeEscape String
cs
    where
        escval :: Char
escval = Int -> Char
chr (Char -> Int
digitToInt Char
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
16Int -> Int -> Int
forall a. Num a => a -> a -> a
+Char -> Int
digitToInt Char
h2)
normalizeEscape (Char
c:String
cs)         = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
normalizeEscape String
cs
normalizeEscape []             = []

-- |Path segment normalization; cf. RFC3986 section 6.2.2.3
--
normalizePathSegments :: String -> String
normalizePathSegments :: String -> String
normalizePathSegments String
uristr = Maybe URI -> String
normstr Maybe URI
juri
    where
        juri :: Maybe URI
juri = String -> Maybe URI
parseURI String
uristr
        normstr :: Maybe URI -> String
normstr Maybe URI
Nothing  = String
uristr
        normstr (Just URI
u) = URI -> String
forall a. Show a => a -> String
show (URI -> URI
normuri URI
u)
        normuri :: URI -> URI
normuri URI
u = URI
u { uriPath :: String
uriPath = String -> String
removeDotSegments (URI -> String
uriPath URI
u) }

------------------------------------------------------------
--  Lift instances to support Network.URI.Static
------------------------------------------------------------

#if __GLASGOW_HASKELL__ >= 800
deriving instance Lift URI
deriving instance Lift URIAuth
#else
instance Lift URI where
    lift (URI {..}) = [| URI {..} |]

instance Lift URIAuth where
    lift (URIAuth {..}) = [| URIAuth {..} |]
#endif

------------------------------------------------------------
--  Deprecated functions
------------------------------------------------------------

{-# DEPRECATED parseabsoluteURI "use parseAbsoluteURI" #-}
parseabsoluteURI :: String -> Maybe URI
parseabsoluteURI :: String -> Maybe URI
parseabsoluteURI = String -> Maybe URI
parseAbsoluteURI

{-# DEPRECATED escapeString "use escapeURIString, and note the flipped arguments" #-}
escapeString :: String -> (Char->Bool) -> String
escapeString :: String -> (Char -> Bool) -> String
escapeString = ((Char -> Bool) -> String -> String)
-> String -> (Char -> Bool) -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Char -> Bool) -> String -> String
escapeURIString

{-# DEPRECATED reserved "use isReserved" #-}
reserved :: Char -> Bool
reserved :: Char -> Bool
reserved = Char -> Bool
isReserved

{-# DEPRECATED unreserved "use isUnreserved" #-}
unreserved :: Char -> Bool
unreserved :: Char -> Bool
unreserved = Char -> Bool
isUnreserved

--  Additional component access functions for backward compatibility

{-# DEPRECATED scheme "use uriScheme" #-}
scheme :: URI -> String
scheme :: URI -> String
scheme = (String -> String) -> String -> String
forall a. ([a] -> [a]) -> [a] -> [a]
orNull String -> String
forall a. [a] -> [a]
init (String -> String) -> (URI -> String) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
uriScheme

{-# DEPRECATED authority "use uriAuthority, and note changed functionality" #-}
authority :: URI -> String
authority :: URI -> String
authority = String -> String
dropss (String -> String) -> (URI -> String) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$String
"") ((String -> String) -> String)
-> (URI -> String -> String) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> Maybe URIAuth -> String -> String
uriAuthToString String -> String
forall a. a -> a
id (Maybe URIAuth -> String -> String)
-> (URI -> Maybe URIAuth) -> URI -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Maybe URIAuth
uriAuthority
    where
        -- Old-style authority component does not include leading '//'
        dropss :: String -> String
dropss (Char
'/':Char
'/':String
s) = String
s
        dropss String
s           = String
s

{-# DEPRECATED path "use uriPath" #-}
path :: URI -> String
path :: URI -> String
path = URI -> String
uriPath

{-# DEPRECATED query "use uriQuery, and note changed functionality" #-}
query :: URI -> String
query :: URI -> String
query = (String -> String) -> String -> String
forall a. ([a] -> [a]) -> [a] -> [a]
orNull String -> String
forall a. [a] -> [a]
tail (String -> String) -> (URI -> String) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
uriQuery

{-# DEPRECATED fragment "use uriFragment, and note changed functionality" #-}
fragment :: URI -> String
fragment :: URI -> String
fragment = (String -> String) -> String -> String
forall a. ([a] -> [a]) -> [a] -> [a]
orNull String -> String
forall a. [a] -> [a]
tail (String -> String) -> (URI -> String) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
uriFragment

orNull :: ([a]->[a]) -> [a] -> [a]
orNull :: ([a] -> [a]) -> [a] -> [a]
orNull [a] -> [a]
_ [] = []
orNull [a] -> [a]
f [a]
as = [a] -> [a]
f [a]
as

--------------------------------------------------------------------------------
--
--  Copyright (c) 2004, G. KLYNE.  All rights reserved.
--  Distributed as free software under the following license.
--
--  Redistribution and use in source and binary forms, with or without
--  modification, are permitted provided that the following conditions
--  are met:
--
--  - Redistributions of source code must retain the above copyright notice,
--  this list of conditions and the following disclaimer.
--
--  - Redistributions in binary form must reproduce the above copyright
--  notice, this list of conditions and the following disclaimer in the
--  documentation and/or other materials provided with the distribution.
--
--  - Neither name of the copyright holders nor the names of its
--  contributors may be used to endorse or promote products derived from
--  this software without specific prior written permission.
--
--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS
--  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
--  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
--  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
--  HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
--  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
--  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
--  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
--  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
--  TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
--  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--
--------------------------------------------------------------------------------