{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Text.URI (
	URI(..)
	, dereferencePath
	, dereferencePathString
	, escapeString
	, isReference
	, isRelative
	, nullURI
	, okInFragment
	, okInPath
	, okInPathSegment
	, okInQuery
	, okInQueryItem
	, okInUserinfo
	, mergePaths
	, mergePathStrings
	, mergeURIs
	, mergeURIStrings
	, pairsToQuery
	, parseURI
	, pathToSegments
	, segmentsToPath
	, queryToPairs
	, unescapeString
	, uriPathSegments
	, uriQueryItems
	) where

import Codec.Binary.UTF8.String
import Data.Char
import Data.Data
import Data.List
import Data.Maybe
import Data.Typeable
import Data.Word
import Safe
import Text.Parsec
import Text.Printf
------------------------------------------------------------
--  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 -> Maybe String
uriScheme :: Maybe String -- ^ @foo@
	, URI -> Maybe String
uriUserInfo :: Maybe String -- ^ @anonymous@
	, URI -> Maybe String
uriRegName :: Maybe String -- ^ @www.haskell.org@
	, URI -> Maybe Integer
uriPort :: Maybe Integer -- ^ @42@
	, URI -> String
uriPath :: String -- ^ @/ghc@
	, URI -> Maybe String
uriQuery :: Maybe String -- ^ @query@
	, URI -> Maybe String
uriFragment :: Maybe String -- ^ @frag@
	} 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
Constr
DataType
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 -> Constr
URI -> DataType
(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)

-- | Blank URI
nullURI :: URI
nullURI :: URI
nullURI = URI :: Maybe String
-> Maybe String
-> Maybe String
-> Maybe Integer
-> String
-> Maybe String
-> Maybe String
-> URI
URI {
	uriScheme :: Maybe String
uriScheme = Maybe String
forall a. Maybe a
Nothing
	, uriRegName :: Maybe String
uriRegName = Maybe String
forall a. Maybe a
Nothing
	, uriUserInfo :: Maybe String
uriUserInfo = Maybe String
forall a. Maybe a
Nothing
	, uriPort :: Maybe Integer
uriPort = Maybe Integer
forall a. Maybe a
Nothing
	, uriPath :: String
uriPath = ""
	, uriQuery :: Maybe String
uriQuery = Maybe String
forall a. Maybe a
Nothing
	, uriFragment :: Maybe String
uriFragment = Maybe String
forall a. Maybe a
Nothing
	}

instance Show URI where
	show :: URI -> String
show u :: URI
u = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
		String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":") (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriScheme URI
u
		, if (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriRegName URI
u) then "//" else ""
		, String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (String -> ShowS
forall a. [a] -> [a] -> [a]
++ "@") (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriUserInfo URI
u
		, String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriRegName URI
u
		, String -> (Integer -> String) -> Maybe Integer -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\s :: Integer
s -> ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
s) (Maybe Integer -> String) -> Maybe Integer -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe Integer
uriPort URI
u
		, if (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriRegName URI
u) Bool -> Bool -> Bool
&& (Bool -> Bool
not ("/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` URI -> String
uriPath URI
u Bool -> Bool -> Bool
|| URI -> String
uriPath URI
u String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "")) then ("/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ URI -> String
uriPath URI
u) else URI -> String
uriPath URI
u
		, String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ("?" String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriQuery URI
u
		, String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ("#" String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriFragment URI
u
		]

-- | Checks if character is OK in userinfo
okInUserinfo :: Char -> Bool
okInUserinfo :: Char -> Bool
okInUserinfo = [Char -> Bool] -> Char -> Bool
forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isUnreserved, Char -> Bool
isSubDelim, (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':')]
-- | Checks if character is OK in query
okInQuery :: Char -> Bool
okInQuery :: Char -> Bool
okInQuery = [Char -> Bool] -> Char -> Bool
forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isPChar, (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "/?")]
-- | Checks if character is OK in urlencoded query item
okInQueryItem :: Char -> Bool
okInQueryItem :: Char -> Bool
okInQueryItem c :: Char
c = Char -> Bool
okInQuery Char
c Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c "&=")
-- | Checks if character is OK in fragment
okInFragment :: Char -> Bool
okInFragment :: Char -> Bool
okInFragment = Char -> Bool
okInQuery
-- | Checks if character is OK in path
okInPath :: Char -> Bool
okInPath :: Char -> Bool
okInPath = [Char -> Bool] -> Char -> Bool
forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isPChar, (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "/@")]
-- | Checks if character is ok in path segment
okInPathSegment :: Char -> Bool
okInPathSegment :: Char -> Bool
okInPathSegment = [Char -> Bool] -> Char -> Bool
forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isPChar, (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '@')]

