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

module Network.URI
    ( -- * The URI type
      URI(..)
    , URIAuth(..)
    , nullURI
      -- * Parsing
    , parseURI                  -- :: String -> Maybe URI
    , parseURIReference         -- :: String -> Maybe URI
    , parseRelativeReference    -- :: String -> Maybe URI
    , parseAbsoluteURI          -- :: String -> Maybe URI
      -- * Test for strings containing various kinds of URI
    , isURI
    , isURIReference
    , isRelativeReference
    , isAbsoluteURI
    , isIPv6address
    , isIPv4address
      -- * Relative URIs
    , relativeTo                -- :: URI -> URI -> Maybe URI
    , nonStrictRelativeTo       -- :: URI -> URI -> Maybe URI
    , relativeFrom              -- :: URI -> URI -> URI
      -- * Operations on URI strings
      -- | Support for putting strings into URI-friendly
      --   escaped format and getting them back again.
      --   This can't be done transparently in all cases, because certain
      --   characters have different meanings in different kinds of URI.
      --   The URI spec [3], section 2.4, indicates that all URI components
      --   should be escaped before they are assembled as a URI:
      --   \"Once produced, a URI is always in its percent-encoded form\"
    , uriToString               -- :: URI -> ShowS
    , isReserved, isUnreserved  -- :: Char -> Bool
    , isAllowedInURI, isUnescapedInURI  -- :: Char -> Bool
    , escapeURIChar             -- :: (Char->Bool) -> Char -> String
    , escapeURIString           -- :: (Char->Bool) -> String -> String
    , unEscapeString            -- :: String -> String
    -- * URI Normalization functions
    , normalizeCase             -- :: String -> String
    , normalizeEscape           -- :: String -> String
    , normalizePathSegments     -- :: String -> String
    -- * Deprecated functions
    , parseabsoluteURI          -- :: String -> Maybe URI
    , escapeString              -- :: String -> (Char->Bool) -> String
    , reserved, unreserved      -- :: Char -> Bool
    , scheme, authority, path, query, fragment
    )
where

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

import Data.Char( ord, chr, isHexDigit, isSpace, toLower, toUpper, digitToInt )

import Debug.Trace( trace )

import Numeric( showIntAtBase )

import Data.Maybe( isJust )

import Control.Monad( MonadPlus(..) )

#ifdef __GLASGOW_HASKELL__
import Data.Typeable  ( Typeable )
import Data.Generics  ( Data )
#else
import Data.Typeable  ( Typeable(..), TyCon, mkTyCon, mkTyConApp )
#endif

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

-- |Represents a general universal resource identifier using
--  its component parts.
--
--  For example, for the URI
--
--  >   foo://anonymous@www.haskell.org:42/ghc?query#frag
--
--  the components are:
--
data URI = URI
    { uriScheme     :: String           -- ^ @foo:@
    , uriAuthority  :: Maybe URIAuth    -- ^ @\/\/anonymous\@www.haskell.org:42@
    , uriPath       :: String           -- ^ @\/ghc@
    , uriQuery      :: String           -- ^ @?query@
    , uriFragment   :: String           -- ^ @#frag@
    } deriving (Eq
#ifdef __GLASGOW_HASKELL__
    , Typeable, Data
#endif
    )

#ifndef __GLASGOW_HASKELL__
uriTc :: TyCon
uriTc = mkTyCon "URI"

instance Typeable URI where
  typeOf _ = mkTyConApp uriTc []
#endif

-- |Type for authority value within a URI
data URIAuth = URIAuth
    { uriUserInfo   :: String           -- ^ @anonymous\@@
    , uriRegName    :: String           -- ^ @www.haskell.org@
    , uriPort       :: String           -- ^ @:42@
    } deriving (Eq
#ifdef __GLASGOW_HASKELL__
    , Typeable, Data
#endif
    )

#ifndef __GLASGOW_HASKELL__
uriAuthTc :: TyCon
uriAuthTc = mkTyCon "URIAuth"

instance Typeable URIAuth where
  typeOf _ = mkTyConApp uriAuthTc []
#endif

-- |Blank URI
nullURI :: URI
nullURI = URI
    { uriScheme     = ""
    , uriAuthority  = Nothing
    , uriPath       = ""
    , uriQuery      = ""
    , uriFragment   = ""
    }

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

defaultUserInfoMap :: String -> String
defaultUserInfoMap uinf = user++newpass
    where
        (user,pass) = break (==':') uinf
        newpass     = if null pass || (pass == "@")
                                   || (pass == ":@")
                        then pass
                        else ":...@"

