{-# 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
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
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
Ord, Typeable, Typeable URI
URI -> Constr
URI -> DataType
(forall b. Data b => b -> b) -> URI -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> URI -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> URI -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> URI -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> URI -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data)

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

instance Show URI where
	show :: URI -> String
show URI
u = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
		forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (forall a. [a] -> [a] -> [a]
++ String
":") forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriScheme URI
u
		, if (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriRegName URI
u) then String
"//" else String
""
		, forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (forall a. [a] -> [a] -> [a]
++ String
"@") forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriUserInfo URI
u
		, forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriRegName URI
u
		, forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Integer
s -> String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
s) forall a b. (a -> b) -> a -> b
$ URI -> Maybe Integer
uriPort URI
u
		, if (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriRegName URI
u) Bool -> Bool -> Bool
&& (Bool -> Bool
not (String
"/" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` URI -> String
uriPath URI
u Bool -> Bool -> Bool
|| URI -> String
uriPath URI
u forall a. Eq a => a -> a -> Bool
== String
"")) then (String
"/" forall a. [a] -> [a] -> [a]
++ URI -> String
uriPath URI
u) else URI -> String
uriPath URI
u
		, forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"?" forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ URI -> Maybe String
uriQuery URI
u
		, forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"#" forall a. [a] -> [a] -> [a]
++) 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 = forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isUnreserved, Char -> Bool
isSubDelim, (forall a. Eq a => a -> a -> Bool
==Char
':')]
-- | Checks if character is OK in query
okInQuery :: Char -> Bool
okInQuery :: Char -> Bool
okInQuery = forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isPChar, (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"/?")]
-- | Checks if character is OK in urlencoded query item
okInQueryItem :: Char -> Bool
okInQueryItem :: Char -> Bool
okInQueryItem Char
c = Char -> Bool
okInQuery Char
c Bool -> Bool -> Bool
&& (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c String
"&=")
-- | 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 = forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isPChar, (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"/@")]
-- | Checks if character is ok in path segment
okInPathSegment :: Char -> Bool
okInPathSegment :: Char -> Bool
okInPathSegment = forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isPChar, (forall a. Eq a => a -> a -> Bool
== Char
'@')]

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

-- | Escapes one char, see escapeString
escapeChar :: (Char -> Bool) -> Char -> String
escapeChar :: (Char -> Bool) -> Char -> String
escapeChar Char -> Bool
f Char
c = if Char -> Bool
f Char
c Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'%' then [Char
c] else forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall r. PrintfType r => String -> r
printf String
"%%%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 Char -> Bool
f String
s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ 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 URI
u = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (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 URI
u = URI -> Bool
isReference URI
u Bool -> Bool -> Bool
&& (forall a. a -> [a] -> a
headDef Char
' ' (URI -> String
uriPath URI
u) forall a. Eq a => a -> a -> Bool
/= Char
'/')

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

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

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

-- | Convenience function for extracting www-urlencoded data
uriQueryItems :: URI -> [(String, String)]
uriQueryItems :: URI -> [(String, String)]
uriQueryItems = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> [(String, String)]
queryToPairs) 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 = forall a. Eq a => a -> [a] -> [[a]]
explode Char
'/'

-- | Convenience function for extracting path segments
uriPathSegments :: URI -> [String]
uriPathSegments :: URI -> [String]
uriPathSegments = String -> [String]
pathToSegments 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 [String
""] = String
"/"
segmentsToPath [String]
ss = forall a. [a] -> [[a]] -> [a]
intercalate String
"/" forall a b. (a -> b) -> a -> b
$ 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 URI
t URI
r = if 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 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 forall a. Eq a => a -> a -> Bool
== String
"" then
			URI
t { uriQuery :: Maybe String
uriQuery = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (URI -> Maybe String
uriQuery URI
t) (forall a. a -> Maybe a
Just) 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 String
s1 String
s2 = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ URI -> URI -> URI
mergeURIs (forall a. a -> Maybe a -> a
fromMaybe URI
nullURI forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURI String
s1) (forall a. a -> Maybe a -> a
fromMaybe URI
nullURI forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURI String
s2)

-- | mergePaths for strings
mergePathStrings :: String -> String -> String
mergePathStrings :: String -> ShowS
mergePathStrings String
p1 String
p2 = [String] -> String
segmentsToPath 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 [String]
p1 p2 :: [String]
p2@(String
"":[String]
_) = [String] -> [String]
dereferencePath [String]
p2
mergePaths [String]
p1 [] = [String] -> [String]
dereferencePath [String]
p1
mergePaths [String]
p1 [String]
p2 = [String] -> [String]
dereferencePath ((forall a. [a] -> [a]
initSafe [String]
p1 forall a. [a] -> [a] -> [a]
++ [String
"."]) forall a. [a] -> [a] -> [a]
++ [String]
p2)

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

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

-- Private functions

dereferencePath' :: [String] -> [String] -> [String]
dereferencePath' :: [String] -> [String] -> [String]
dereferencePath' [String]
processed [] = [String]
processed
dereferencePath' [String]
processed [String
"."] = String
""forall a. a -> [a] -> [a]
:[String]
processed
dereferencePath' (String
".":[String]
processed) ps :: [String]
ps@(String
"..":[String]
_) = [String] -> [String] -> [String]
dereferencePath' [String]
processed [String]
ps
dereferencePath' [String]
processed (String
"..":[String]
ps) = [String] -> [String] -> [String]
dereferencePath' (forall a. [a] -> [a]
tailSafe [String]
processed) (String
"."forall a. a -> [a] -> [a]
:[String]
ps)
dereferencePath' [String]
processed (String
".":[String]
ps) = [String] -> [String] -> [String]
dereferencePath' [String]
processed [String]
ps
dereferencePath' [String]
processed (String
p:[String]
ps) = [String] -> [String] -> [String]
dereferencePath' (String
pforall 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 ParsecT s u m [a]
p ParsecT s u m [a]
sep = 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 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []

-- Character classes

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

satisfiesAny :: [a -> Bool] -> a -> Bool
satisfiesAny :: forall a. [a -> Bool] -> a -> Bool
satisfiesAny [a -> Bool]
fs a
a = forall (t :: * -> *). Foldable t => t Bool -> Bool
or (forall a b. (a -> b) -> [a] -> [b]
map (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 ParsecT s u m [a]
p ParsecT s u m [a]
sep = do
	[a]
first <- ParsecT s u m [a]
p
	[[a]]
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ do
		[a]
sepV <- ParsecT s u m [a]
sep
		[a]
pV <- ParsecT s u m [a]
p
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a]
sepV forall a. [a] -> [a] -> [a]
++ [a]
pV
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([a]
first forall a. a -> [a] -> [a]
: [[a]]
rest)

percentEncodedP :: ParsecT String u Identity Char
percentEncodedP = do
	forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%"
	Char
d1 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
	Char
d2 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ String
"0x" 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 :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
reservedP = 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 = 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 :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
genDelimP = 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 = 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 = 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 <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall {u}. ParsecT String u Identity String
schemeP
	(Maybe (Maybe String, Maybe String, Maybe Integer)
authorityV, String
pathV) <- forall {u}.
ParsecT
  String
  u
  Identity
  (Maybe (Maybe String, Maybe String, Maybe Integer), String)
hierPartP
	let (Maybe String
userinfoV, Maybe String
hostV, Maybe Integer
portV) = forall a. a -> Maybe a -> a
fromMaybe (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing) Maybe (Maybe String, Maybe String, Maybe Integer)
authorityV
	Maybe String
queryV <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
		forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"?"
		forall {u}. ParsecT String u Identity String
queryP
	Maybe String
fragmentV <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
		forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"#"
		forall {u}. ParsecT String u Identity String
fragmentP
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
	String
ls <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-.")
	forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
":"
	forall (m :: * -> *) a. Monad m => a -> m a
return (Char
lforall 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 <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
		forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"//"
		forall {u}.
ParsecT
  String u Identity (Maybe String, Maybe String, Maybe Integer)
authorityP
	String
pathV <- forall {u}. ParsecT String u Identity String
pathP
	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 = (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall {u}. ParsecT String u Identity String
pathRootlessP) forall s u (m :: * -> *) a.
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
try forall {u}. ParsecT String u Identity String
pathAbsoluteP forall s u (m :: * -> *) a.
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
try forall {u}. ParsecT String u Identity String
pathNoSchemeP forall s u (m :: * -> *) a.
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
try forall {u}. ParsecT String u Identity String
pathABEmptyP forall s u (m :: * -> *) a.
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
try forall {u}. ParsecT String u Identity String
pathEmptyP

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

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

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

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

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

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

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

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

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

hostP :: ParsecT String u Identity String
hostP = forall {u}. ParsecT String u Identity String
ipLiteralP forall s u (m :: * -> *) a.
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
try forall {u}. ParsecT String u Identity String
ipv4AddressP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT String u Identity String
regNameP

-- ip v6+ parser
ipLiteralP :: ParsecT String u Identity String
ipLiteralP = do
	forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"["
	String
result <- forall {u}. ParsecT String u Identity String
ipv6AddressP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT String u Identity String
ipvFutureP
	forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string 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 <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"v"
	String
versionV <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
	String
dot <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"."
	String
datV <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ forall a. [a -> Bool] -> a -> Bool
satisfiesAny [Char -> Bool
isUnreserved, Char -> Bool
isSubDelim, (forall a. Eq a => a -> a -> Bool
==Char
':')])
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall {u}. ParsecT String u Identity String
h16
	String
c <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
":"
	forall (m :: * -> *) a. Monad m => a -> m a
return (String
h 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 Int
n ParsecT s u m a
p = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (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 <- [Int
0..Int
n]]

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

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

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

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

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

-- helper
countMinMax :: t -> a -> ParsecT s u m a -> ParsecT s u m [a]
countMinMax t
m a
n ParsecT s u m a
p | t
m forall a. Ord a => a -> a -> Bool
> t
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
mforall a. Num a => a -> a -> a
-t
1) (a
nforall a. Num a => a -> a -> a
-a
1) ParsecT s u m a
p
	forall (m :: * -> *) a. Monad m => a -> m a
return (a
a1forall a. a -> [a] -> [a]
:[a]
ar)
countMinMax t
_ a
n ParsecT s u m a
_ | a
n forall a. Ord a => a -> a -> Bool
<= a
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
countMinMax t
_ a
n ParsecT s u m a
p = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] 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 t
0 (a
nforall a. Num a => a -> a -> a
-a
1) ParsecT s u m a
p
	forall (m :: * -> *) a. Monad m => a -> m a
return (a
a1forall a. a -> [a] -> [a]
:[a]
ar)

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

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

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

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

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

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

urlEncodedPairP :: ParsecT String u Identity (String, String)
urlEncodedPairP = do
	String
keyV <- 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 (forall {u}. ParsecT String u Identity Char
percentEncodedP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT String u Identity Char
plusP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT String u Identity Char
queryItemP) (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
	String
valueV <- 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 (forall {u}. ParsecT String u Identity Char
percentEncodedP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT String u Identity Char
plusP forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT String u Identity Char
queryItemP) (forall {m :: * -> *} {a}. Monad m => m a -> m ()
skip (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
	forall (m :: * -> *) a. Monad m => a -> m a
return (String
keyV, String
valueV)

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

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

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