-- | Parses URI
parseURI :: String -> Maybe URI
parseURI :: String -> Maybe URI
parseURI s :: String
s = (ParseError -> Maybe URI)
-> (URI -> Maybe URI) -> Either ParseError URI -> Maybe URI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe URI -> ParseError -> Maybe URI
forall a b. a -> b -> a
const Maybe URI
forall a. Maybe a
Nothing) (URI -> Maybe URI
forall a. a -> Maybe a
Just) (Either ParseError URI -> Maybe URI)
-> Either ParseError URI -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Parsec String () URI -> String -> String -> Either ParseError URI
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () URI
forall u. ParsecT String u Identity URI
uriP "user input" String
s

-- | Escapes one char, see escapeString
escapeChar :: (Char -> Bool) -> Char -> String
escapeChar :: (Char -> Bool) -> Char -> String
escapeChar f :: Char -> Bool
f c :: Char
c = if Char -> Bool
f Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '%' then [Char
c] else [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> String) -> [Word8] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Word8 -> String
forall r. PrintfType r => String -> r
printf "%%%0.2X") (String -> [Word8]
encode [Char
c])

-- | Escapes string, using predicate to determine whether character is allowed
escapeString :: (Char -> Bool) -> String -> String
escapeString :: (Char -> Bool) -> ShowS
escapeString f :: Char -> Bool
f s :: String
s = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> Char -> String
escapeChar Char -> Bool
f) String
s

-- | Checks if uri is a reference
isReference :: URI -> Bool
isReference :: URI -> Bool
isReference u :: URI
u = (Maybe String -> Bool) -> [Maybe String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing) [URI -> Maybe String
uriRegName URI
u, URI -> Maybe String
uriScheme URI
u]

-- | Checks if uri is relative
isRelative :: URI -> Bool
isRelative :: URI -> Bool
isRelative u :: URI
u = URI -> Bool
isReference URI
u Bool -> Bool -> Bool
&& (Char -> String -> Char
forall a. a -> [a] -> a
headDef ' ' (URI -> String
uriPath URI
u) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '/')

-- | Composes www-urlencoded query from key-value pairs
pairsToQuery :: [(String, String)] -> String
pairsToQuery :: [(String, String)] -> String
pairsToQuery = ShowS
forall a. [a] -> [a]
initSafe ShowS
-> ([(String, String)] -> String) -> [(String, String)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (String, String) -> String)
-> String -> [(String, String)] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\rest :: String
rest (k :: String
k,v :: String
v) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
	String
rest
	, (Char -> Bool) -> ShowS
escapeString (Char -> Bool
okInQueryItem) String
k
	, "="
	, (Char -> Bool) -> ShowS
escapeString (Char -> Bool
okInQueryItem) String
v
	, "&"
	]) ""

-- | Parses www-urlencoded string to key-value pairs
queryToPairs :: String -> [(String, String)]
queryToPairs :: String -> [(String, String)]
queryToPairs q :: String
q = (ParseError -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> Either ParseError [(String, String)]
-> [(String, String)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([(String, String)] -> ParseError -> [(String, String)]
forall a b. a -> b -> a
const []) ([(String, String)] -> [(String, String)]
forall a. a -> a
id) (Either ParseError [(String, String)] -> [(String, String)])
-> Either ParseError [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ Parsec String () [(String, String)]
-> String -> String -> Either ParseError [(String, String)]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [(String, String)]
forall u. ParsecT String u Identity [(String, String)]
urlEncodedPairsP "query" String
q

-- | Unescapes percent-sequences
unescapeString :: String -> String
unescapeString :: ShowS
unescapeString s :: String
s = (ParseError -> String)
-> ShowS -> Either ParseError String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseError -> String
forall a b. a -> b -> a
const String
s) (ShowS
forall a. a -> a
id) (Either ParseError String -> String)
-> Either ParseError String -> String
forall a b. (a -> b) -> a -> b
$ Parsec String () String
-> String -> String -> Either ParseError String
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT String () Identity Char -> Parsec String () String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char -> Parsec String () String)
-> ParsecT String () Identity Char -> Parsec String () String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
percentEncodedP ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar) "escaped text" String
s