testDefaultUserInfoMap =
     [ defaultUserInfoMap ""                == ""
     , defaultUserInfoMap "@"               == "@"
     , defaultUserInfoMap "user@"           == "user@"
     , defaultUserInfoMap "user:@"          == "user:@"
     , defaultUserInfoMap "user:anonymous@" == "user:...@"
     , defaultUserInfoMap "user:pass@"      == "user:...@"
     , defaultUserInfoMap "user:pass"       == "user:...@"
     , defaultUserInfoMap "user:anonymous"  == "user:...@"
     ]

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

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

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

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

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

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

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

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

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

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

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

-- |Test function: parse and reconstruct a URI reference
--
testURIReference :: String -> String
testURIReference uristr = show (parseAll uriReference "" uristr)

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

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

parseAll :: URIParser a -> String -> String -> Either ParseError a
parseAll parser filename uristr = parse newparser filename uristr
    where
        newparser =
            do  { res <- parser
                ; eof
                ; return res
                }

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

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

--  RFC3986, section 2.1
--
--  Parse and return a 'pct-encoded' sequence
--
escaped :: URIParser String
escaped =
    do  { char '%'
        ; h1 <- hexDigitChar
        ; h2 <- hexDigitChar
        ; return $ ['%',h1,h2]
        }

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

isGenDelims c = c `elem` ":/?#[]@"

isSubDelims c = c `elem` "!$&'()*+,;="

genDelims :: URIParser String
genDelims = do { c <- satisfy isGenDelims ; return [c] }

subDelims :: URIParser String
subDelims = do { c <- satisfy isSubDelims ; return [c] }

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

unreservedChar :: URIParser String
unreservedChar = do { c <- satisfy isUnreserved ; return [c] }

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

uri :: URIParser URI
uri =
    do  { us <- try uscheme
        -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } )
        -- ; up <- upath
        ; (ua,up) <- hierPart
        ; uq <- option "" ( do { char '?' ; uquery    } )
        ; uf <- option "" ( do { char '#' ; ufragment } )
        ; return $ URI
            { uriScheme    = us
            , uriAuthority = ua
            , uriPath      = up
            , uriQuery     = uq
            , uriFragment  = uf
            }
        }

hierPart :: URIParser ((Maybe URIAuth),String)
hierPart =
        do  { try (string "//")
            ; ua <- uauthority
            ; up <- pathAbEmpty
            ; return (ua,up)
            }
    <|> do  { up <- pathAbs
            ; return (Nothing,up)
            }
    <|> do  { up <- pathRootLess
            ; return (Nothing,up)
            }
    <|> do  { return (Nothing,"")
            }

--  RFC3986, section 3.1

uscheme :: URIParser String
uscheme =
    do  { s <- oneThenMany alphaChar (satisfy isSchemeChar)
        ; char ':'
        ; return $ s++":"
        }

--  RFC3986, section 3.2

uauthority :: URIParser (Maybe URIAuth)
uauthority =
    do  { uu <- option "" (try userinfo)
        ; uh <- host
        ; up <- option "" port
        ; return $ Just $ URIAuth
            { uriUserInfo = uu
            , uriRegName  = uh
            , uriPort     = up
            }
        }

--  RFC3986, section 3.2.1

userinfo :: URIParser String
userinfo =
    do  { uu <- many (uchar ";:&=+$,")
        ; char '@'
        ; return (concat uu ++"@")
        }

--  RFC3986, section 3.2.2

host :: URIParser String
host = ipLiteral <|> try ipv4address <|> regName

ipLiteral :: URIParser String
ipLiteral =
    do  { char '['
        ; ua <- ( ipv6address <|> ipvFuture )
        ; char ']'
        ; return $ "[" ++ ua ++ "]"
        }
    <?> "IP address literal"

ipvFuture :: URIParser String
ipvFuture =
    do  { char 'v'
        ; h <- hexDigitChar
        ; char '.'
        ; a <- many1 (satisfy isIpvFutureChar)
        ; return $ 'c':h:'.':a
        }

isIpvFutureChar c = isUnreserved c || isSubDelims c || (c==';')