-- | Convenience function for extracting www-urlencoded data
uriQueryItems :: URI -> [(String, String)]
uriQueryItems :: URI -> [(String, String)]
uriQueryItems = [(String, String)]
-> (String -> [(String, String)])
-> Maybe String
-> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> [(String, String)]
queryToPairs) (Maybe String -> [(String, String)])
-> (URI -> Maybe String) -> URI -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Maybe String
uriQuery

-- | Splits path to segments
pathToSegments :: String -> [String]
pathToSegments :: String -> [String]
pathToSegments = Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
explode '/'

-- | Convenience function for extracting path segments
uriPathSegments :: URI -> [String]
uriPathSegments :: URI -> [String]
uriPathSegments = String -> [String]
pathToSegments (String -> [String]) -> (URI -> String) -> URI -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
uriPath

-- | Joins path segments, with escaping
segmentsToPath :: [String] -> String
segmentsToPath :: [String] -> String
segmentsToPath [""] = "/"
segmentsToPath ss :: [String]
ss = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "/" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> ShowS
escapeString (Char -> Bool
okInPathSegment)) [String]
ss

-- | Merges two URIs
mergeURIs :: URI -- ^ Base URI
	-> URI -- ^ Reference URI
	-> URI -- ^ Resulting URI
mergeURIs :: URI -> URI -> URI
mergeURIs t :: URI
t r :: URI
r = if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (URI -> Maybe String
uriScheme URI
r) then
	URI
t { uriScheme :: Maybe String
uriScheme = URI -> Maybe String
uriScheme URI
r
		, uriRegName :: Maybe String
uriRegName = URI -> Maybe String
uriRegName URI
r
		, uriPort :: Maybe Integer
uriPort = URI -> Maybe Integer
uriPort URI
r
		, uriUserInfo :: Maybe String
uriUserInfo = URI -> Maybe String
uriUserInfo URI
r
		, uriPath :: String
uriPath = ShowS
dereferencePathString (URI -> String
uriPath URI
r)
		, uriQuery :: Maybe String
uriQuery = URI -> Maybe String
uriQuery URI
r
		, uriFragment :: Maybe String
uriFragment = URI -> Maybe String
uriFragment URI
r
		}
	else
	if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (URI -> Maybe String
uriRegName URI
r) then
		URI
t { uriRegName :: Maybe String
uriRegName = URI -> Maybe String
uriRegName URI
r
			, uriPort :: Maybe Integer
uriPort = URI -> Maybe Integer
uriPort URI
r
			, uriUserInfo :: Maybe String
uriUserInfo = URI -> Maybe String
uriUserInfo URI
r
			, uriPath :: String
uriPath = ShowS
dereferencePathString (URI -> String
uriPath URI
r)
			, uriQuery :: Maybe String
uriQuery = URI -> Maybe String
uriQuery URI
r
			, uriFragment :: Maybe String
uriFragment = URI -> Maybe String
uriFragment URI
r
			}
		else -- Not 100% sure about how good i translated this, but seems right.
		if URI -> String
uriPath URI
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" then
			URI
t { uriQuery :: Maybe String
uriQuery = Maybe String
-> (String -> Maybe String) -> Maybe String -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (URI -> Maybe String
uriQuery URI
t) (String -> Maybe String
forall a. a -> Maybe a
Just) (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriQuery URI
r
				, uriPath :: String
uriPath = URI -> String
uriPath URI
t
				, uriFragment :: Maybe String
uriFragment = URI -> Maybe String
uriFragment URI
r
				}
			else
			URI
t { uriQuery :: Maybe String
uriQuery = URI -> Maybe String
uriQuery URI
r
				, uriPath :: String
uriPath = String -> ShowS
mergePathStrings (URI -> String
uriPath URI
t) (URI -> String
uriPath URI
r)
				, uriFragment :: Maybe String
uriFragment = URI -> Maybe String
uriFragment URI
r
				}

-- | mergeURIs for strings
mergeURIStrings :: String -> String -> String
mergeURIStrings :: String -> ShowS
mergeURIStrings s1 :: String
s1 s2 :: String
s2 = URI -> String
forall a. Show a => a -> String
show (URI -> String) -> URI -> String
forall a b. (a -> b) -> a -> b
$ URI -> URI -> URI
mergeURIs (URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe URI
nullURI (Maybe URI -> URI) -> Maybe URI -> URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURI String
s1) (URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe URI
nullURI (Maybe URI -> URI) -> Maybe URI -> URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURI String
s2)

-- | mergePaths for strings
mergePathStrings :: String -> String -> String
mergePathStrings :: String -> ShowS
mergePathStrings p1 :: String
p1 p2 :: String
p2 = [String] -> String
segmentsToPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [String]
mergePaths (String -> [String]
pathToSegments String
p1) (String -> [String]
pathToSegments String
p2)

-- | Merges two paths
mergePaths :: [String] -> [String] -> [String]
mergePaths :: [String] -> [String] -> [String]
mergePaths p1 :: [String]
p1 p2 :: [String]
p2@("":_) = [String] -> [String]
dereferencePath [String]
p2
mergePaths p1 :: [String]
p1 [] = [String] -> [String]
dereferencePath [String]
p1
mergePaths p1 :: [String]
p1 p2 :: [String]
p2 = [String] -> [String]
dereferencePath (([String] -> [String]
forall a. [a] -> [a]
initSafe [String]
p1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["."]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
p2)

-- | Removes ".." and "." from path
dereferencePath :: [String] -> [String]
dereferencePath :: [String] -> [String]
dereferencePath = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [String]
dereferencePath' [] ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: String
s -> if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" then "." else String
s)

-- | dereferencePath for strings
dereferencePathString :: String -> String
dereferencePathString :: ShowS
dereferencePathString = [String] -> String
segmentsToPath ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
dereferencePath ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
pathToSegments

-- Private functions

dereferencePath' :: [String] -> [String] -> [String]
dereferencePath' :: [String] -> [String] -> [String]
dereferencePath' processed :: [String]
processed [] = [String]
processed
dereferencePath' processed :: [String]
processed ["."] = ""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
processed
dereferencePath' (".":processed :: [String]
processed) ps :: [String]
ps@("..":_) = [String] -> [String] -> [String]
dereferencePath' [String]
processed [String]
ps
dereferencePath' processed :: [String]
processed ("..":ps :: [String]
ps) = [String] -> [String] -> [String]
dereferencePath' ([String] -> [String]
forall a. [a] -> [a]
tailSafe [String]
processed) ("."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ps)
dereferencePath' processed :: [String]
processed (".":ps :: [String]
ps) = [String] -> [String] -> [String]
dereferencePath' [String]
processed [String]
ps
dereferencePath' processed :: [String]
processed (p :: String
p:ps :: [String]
ps) = [String] -> [String] -> [String]
dereferencePath' (String
pString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
processed) [String]
ps

-- Parser

-- sepBy version thet returns full parsed string
sepByWSep :: ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
sepByWSep p :: ParsecT s u m [a]
p sep :: ParsecT s u m [a]
sep = ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
forall s u (m :: * -> *) a.
ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
sepByWSep1 ParsecT s u m [a]
p ParsecT s u m [a]
sep ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- Character classes

isGenDelim :: Char -> Bool
isGenDelim = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ":/?#[]@")
isSubDelim :: Char -> Bool
isSubDelim = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "!$&'()*+,;=")
isReserved :: Char -> Bool
isReserved c :: Char
c = Char -> Bool
isGenDelim Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSubDelim Char
c
isUnreserved :: Char -> Bool
isUnreserved c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "-._~"
isPChar :: Char -> Bool
isPChar = [Char -> Bool] -> Char -> Bool
forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isUnreserved, Char -> Bool
isSubDelim, (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "%:@")]

satisfiesAny :: [a -> Bool] -> a -> Bool
satisfiesAny :: [a -> Bool] -> a -> Bool
satisfiesAny fs :: [a -> Bool]
fs a :: a
a = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (((a -> Bool) -> Bool) -> [a -> Bool] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ a
a) [a -> Bool]
fs)

sepByWSep1 :: ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
sepByWSep1 p :: ParsecT s u m [a]
p sep :: ParsecT s u m [a]
sep = do
	[a]
first <- ParsecT s u m [a]
p
	[[a]]
rest <- ParsecT s u m [a] -> ParsecT s u m [[a]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m [a] -> ParsecT s u m [[a]])
-> ParsecT s u m [a] -> ParsecT s u m [[a]]
forall a b. (a -> b) -> a -> b
$ do
		[a]