ipv6address :: URIParser String
ipv6address =
        try ( do
                { a2 <- count 6 h4c
                ; a3 <- ls32
                ; return $ concat a2 ++ a3
                } )
    <|> try ( do
                { string "::"
                ; a2 <- count 5 h4c
                ; a3 <- ls32
                ; return $ "::" ++ concat a2 ++ a3
                } )
    <|> try ( do
                { a1 <- opt_n_h4c_h4 0
                ; string "::"
                ; a2 <- count 4 h4c
                ; a3 <- ls32
                ; return $ a1 ++ "::" ++ concat a2 ++ a3
                } )
    <|> try ( do
                { a1 <- opt_n_h4c_h4 1
                ; string "::"
                ; a2 <- count 3 h4c
                ; a3 <- ls32
                ; return $ a1 ++ "::" ++ concat a2 ++ a3
                } )
    <|> try ( do
                { a1 <- opt_n_h4c_h4 2
                ; string "::"
                ; a2 <- count 2 h4c
                ; a3 <- ls32
                ; return $ a1 ++ "::" ++ concat a2 ++ a3
                } )
    <|> try ( do
                { a1 <- opt_n_h4c_h4 3
                ; string "::"
                ; a2 <- h4c
                ; a3 <- ls32
                ; return $ a1 ++ "::" ++ a2 ++ a3
                } )
    <|> try ( do
                { a1 <- opt_n_h4c_h4 4
                ; string "::"
                ; a3 <- ls32
                ; return $ a1 ++ "::" ++ a3
                } )
    <|> try ( do
                { a1 <- opt_n_h4c_h4 5
                ; string "::"
                ; a3 <- h4
                ; return $ a1 ++ "::" ++ a3
                } )
    <|> try ( do
                { a1 <- opt_n_h4c_h4 6
                ; string "::"
                ; return $ a1 ++ "::"
                } )
    <?> "IPv6 address"

opt_n_h4c_h4 :: Int -> URIParser String
opt_n_h4c_h4 n = option "" $
    do  { a1 <- countMinMax 0 n h4c
        ; a2 <- h4
        ; return $ concat a1 ++ a2
        }

ls32 :: URIParser String
ls32 =  try ( do
                { a1 <- h4c
                ; a2 <- h4
                ; return (a1++a2)
                } )
    <|> ipv4address

h4c :: URIParser String
h4c = try $
    do  { a1 <- h4
        ; char ':'
        ; notFollowedBy (char ':')
        ; return $ a1 ++ ":"
        }

h4 :: URIParser String
h4 = countMinMax 1 4 hexDigitChar

ipv4address :: URIParser String
ipv4address =
    do  { a1 <- decOctet ; char '.'
        ; a2 <- decOctet ; char '.'
        ; a3 <- decOctet ; char '.'
        ; a4 <- decOctet
        ; return $ a1++"."++a2++"."++a3++"."++a4
        }

decOctet :: URIParser String
decOctet =
    do  { a1 <- countMinMax 1 3 digitChar
        ; if read a1 > 255 then
            fail "Decimal octet value too large"
          else
            return a1
        }

regName :: URIParser String
regName =
    do  { ss <- countMinMax 0 255 ( unreservedChar <|> escaped <|> subDelims )
        ; return $ concat ss
        }
    <?> "Registered name"

--  RFC3986, section 3.2.3

port :: URIParser String
port =
    do  { char ':'
        ; p <- many digitChar
        ; return (':':p)
        }

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

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

pathAbEmpty :: URIParser String
pathAbEmpty =
    do  { ss <- many slashSegment
        ; return $ concat ss
        }

pathAbs :: URIParser String
pathAbs =
    do  { char '/'
        ; ss <- option "" pathRootLess
        ; return $ '/':ss
        }

pathNoScheme :: URIParser String
pathNoScheme =
    do  { s1 <- segmentNzc
        ; ss <- many slashSegment
        ; return $ concat (s1:ss)
        }

pathRootLess :: URIParser String
pathRootLess =
    do  { s1 <- segmentNz
        ; ss <- many slashSegment
        ; return $ concat (s1:ss)
        }

slashSegment :: URIParser String
slashSegment =
    do  { char '/'
        ; s <- segment
        ; return ('/':s)
        }

segment :: URIParser String
segment =
    do  { ps <- many pchar
        ; return $ concat ps
        }

segmentNz :: URIParser String
segmentNz =
    do  { ps <- many1 pchar
        ; return $ concat ps
        }

segmentNzc :: URIParser String
segmentNzc =
    do  { ps <- many1 (uchar "@")
        ; return $ concat ps
        }

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

-- helper function for pchar and friends
uchar :: String -> URIParser String
uchar extras =
        unreservedChar
    <|> escaped
    <|> subDelims
    <|> do { c <- oneOf extras ; return [c] }

--  RFC3986, section 3.4

uquery :: URIParser String
uquery =
    do  { ss <- many $ uchar (":@"++"/?")
        ; return $ '?':concat ss
        }

--  RFC3986, section 3.5

ufragment :: URIParser String
ufragment =
    do  { ss <- many $ uchar (":@"++"/?")
        ; return $ '#':concat ss
        }

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

uriReference :: URIParser URI
uriReference = uri <|> relativeRef

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