sepV <- ParsecT s u m [a]
sep
		[a]
pV <- ParsecT s u m [a]
p
		[a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ParsecT s u m [a]) -> [a] -> ParsecT s u m [a]
forall a b. (a -> b) -> a -> b
$ [a]
sepV [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
pV
	[a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ParsecT s u m [a]) -> [a] -> ParsecT s u m [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([a]
first [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
rest)

percentEncodedP :: ParsecT String u Identity Char
percentEncodedP = do
	String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "%"
	Char
d1 <- ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
	Char
d2 <- ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
	Char -> ParsecT String u Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ParsecT String u Identity Char)
-> Char -> ParsecT String u Identity Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ "0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
d1,Char
d2]) -- What possibly can go wrong?

reservedP :: Stream s m Char => ParsecT s u m Char
reservedP :: ParsecT s u m Char
reservedP = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isReserved
unreservedP :: ParsecT String u Identity Char
unreservedP = (Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isUnreserved
genDelimP :: Stream s m Char => ParsecT s u m Char
genDelimP :: ParsecT s u m Char
genDelimP = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isGenDelim
subDelimP :: ParsecT String u Identity Char
subDelimP = (Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSubDelim
pCharP :: ParsecT String u Identity Char
pCharP = (Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isPChar

uriP :: ParsecT String u Identity URI
uriP = do
	Maybe String
schemeV <- ParsecT String u Identity String
-> ParsecT String u Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String u Identity String
 -> ParsecT String u Identity (Maybe String))
-> ParsecT String u Identity String
-> ParsecT String u Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity String
forall u. ParsecT String u Identity String
schemeP
	(authorityV :: Maybe (Maybe String, Maybe String, Maybe Integer)
authorityV, pathV :: String
pathV) <- ParsecT
  String
  u
  Identity
  (Maybe (Maybe String, Maybe String, Maybe Integer), String)
forall u.
ParsecT
  String
  u
  Identity
  (Maybe (Maybe String, Maybe String, Maybe Integer), String)
hierPartP
	let (userinfoV :: Maybe String
userinfoV, hostV :: Maybe String
hostV, portV :: Maybe Integer
portV) = (Maybe String, Maybe String, Maybe Integer)
-> Maybe (Maybe String, Maybe String, Maybe Integer)
-> (Maybe String, Maybe String, Maybe Integer)
forall a. a -> Maybe a -> a
fromMaybe (Maybe String
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing, Maybe Integer
forall a. Maybe a
Nothing) Maybe (Maybe String, Maybe String, Maybe Integer)
authorityV
	Maybe String
queryV <- ParsecT String u Identity String
-> ParsecT String u Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String u Identity String
 -> ParsecT String u Identity (Maybe String))
-> ParsecT String u Identity String
-> ParsecT String u Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity String
 -> ParsecT String u Identity String)
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ do
		String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "?"
		ParsecT String u Identity String
forall u. ParsecT String u Identity String
queryP
	Maybe String
fragmentV <- ParsecT String u Identity String
-> ParsecT String u Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String u Identity String
 -> ParsecT String u Identity (Maybe String))
-> ParsecT String u Identity String
-> ParsecT String u Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity String
 -> ParsecT String u Identity String)
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ do
		String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "#"
		ParsecT String u Identity String
forall u. ParsecT String u Identity String
fragmentP
	URI -> ParsecT String u Identity URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> ParsecT String u Identity URI)
-> URI -> ParsecT String u Identity URI
forall a b. (a -> b) -> a -> b
$ URI :: Maybe String
-> Maybe String
-> Maybe String
-> Maybe Integer
-> String
-> Maybe String
-> Maybe String
-> URI
URI {
		uriScheme :: Maybe String
uriScheme = Maybe String
schemeV
		, uriRegName :: Maybe String
uriRegName = Maybe String
hostV
		, uriPort :: Maybe Integer
uriPort = Maybe Integer
portV
		, uriPath :: String
uriPath = String
pathV
		, uriUserInfo :: Maybe String
uriUserInfo = Maybe String
userinfoV
		, uriQuery :: Maybe String
uriQuery = Maybe String
queryV
		, uriFragment :: Maybe String
uriFragment = Maybe String
fragmentV
		}

-- | scheme parser
schemeP :: ParsecT String u Identity String
schemeP = do
	Char
l <- ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
	String
ls <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "+-.")
	String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":"
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
lChar -> ShowS
forall a. a -> [a] -> [a]
:String
ls)

hierPartP :: ParsecT
  String
  u
  Identity
  (Maybe (Maybe String, Maybe String, Maybe Integer), String)
hierPartP = do
	Maybe (Maybe String, Maybe String, Maybe Integer)
authorityV <- ParsecT
  String u Identity (Maybe String, Maybe String, Maybe Integer)
-> ParsecT
     String
     u
     Identity
     (Maybe (Maybe String, Maybe String, Maybe Integer))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT
   String u Identity (Maybe String, Maybe String, Maybe Integer)
 -> ParsecT
      String
      u
      Identity
      (Maybe (Maybe String, Maybe String, Maybe Integer)))
-> ParsecT
     String u Identity (Maybe String, Maybe String, Maybe Integer)
-> ParsecT
     String
     u
     Identity
     (Maybe (Maybe String, Maybe String, Maybe Integer))
forall a b. (a -> b) -> a -> b
$ ParsecT
  String u Identity (Maybe String, Maybe String, Maybe Integer)
-> ParsecT
     String u Identity (Maybe String, Maybe String, Maybe Integer)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT
   String u Identity (Maybe String, Maybe String, Maybe Integer)
 -> ParsecT
      String u Identity (Maybe String, Maybe String, Maybe Integer))
-> ParsecT
     String u Identity (Maybe String, Maybe String, Maybe Integer)
-> ParsecT
     String u Identity (Maybe String, Maybe String, Maybe Integer)
forall a b. (a -> b) -> a -> b
$ do
		String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "//"
		ParsecT
  String u Identity (Maybe String, Maybe String, Maybe Integer)
forall u.
ParsecT
  String u Identity (Maybe String, Maybe String, Maybe Integer)
authorityP
	String
pathV <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
pathP
	(Maybe (Maybe String, Maybe String, Maybe Integer), String)
-> ParsecT
     String
     u
     Identity
     (Maybe (Maybe String, Maybe String, Maybe Integer), String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe String, Maybe String, Maybe Integer)
authorityV, String
pathV)

-- Path parser
pathP :: ParsecT String u Identity String
pathP = (ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity String
forall u. ParsecT String u Identity String
pathRootlessP) ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity String
forall u. ParsecT String u Identity String
pathAbsoluteP ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity String
forall u. ParsecT String u Identity String
pathNoSchemeP ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity String
forall u. ParsecT String u Identity String
pathABEmptyP ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity String
forall u. ParsecT String u Identity String
pathEmptyP

pathABEmptyP :: ParsecT String u Identity String
pathABEmptyP = do
	[String]
segs <- ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity String
 -> ParsecT String u Identity [String])
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall a b. (a -> b) -> a -> b
$ do
		String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "/"
		String
segmentV <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
segmentP
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
segmentV
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
segs)

pathAbsoluteP :: ParsecT String u Identity String
pathAbsoluteP = do
	String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "/"
	String
rest <- String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT String u Identity String
 -> ParsecT String u Identity String)
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ do
		String
s1 <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
segmentNZP
		[String]
segs <- ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity String
 -> ParsecT String u Identity [String])
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall a b. (a -> b) -> a -> b
$ do
			String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "/"
			String
v <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
segmentP
			String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
s1 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
segs)
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest

pathNoSchemeP :: ParsecT String u Identity String
pathNoSchemeP = do
	String
first <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
segmentNZNCP
	String
rest <- ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
sepByWSep ParsecT String u Identity String
forall u. ParsecT String u Identity String
segmentP (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "/")
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String
first String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest

pathRootlessP :: ParsecT String u Identity String
pathRootlessP = do
	String
first <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
segmentNZP
	String
rest <- ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
sepByWSep ParsecT String u Identity String
forall u. ParsecT String u Identity String
segmentP (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "/")
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String
first String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest

pathEmptyP :: ParsecT String u Identity String
pathEmptyP = String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ""

segmentP :: ParsecT String u Identity String
segmentP = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
pCharP

segmentNZP :: ParsecT String u Identity String
segmentNZP = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
pCharP

segmentNZNCP :: ParsecT String u Identity String
segmentNZNCP = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
subDelimP ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
unreservedP ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "@%")