relativeRef :: URIParser URI
relativeRef =
    do  { notMatching uscheme
        -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } )
        -- ; up <- upath
        ; (ua,up) <- relativePart
        ; uq <- option "" ( do { char '?' ; uquery    } )
        ; uf <- option "" ( do { char '#' ; ufragment } )
        ; return $ URI
            { uriScheme    = ""
            , uriAuthority = ua
            , uriPath      = up
            , uriQuery     = uq
            , uriFragment  = uf
            }
        }

relativePart :: URIParser ((Maybe URIAuth),String)
relativePart =
        do  { try (string "//")
            ; ua <- uauthority
            ; up <- pathAbEmpty
            ; return (ua,up)
            }
    <|> do  { up <- pathAbs
            ; return (Nothing,up)
            }
    <|> do  { up <- pathNoScheme
            ; return (Nothing,up)
            }
    <|> do  { return (Nothing,"")
            }

--  RFC3986, section 4.3

absoluteURI :: URIParser URI
absoluteURI =
    do  { us <- uscheme
        -- ; ua <- option Nothing ( do { try (string "//") ; uauthority } )
        -- ; up <- upath
        ; (ua,up) <- hierPart
        ; uq <- option "" ( do { char '?' ; uquery    } )
        ; return $ URI
            { uriScheme    = us
            , uriAuthority = ua
            , uriPath      = up
            , uriQuery     = uq
            , uriFragment  = ""
            }
        }

--  Imports from RFC 2234

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

isAlphaChar c    = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')

isDigitChar c    = (c >= '0' && c <= '9')

isAlphaNumChar c = isAlphaChar c || isDigitChar c

isHexDigitChar c = isHexDigit c

isSchemeChar c   = (isAlphaNumChar c) || (c `elem` "+-.")

alphaChar :: URIParser Char
alphaChar = satisfy isAlphaChar         -- or: Parsec.letter ?

digitChar :: URIParser Char
digitChar = satisfy isDigitChar         -- or: Parsec.digit ?

alphaNumChar :: URIParser Char
alphaNumChar = satisfy isAlphaNumChar

hexDigitChar :: URIParser Char
hexDigitChar = satisfy isHexDigitChar   -- or: Parsec.hexDigit ?

--  Additional parser combinators for common patterns

oneThenMany :: GenParser t s a -> GenParser t s a -> GenParser t s [a]
oneThenMany p1 pr =
    do  { a1 <- p1
        ; ar <- many pr
        ; return (a1:ar)
        }

countMinMax :: Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax m n p | m > 0 =
    do  { a1 <- p
        ; ar <- countMinMax (m-1) (n-1) p
        ; return (a1:ar)
        }
countMinMax _ n _ | n <= 0 = return []
countMinMax _ n p = option [] $
    do  { a1 <- p
        ; ar <- countMinMax 0 (n-1) p
        ; return (a1:ar)
        }

notMatching :: Show a => GenParser tok st a -> GenParser tok st ()
notMatching p = do { a <- try p ; unexpected (show a) } <|> return ()

------------------------------------------------------------
--  Reconstruct a URI string
------------------------------------------------------------
--
-- |Turn a 'URI' into a string.
--
--  Uses a supplied function to map the userinfo part of the URI.
--
--  The Show instance for URI uses a mapping that hides any password
--  that may be present in the URI.  Use this function with argument @id@
--  to preserve the password in the formatted output.
--
uriToString :: (String->String) -> URI -> ShowS
uriToString userinfomap URI { uriScheme=scheme
                            , uriAuthority=authority
                            , uriPath=path
                            , uriQuery=query
                            , uriFragment=fragment
                            } =
    (scheme++) . (uriAuthToString userinfomap authority)
               . (path++) . (query++) . (fragment++)

uriAuthToString :: (String->String) -> (Maybe URIAuth) -> ShowS
uriAuthToString _           Nothing   = id          -- shows ""
uriAuthToString userinfomap
        (Just URIAuth { uriUserInfo = uinfo
                      , uriRegName  = regname
                      , uriPort     = port
                      } ) =
    ("//"++) . (if null uinfo then id else ((userinfomap uinfo)++))
             . (regname++)
             . (port++)

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

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

-- | Returns 'True' if the character is allowed unescaped in a URI.
--
isUnescapedInURI :: Char -> Bool
isUnescapedInURI c = isReserved c || isUnreserved c

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

-- |Escape character if supplied predicate is not satisfied,
--  otherwise return character as singleton string.
--
escapeURIChar :: (Char->Bool) -> Char -> String
escapeURIChar p c
    | p c       = [c]
    | otherwise = '%' : myShowHex (ord c) ""
    where
        myShowHex :: Int -> ShowS
        myShowHex n r =  case showIntAtBase 16 (toChrHex) n r of
            []  -> "00"
            [c] ->