authorityP :: ParsecT
  String u Identity (Maybe String, Maybe String, Maybe Integer)
authorityP = do
	Maybe String
userinfoV <- ParsecT String u Identity String
-> ParsecT String u Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity String
 -> ParsecT String u Identity String)
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ do
		String
result <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
userinfoP
		String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "@"
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
result)
	String
hostV <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
hostP
	Maybe Integer
portV <- ParsecT String u Identity Integer
-> ParsecT String u Identity (Maybe Integer)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String u Identity Integer
-> ParsecT String u Identity Integer
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity Integer
 -> ParsecT String u Identity Integer)
-> ParsecT String u Identity Integer
-> ParsecT String u Identity Integer
forall a b. (a -> b) -> a -> b
$ do
		String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":"
		ParsecT String u Identity Integer
forall u. ParsecT String u Identity Integer
portP)
	(Maybe String, Maybe String, Maybe Integer)
-> ParsecT
     String u Identity (Maybe String, Maybe String, Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
userinfoV, String -> Maybe String
forall a. a -> Maybe a
Just String
hostV, Maybe Integer
portV)

hostP :: ParsecT String u Identity String
hostP = ParsecT String u Identity String
forall u. ParsecT String u Identity String
ipLiteralP ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity String
forall u. ParsecT String u Identity String
ipv4AddressP ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
forall u. ParsecT String u Identity String
regNameP

-- ip v6+ parser
ipLiteralP :: ParsecT String u Identity String
ipLiteralP = do
	String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "["
	String
result <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
ipv6AddressP ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
forall u. ParsecT String u Identity String
ipvFutureP
	String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "]"
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
result

-- Future IP parser
ipvFutureP :: ParsecT String u Identity String
ipvFutureP = do
	String
v <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "v"
	String
versionV <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
	String
dot <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "."
	String
datV <- ParsecT String u Identity Char -> ParsecT String u Identity 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 u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT String u Identity Char)
-> (Char -> Bool) -> ParsecT String u Identity Char
forall a b. (a -> b) -> a -> b
$ [Char -> Bool] -> Char -> Bool
forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isUnreserved, Char -> Bool
isSubDelim, (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':')])
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
v, String
versionV, String
dot, String
datV]

-- | Parse h16 followed by a colon, with no backtracking on failure.
h16Colon :: ParsecT String u Identity String
h16Colon = do
	String
h <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
	String
c <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":"
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c)

-- | Process 0..n instances of the specified parser, backtracking on failure.
upTo :: Int -> ParsecT s u m a -> ParsecT s u m [a]
upTo n :: Int
n p :: ParsecT s u m a
p = [ParsecT s u m [a]] -> ParsecT s u m [a]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m [a] -> ParsecT s u m [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Int -> ParsecT s u m a -> ParsecT s u m [a]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
x ParsecT s u m a
p) | Int
x <- [0..Int
n]]

ipv6AddressP :: ParsecT String u Identity String
ipv6AddressP = ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		[String]
hs <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 6 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
s <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
ls32
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
hs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::"
		[String]
hs <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 5 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
s <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
ls32
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
hs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		String
p <- String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
		String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::"
		[String]
hs <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 4 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
s <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
ls32
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
hs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		[String]
ps <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
upTo 1 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
pp <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
		String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::"
		[String]
hs <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 3 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
s <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
ls32
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
hs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		[String]
ps <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
upTo 2 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
pp <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
		String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::"
		[String]
hs <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 2 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
s <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
ls32
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
hs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		[String]
ps <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
upTo 3 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
pp <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
		String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::"
		String
h <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
s <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
ls32
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		[String]
ps <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
upTo 4 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
pp <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
		String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::"
		String
s <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
ls32
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		[String]
ps <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
upTo 5 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
pp <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
		String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::"
		String
h <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
h)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
		[String]
ps <- Int
-> ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
upTo 6 ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16Colon
		String
pp <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
		String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::"
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
co)

h16 :: ParsecT String u Identity String
h16 = Int
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 4 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
ls32 :: ParsecT String u Identity String
ls32 = ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
	String
h1 <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
	String
co <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":"
	String
h2 <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
h16
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String
h1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
h2)
	ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity String
forall u. ParsecT String u Identity String
ipv4AddressP

-- ipv4Address parser
ipv4AddressP :: ParsecT String u Identity String
ipv4AddressP = do
	String
d1 <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
decOctetP
	String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "."
	String
d2 <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
decOctetP
	String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "."
	String
d3 <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
decOctetP
	String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "."
	String
d4 <- ParsecT String u Identity String
forall u. ParsecT String u Identity String
decOctetP
	String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
d1, ".", String
d2, ".", String
d3, ".", String
d4]

-- decimal octet
decOctetP :: ParsecT String u Identity String
decOctetP = do
	String
a1 <- Integer
-> Integer
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall t a s (m :: * -> *) t u a.
(Num t, Num a, Ord t, Ord a, Stream s m t) =>
t -> a -> ParsecT s u m a -> ParsecT s u m [a]
countMinMax 1 3 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
	if String -> Integer
forall a. Read a => String -> a
read String
a1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 255 then
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Decimal octet value too large"
		else
		String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
a1

regNameP :: ParsecT String u Identity String
regNameP = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
unreservedP ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
subDelimP ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "%")

-- helper
countMinMax :: t -> a -> ParsecT s u m a -> ParsecT s u m [a]
countMinMax m :: t
m n :: a
n p :: ParsecT s u m a
p | t
m t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = do
	a
a1 <- ParsecT s u m a
p
	[a]
ar <- t -> a -> ParsecT s u m a -> ParsecT s u m [a]
countMinMax (t
mt -> t -> t
forall a. Num a => a -> a -> a
-1) (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) ParsecT s u m a
p
	[a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ar)
countMinMax _ n :: a
n _ | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
countMinMax _ n :: a
n p :: ParsecT s u m a
p = [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT s u m [a] -> ParsecT s u m [a])
-> ParsecT s u m [a] -> ParsecT s u m [a]
forall a b. (a -> b) -> a -> b
$ do
	a
a1 <- ParsecT s u m a
p
	[a]
ar <- t -> a -> ParsecT s u m a -> ParsecT s u m [a]
countMinMax 0 (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) ParsecT s u m a
p
	[a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ar)

-- port
portP :: ParsecT String u Identity Integer
portP = do
	String
digitV <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
	Integer -> ParsecT String u Identity Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ParsecT String u Identity Integer)
-> Integer -> ParsecT String u Identity Integer
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read String
digitV

-- userinfo
userinfoP :: ParsecT String u Identity String
userinfoP = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT String u Identity Char)
-> (Char -> Bool) -> ParsecT String u Identity Char
forall a b. (a -> b) -> a -> b
$ [Char -> Bool] -> Char -> Bool
forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isUnreserved, Char -> Bool
isSubDelim, (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':')]

queryP :: ParsecT String u Identity String
queryP = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Bool
isPChar) ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "/?"

queryItemP :: ParsecT String u Identity Char
queryItemP = (Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Bool
isPChar) ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "/?"

fragmentP :: ParsecT String u Identity String
fragmentP = ParsecT String u Identity String
forall u. ParsecT String u Identity String
queryP

urlEncodedPairsP :: ParsecT String u Identity [(String, String)]
urlEncodedPairsP = ParsecT String u Identity (String, String)
-> ParsecT String u Identity [(String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity (String, String)
forall u. ParsecT String u Identity (String, String)
urlEncodedPairP

urlEncodedPairP :: ParsecT String u Identity (String, String)
urlEncodedPairP = do
	String
keyV <- ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
percentEncodedP ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
plusP ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
queryItemP) (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '=')
	String
valueV <- ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
percentEncodedP ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
plusP ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
queryItemP) (ParsecT String u Identity Char -> ParsecT String u Identity ()
forall (m :: * -> *) a. Monad m => m a -> m ()
skip (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '&') ParsecT String u Identity ()
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
	(String, String) -> ParsecT String u Identity (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
keyV, String
valueV)

plusP :: ParsecT String u Identity Char
plusP = do
	Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '+'
	Char -> ParsecT String u Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return ' '

skip :: m a -> m ()
skip a :: m a
a = do
	m a
a
	() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

explode :: (Eq a) => a -> [a] -> [[a]]
explode :: a -> [a] -> [[a]]
explode _ [] = []
explode delim :: a
delim xs :: [a]
xs = let (first :: [a]
first, rest :: [a]
rest) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
delim) [a]
xs
	in [a]
first [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: case [a]
rest of
		[] -> []
		x :: a
x:[] -> [[]]
		x :: a
x:xs :: [a]
xs -> a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
explode a
delim [a]
xs