{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

A 'GI.Soup.Structs.URI.URI' represents a (parsed) URI. 'GI.Soup.Structs.URI.URI' supports RFC 3986
(URI Generic Syntax), and can parse any valid URI. However, libsoup
only uses \"http\" and \"https\" URIs internally; You can use
@/SOUP_URI_VALID_FOR_HTTP()/@ to test if a 'GI.Soup.Structs.URI.URI' is a valid HTTP
URI.

/@scheme@/ will always be set in any URI. It is an interned string and
is always all lowercase. (If you parse a URI with a non-lowercase
scheme, it will be converted to lowercase.) The macros
@/SOUP_URI_SCHEME_HTTP/@ and @/SOUP_URI_SCHEME_HTTPS/@ provide the
interned values for \"http\" and \"https\" and can be compared against
URI /@scheme@/ values.

/@user@/ and /@password@/ are parsed as defined in the older URI specs
(ie, separated by a colon; RFC 3986 only talks about a single
\"userinfo\" field). Note that /@password@/ is not included in the
output of 'GI.Soup.Structs.URI.uRIToString'. libsoup does not normally use these
fields; authentication is handled via 'GI.Soup.Objects.Session.Session' signals.

/@host@/ contains the hostname, and /@port@/ the port specified in the
URI. If the URI doesn\'t contain a hostname, /@host@/ will be 'Nothing',
and if it doesn\'t specify a port, /@port@/ may be 0. However, for
\"http\" and \"https\" URIs, /@host@/ is guaranteed to be non-'Nothing'
(trying to parse an http URI with no /@host@/ will return 'Nothing'), and
/@port@/ will always be non-0 (because libsoup knows the default value
to use when it is not specified in the URI).

/@path@/ is always non-'Nothing'. For http\/https URIs, /@path@/ will never be
an empty string either; if the input URI has no path, the parsed
'GI.Soup.Structs.URI.URI' will have a /@path@/ of \"\/\".

/@query@/ and /@fragment@/ are optional for all URI types.
'GI.Soup.Functions.formDecode' may be useful for parsing /@query@/.

Note that /@path@/, /@query@/, and /@fragment@/ may contain
%\<!-- -->-encoded characters. 'GI.Soup.Structs.URI.uRINew' calls
'GI.Soup.Functions.uriNormalize' on them, but not 'GI.Soup.Functions.uriDecode'. This is
necessary to ensure that 'GI.Soup.Structs.URI.uRIToString' will generate a URI
that has exactly the same meaning as the original. (In theory,
'GI.Soup.Structs.URI.URI' should leave /@user@/, /@password@/, and /@host@/ partially-encoded
as well, but this would be more annoying than useful.)
-}

module GI.Soup.Structs.URI
    ( 

-- * Exported types
    URI(..)                                 ,
    newZeroURI                              ,
    noURI                                   ,


 -- * Methods
-- ** copy #method:copy#
    URICopyMethodInfo                       ,
    uRICopy                                 ,


-- ** copyHost #method:copyHost#
    URICopyHostMethodInfo                   ,
    uRICopyHost                             ,


-- ** decode #method:decode#
    uRIDecode                               ,


-- ** encode #method:encode#
    uRIEncode                               ,


-- ** equal #method:equal#
    URIEqualMethodInfo                      ,
    uRIEqual                                ,


-- ** free #method:free#
    URIFreeMethodInfo                       ,
    uRIFree                                 ,


-- ** getFragment #method:getFragment#
    URIGetFragmentMethodInfo                ,
    uRIGetFragment                          ,


-- ** getHost #method:getHost#
    URIGetHostMethodInfo                    ,
    uRIGetHost                              ,


-- ** getPassword #method:getPassword#
    URIGetPasswordMethodInfo                ,
    uRIGetPassword                          ,


-- ** getPath #method:getPath#
    URIGetPathMethodInfo                    ,
    uRIGetPath                              ,


-- ** getPort #method:getPort#
    URIGetPortMethodInfo                    ,
    uRIGetPort                              ,


-- ** getQuery #method:getQuery#
    URIGetQueryMethodInfo                   ,
    uRIGetQuery                             ,


-- ** getScheme #method:getScheme#
    URIGetSchemeMethodInfo                  ,
    uRIGetScheme                            ,


-- ** getUser #method:getUser#
    URIGetUserMethodInfo                    ,
    uRIGetUser                              ,


-- ** hostEqual #method:hostEqual#
    URIHostEqualMethodInfo                  ,
    uRIHostEqual                            ,


-- ** hostHash #method:hostHash#
    URIHostHashMethodInfo                   ,
    uRIHostHash                             ,


-- ** new #method:new#
    uRINew                                  ,


-- ** newWithBase #method:newWithBase#
    URINewWithBaseMethodInfo                ,
    uRINewWithBase                          ,


-- ** normalize #method:normalize#
    uRINormalize                            ,


-- ** setFragment #method:setFragment#
    URISetFragmentMethodInfo                ,
    uRISetFragment                          ,


-- ** setHost #method:setHost#
    URISetHostMethodInfo                    ,
    uRISetHost                              ,


-- ** setPassword #method:setPassword#
    URISetPasswordMethodInfo                ,
    uRISetPassword                          ,


-- ** setPath #method:setPath#
    URISetPathMethodInfo                    ,
    uRISetPath                              ,


-- ** setPort #method:setPort#
    URISetPortMethodInfo                    ,
    uRISetPort                              ,


-- ** setQuery #method:setQuery#
    URISetQueryMethodInfo                   ,
    uRISetQuery                             ,


-- ** setQueryFromForm #method:setQueryFromForm#
    URISetQueryFromFormMethodInfo           ,
    uRISetQueryFromForm                     ,


-- ** setScheme #method:setScheme#
    URISetSchemeMethodInfo                  ,
    uRISetScheme                            ,


-- ** setUser #method:setUser#
    URISetUserMethodInfo                    ,
    uRISetUser                              ,


-- ** toString #method:toString#
    URIToStringMethodInfo                   ,
    uRIToString                             ,


-- ** usesDefaultPort #method:usesDefaultPort#
    URIUsesDefaultPortMethodInfo            ,
    uRIUsesDefaultPort                      ,




 -- * Properties
-- ** fragment #attr:fragment#
    clearURIFragment                        ,
    getURIFragment                          ,
    setURIFragment                          ,
    uRI_fragment                            ,


-- ** host #attr:host#
    clearURIHost                            ,
    getURIHost                              ,
    setURIHost                              ,
    uRI_host                                ,


-- ** password #attr:password#
    clearURIPassword                        ,
    getURIPassword                          ,
    setURIPassword                          ,
    uRI_password                            ,


-- ** path #attr:path#
    clearURIPath                            ,
    getURIPath                              ,
    setURIPath                              ,
    uRI_path                                ,


-- ** port #attr:port#
    getURIPort                              ,
    setURIPort                              ,
    uRI_port                                ,


-- ** query #attr:query#
    clearURIQuery                           ,
    getURIQuery                             ,
    setURIQuery                             ,
    uRI_query                               ,


-- ** scheme #attr:scheme#
    clearURIScheme                          ,
    getURIScheme                            ,
    setURIScheme                            ,
    uRI_scheme                              ,


-- ** user #attr:user#
    clearURIUser                            ,
    getURIUser                              ,
    setURIUser                              ,
    uRI_user                                ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP


newtype URI = URI (ManagedPtr URI)
foreign import ccall "soup_uri_get_type" c_soup_uri_get_type :: 
    IO GType

instance BoxedObject URI where
    boxedType _ = c_soup_uri_get_type

-- | Construct a `URI` struct initialized to zero.
newZeroURI :: MonadIO m => m URI
newZeroURI = liftIO $ callocBoxedBytes 64 >>= wrapBoxed URI

instance tag ~ 'AttrSet => Constructible URI tag where
    new _ attrs = do
        o <- newZeroURI
        GI.Attributes.set o attrs
        return o


noURI :: Maybe URI
noURI = Nothing

getURIScheme :: MonadIO m => URI -> m (Maybe T.Text)
getURIScheme s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setURIScheme :: MonadIO m => URI -> CString -> m ()
setURIScheme s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: CString)

clearURIScheme :: MonadIO m => URI -> m ()
clearURIScheme s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: CString)

data URISchemeFieldInfo
instance AttrInfo URISchemeFieldInfo where
    type AttrAllowedOps URISchemeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint URISchemeFieldInfo = (~) CString
    type AttrBaseTypeConstraint URISchemeFieldInfo = (~) URI
    type AttrGetType URISchemeFieldInfo = Maybe T.Text
    type AttrLabel URISchemeFieldInfo = "scheme"
    type AttrOrigin URISchemeFieldInfo = URI
    attrGet _ = getURIScheme
    attrSet _ = setURIScheme
    attrConstruct = undefined
    attrClear _ = clearURIScheme

uRI_scheme :: AttrLabelProxy "scheme"
uRI_scheme = AttrLabelProxy


getURIUser :: MonadIO m => URI -> m (Maybe T.Text)
getURIUser s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setURIUser :: MonadIO m => URI -> CString -> m ()
setURIUser s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: CString)

clearURIUser :: MonadIO m => URI -> m ()
clearURIUser s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: CString)

data URIUserFieldInfo
instance AttrInfo URIUserFieldInfo where
    type AttrAllowedOps URIUserFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint URIUserFieldInfo = (~) CString
    type AttrBaseTypeConstraint URIUserFieldInfo = (~) URI
    type AttrGetType URIUserFieldInfo = Maybe T.Text
    type AttrLabel URIUserFieldInfo = "user"
    type AttrOrigin URIUserFieldInfo = URI
    attrGet _ = getURIUser
    attrSet _ = setURIUser
    attrConstruct = undefined
    attrClear _ = clearURIUser

uRI_user :: AttrLabelProxy "user"
uRI_user = AttrLabelProxy


getURIPassword :: MonadIO m => URI -> m (Maybe T.Text)
getURIPassword s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setURIPassword :: MonadIO m => URI -> CString -> m ()
setURIPassword s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: CString)

clearURIPassword :: MonadIO m => URI -> m ()
clearURIPassword s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: CString)

data URIPasswordFieldInfo
instance AttrInfo URIPasswordFieldInfo where
    type AttrAllowedOps URIPasswordFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint URIPasswordFieldInfo = (~) CString
    type AttrBaseTypeConstraint URIPasswordFieldInfo = (~) URI
    type AttrGetType URIPasswordFieldInfo = Maybe T.Text
    type AttrLabel URIPasswordFieldInfo = "password"
    type AttrOrigin URIPasswordFieldInfo = URI
    attrGet _ = getURIPassword
    attrSet _ = setURIPassword
    attrConstruct = undefined
    attrClear _ = clearURIPassword

uRI_password :: AttrLabelProxy "password"
uRI_password = AttrLabelProxy


getURIHost :: MonadIO m => URI -> m (Maybe T.Text)
getURIHost s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setURIHost :: MonadIO m => URI -> CString -> m ()
setURIHost s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: CString)

clearURIHost :: MonadIO m => URI -> m ()
clearURIHost s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (FP.nullPtr :: CString)

data URIHostFieldInfo
instance AttrInfo URIHostFieldInfo where
    type AttrAllowedOps URIHostFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint URIHostFieldInfo = (~) CString
    type AttrBaseTypeConstraint URIHostFieldInfo = (~) URI
    type AttrGetType URIHostFieldInfo = Maybe T.Text
    type AttrLabel URIHostFieldInfo = "host"
    type AttrOrigin URIHostFieldInfo = URI
    attrGet _ = getURIHost
    attrSet _ = setURIHost
    attrConstruct = undefined
    attrClear _ = clearURIHost

uRI_host :: AttrLabelProxy "host"
uRI_host = AttrLabelProxy


getURIPort :: MonadIO m => URI -> m Word32
getURIPort s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO Word32
    return val

setURIPort :: MonadIO m => URI -> Word32 -> m ()
setURIPort s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (val :: Word32)

data URIPortFieldInfo
instance AttrInfo URIPortFieldInfo where
    type AttrAllowedOps URIPortFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint URIPortFieldInfo = (~) Word32
    type AttrBaseTypeConstraint URIPortFieldInfo = (~) URI
    type AttrGetType URIPortFieldInfo = Word32
    type AttrLabel URIPortFieldInfo = "port"
    type AttrOrigin URIPortFieldInfo = URI
    attrGet _ = getURIPort
    attrSet _ = setURIPort
    attrConstruct = undefined
    attrClear _ = undefined

uRI_port :: AttrLabelProxy "port"
uRI_port = AttrLabelProxy


getURIPath :: MonadIO m => URI -> m (Maybe T.Text)
getURIPath s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 40) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setURIPath :: MonadIO m => URI -> CString -> m ()
setURIPath s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 40) (val :: CString)

clearURIPath :: MonadIO m => URI -> m ()
clearURIPath s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 40) (FP.nullPtr :: CString)

data URIPathFieldInfo
instance AttrInfo URIPathFieldInfo where
    type AttrAllowedOps URIPathFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint URIPathFieldInfo = (~) CString
    type AttrBaseTypeConstraint URIPathFieldInfo = (~) URI
    type AttrGetType URIPathFieldInfo = Maybe T.Text
    type AttrLabel URIPathFieldInfo = "path"
    type AttrOrigin URIPathFieldInfo = URI
    attrGet _ = getURIPath
    attrSet _ = setURIPath
    attrConstruct = undefined
    attrClear _ = clearURIPath

uRI_path :: AttrLabelProxy "path"
uRI_path = AttrLabelProxy


getURIQuery :: MonadIO m => URI -> m (Maybe T.Text)
getURIQuery s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 48) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setURIQuery :: MonadIO m => URI -> CString -> m ()
setURIQuery s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (val :: CString)

clearURIQuery :: MonadIO m => URI -> m ()
clearURIQuery s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (FP.nullPtr :: CString)

data URIQueryFieldInfo
instance AttrInfo URIQueryFieldInfo where
    type AttrAllowedOps URIQueryFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint URIQueryFieldInfo = (~) CString
    type AttrBaseTypeConstraint URIQueryFieldInfo = (~) URI
    type AttrGetType URIQueryFieldInfo = Maybe T.Text
    type AttrLabel URIQueryFieldInfo = "query"
    type AttrOrigin URIQueryFieldInfo = URI
    attrGet _ = getURIQuery
    attrSet _ = setURIQuery
    attrConstruct = undefined
    attrClear _ = clearURIQuery

uRI_query :: AttrLabelProxy "query"
uRI_query = AttrLabelProxy


getURIFragment :: MonadIO m => URI -> m (Maybe T.Text)
getURIFragment s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setURIFragment :: MonadIO m => URI -> CString -> m ()
setURIFragment s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (val :: CString)

clearURIFragment :: MonadIO m => URI -> m ()
clearURIFragment s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (FP.nullPtr :: CString)

data URIFragmentFieldInfo
instance AttrInfo URIFragmentFieldInfo where
    type AttrAllowedOps URIFragmentFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint URIFragmentFieldInfo = (~) CString
    type AttrBaseTypeConstraint URIFragmentFieldInfo = (~) URI
    type AttrGetType URIFragmentFieldInfo = Maybe T.Text
    type AttrLabel URIFragmentFieldInfo = "fragment"
    type AttrOrigin URIFragmentFieldInfo = URI
    attrGet _ = getURIFragment
    attrSet _ = setURIFragment
    attrConstruct = undefined
    attrClear _ = clearURIFragment

uRI_fragment :: AttrLabelProxy "fragment"
uRI_fragment = AttrLabelProxy



instance O.HasAttributeList URI
type instance O.AttributeList URI = URIAttributeList
type URIAttributeList = ('[ '("scheme", URISchemeFieldInfo), '("user", URIUserFieldInfo), '("password", URIPasswordFieldInfo), '("host", URIHostFieldInfo), '("port", URIPortFieldInfo), '("path", URIPathFieldInfo), '("query", URIQueryFieldInfo), '("fragment", URIFragmentFieldInfo)] :: [(Symbol, *)])

-- method URI::new
-- method type : Constructor
-- Args : [Arg {argCName = "uri_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a URI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Soup", name = "URI"}))
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_new" soup_uri_new :: 
    CString ->                              -- uri_string : TBasicType TUTF8
    IO (Ptr URI)

{- |
Parses an absolute URI.

You can also pass 'Nothing' for /@uriString@/ if you want to get back an
\"empty\" 'GI.Soup.Structs.URI.URI' that you can fill in by hand. (You will need to
call at least 'GI.Soup.Structs.URI.uRISetScheme' and 'GI.Soup.Structs.URI.uRISetPath', since
those fields are required.)
-}
uRINew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    {- ^ /@uriString@/: a URI -}
    -> m (Maybe URI)
    {- ^ __Returns:__ a 'GI.Soup.Structs.URI.URI', or 'Nothing' if the given string
 was found to be invalid. -}
uRINew uriString = liftIO $ do
    maybeUriString <- case uriString of
        Nothing -> return nullPtr
        Just jUriString -> do
            jUriString' <- textToCString jUriString
            return jUriString'
    result <- soup_uri_new maybeUriString
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapBoxed URI) result'
        return result''
    freeMem maybeUriString
    return maybeResult

-- method URI::copy
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Soup", name = "URI"}))
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_copy" soup_uri_copy :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO (Ptr URI)

{- |
Copies /@uri@/
-}
uRICopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m URI
    {- ^ __Returns:__ a copy of /@uri@/, which must be freed with 'GI.Soup.Structs.URI.uRIFree' -}
uRICopy uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_copy uri'
    checkUnexpectedReturnNULL "uRICopy" result
    result' <- (wrapBoxed URI) result
    touchManagedPtr uri
    return result'

data URICopyMethodInfo
instance (signature ~ (m URI), MonadIO m) => O.MethodInfo URICopyMethodInfo URI signature where
    overloadedMethod _ = uRICopy

-- method URI::copy_host
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Soup", name = "URI"}))
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_copy_host" soup_uri_copy_host :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO (Ptr URI)

{- |
Makes a copy of /@uri@/, considering only the protocol, host, and port

@since 2.28
-}
uRICopyHost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m URI
    {- ^ __Returns:__ the new 'GI.Soup.Structs.URI.URI' -}
uRICopyHost uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_copy_host uri'
    checkUnexpectedReturnNULL "uRICopyHost" result
    result' <- (wrapBoxed URI) result
    touchManagedPtr uri
    return result'

data URICopyHostMethodInfo
instance (signature ~ (m URI), MonadIO m) => O.MethodInfo URICopyHostMethodInfo URI signature where
    overloadedMethod _ = uRICopyHost

-- method URI::equal
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri1", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "uri2", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "another #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_equal" soup_uri_equal :: 
    Ptr URI ->                              -- uri1 : TInterface (Name {namespace = "Soup", name = "URI"})
    Ptr URI ->                              -- uri2 : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CInt

{- |
Tests whether or not /@uri1@/ and /@uri2@/ are equal in all parts
-}
uRIEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri1@/: a 'GI.Soup.Structs.URI.URI' -}
    -> URI
    {- ^ /@uri2@/: another 'GI.Soup.Structs.URI.URI' -}
    -> m Bool
    {- ^ __Returns:__ 'True' or 'False' -}
uRIEqual uri1 uri2 = liftIO $ do
    uri1' <- unsafeManagedPtrGetPtr uri1
    uri2' <- unsafeManagedPtrGetPtr uri2
    result <- soup_uri_equal uri1' uri2'
    let result' = (/= 0) result
    touchManagedPtr uri1
    touchManagedPtr uri2
    return result'

data URIEqualMethodInfo
instance (signature ~ (URI -> m Bool), MonadIO m) => O.MethodInfo URIEqualMethodInfo URI signature where
    overloadedMethod _ = uRIEqual

-- method URI::free
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_free" soup_uri_free :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO ()

{- |
Frees /@uri@/.
-}
uRIFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m ()
uRIFree uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    soup_uri_free uri'
    touchManagedPtr uri
    return ()

data URIFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo URIFreeMethodInfo URI signature where
    overloadedMethod _ = uRIFree

-- method URI::get_fragment
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_get_fragment" soup_uri_get_fragment :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CString

{- |
Gets /@uri@/\'s fragment.

@since 2.32
-}
uRIGetFragment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m T.Text
    {- ^ __Returns:__ /@uri@/\'s fragment. -}
uRIGetFragment uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_get_fragment uri'
    checkUnexpectedReturnNULL "uRIGetFragment" result
    result' <- cstringToText result
    touchManagedPtr uri
    return result'

data URIGetFragmentMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo URIGetFragmentMethodInfo URI signature where
    overloadedMethod _ = uRIGetFragment

-- method URI::get_host
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_get_host" soup_uri_get_host :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CString

{- |
Gets /@uri@/\'s host.

@since 2.32
-}
uRIGetHost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m T.Text
    {- ^ __Returns:__ /@uri@/\'s host. -}
uRIGetHost uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_get_host uri'
    checkUnexpectedReturnNULL "uRIGetHost" result
    result' <- cstringToText result
    touchManagedPtr uri
    return result'

data URIGetHostMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo URIGetHostMethodInfo URI signature where
    overloadedMethod _ = uRIGetHost

-- method URI::get_password
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_get_password" soup_uri_get_password :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CString

{- |
Gets /@uri@/\'s password.

@since 2.32
-}
uRIGetPassword ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m T.Text
    {- ^ __Returns:__ /@uri@/\'s password. -}
uRIGetPassword uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_get_password uri'
    checkUnexpectedReturnNULL "uRIGetPassword" result
    result' <- cstringToText result
    touchManagedPtr uri
    return result'

data URIGetPasswordMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo URIGetPasswordMethodInfo URI signature where
    overloadedMethod _ = uRIGetPassword

-- method URI::get_path
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_get_path" soup_uri_get_path :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CString

{- |
Gets /@uri@/\'s path.

@since 2.32
-}
uRIGetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m T.Text
    {- ^ __Returns:__ /@uri@/\'s path. -}
uRIGetPath uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_get_path uri'
    checkUnexpectedReturnNULL "uRIGetPath" result
    result' <- cstringToText result
    touchManagedPtr uri
    return result'

data URIGetPathMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo URIGetPathMethodInfo URI signature where
    overloadedMethod _ = uRIGetPath

-- method URI::get_port
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_get_port" soup_uri_get_port :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO Word32

{- |
Gets /@uri@/\'s port.

@since 2.32
-}
uRIGetPort ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m Word32
    {- ^ __Returns:__ /@uri@/\'s port. -}
uRIGetPort uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_get_port uri'
    touchManagedPtr uri
    return result

data URIGetPortMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo URIGetPortMethodInfo URI signature where
    overloadedMethod _ = uRIGetPort

-- method URI::get_query
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_get_query" soup_uri_get_query :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CString

{- |
Gets /@uri@/\'s query.

@since 2.32
-}
uRIGetQuery ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m T.Text
    {- ^ __Returns:__ /@uri@/\'s query. -}
uRIGetQuery uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_get_query uri'
    checkUnexpectedReturnNULL "uRIGetQuery" result
    result' <- cstringToText result
    touchManagedPtr uri
    return result'

data URIGetQueryMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo URIGetQueryMethodInfo URI signature where
    overloadedMethod _ = uRIGetQuery

-- method URI::get_scheme
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_get_scheme" soup_uri_get_scheme :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CString

{- |
Gets /@uri@/\'s scheme.

@since 2.32
-}
uRIGetScheme ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m T.Text
    {- ^ __Returns:__ /@uri@/\'s scheme. -}
uRIGetScheme uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_get_scheme uri'
    checkUnexpectedReturnNULL "uRIGetScheme" result
    result' <- cstringToText result
    touchManagedPtr uri
    return result'

data URIGetSchemeMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo URIGetSchemeMethodInfo URI signature where
    overloadedMethod _ = uRIGetScheme

-- method URI::get_user
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_get_user" soup_uri_get_user :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CString

{- |
Gets /@uri@/\'s user.

@since 2.32
-}
uRIGetUser ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m T.Text
    {- ^ __Returns:__ /@uri@/\'s user. -}
uRIGetUser uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_get_user uri'
    checkUnexpectedReturnNULL "uRIGetUser" result
    result' <- cstringToText result
    touchManagedPtr uri
    return result'

data URIGetUserMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo URIGetUserMethodInfo URI signature where
    overloadedMethod _ = uRIGetUser

-- method URI::host_equal
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "v1", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI with a non-%NULL @host member", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "v2", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI with a non-%NULL @host member", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_host_equal" soup_uri_host_equal :: 
    Ptr URI ->                              -- v1 : TInterface (Name {namespace = "Soup", name = "URI"})
    Ptr URI ->                              -- v2 : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CInt

{- |
Compares /@v1@/ and /@v2@/, considering only the scheme, host, and port.

@since 2.28
-}
uRIHostEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@v1@/: a 'GI.Soup.Structs.URI.URI' with a non-'Nothing' /@host@/ member -}
    -> URI
    {- ^ /@v2@/: a 'GI.Soup.Structs.URI.URI' with a non-'Nothing' /@host@/ member -}
    -> m Bool
    {- ^ __Returns:__ whether or not the URIs are equal in scheme, host,
and port. -}
uRIHostEqual v1 v2 = liftIO $ do
    v1' <- unsafeManagedPtrGetPtr v1
    v2' <- unsafeManagedPtrGetPtr v2
    result <- soup_uri_host_equal v1' v2'
    let result' = (/= 0) result
    touchManagedPtr v1
    touchManagedPtr v2
    return result'

data URIHostEqualMethodInfo
instance (signature ~ (URI -> m Bool), MonadIO m) => O.MethodInfo URIHostEqualMethodInfo URI signature where
    overloadedMethod _ = uRIHostEqual

-- method URI::host_hash
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "key", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI with a non-%NULL @host member", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_host_hash" soup_uri_host_hash :: 
    Ptr URI ->                              -- key : TInterface (Name {namespace = "Soup", name = "URI"})
    IO Word32

{- |
Hashes /@key@/, considering only the scheme, host, and port.

@since 2.28
-}
uRIHostHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@key@/: a 'GI.Soup.Structs.URI.URI' with a non-'Nothing' /@host@/ member -}
    -> m Word32
    {- ^ __Returns:__ a hash -}
uRIHostHash key = liftIO $ do
    key' <- unsafeManagedPtrGetPtr key
    result <- soup_uri_host_hash key'
    touchManagedPtr key
    return result

data URIHostHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo URIHostHashMethodInfo URI signature where
    overloadedMethod _ = uRIHostHash

-- method URI::new_with_base
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "base", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a base URI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "uri_string", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the URI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Soup", name = "URI"}))
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_new_with_base" soup_uri_new_with_base :: 
    Ptr URI ->                              -- base : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- uri_string : TBasicType TUTF8
    IO (Ptr URI)

{- |
Parses /@uriString@/ relative to /@base@/.
-}
uRINewWithBase ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@base@/: a base URI -}
    -> T.Text
    {- ^ /@uriString@/: the URI -}
    -> m URI
    {- ^ __Returns:__ a parsed 'GI.Soup.Structs.URI.URI'. -}
uRINewWithBase base uriString = liftIO $ do
    base' <- unsafeManagedPtrGetPtr base
    uriString' <- textToCString uriString
    result <- soup_uri_new_with_base base' uriString'
    checkUnexpectedReturnNULL "uRINewWithBase" result
    result' <- (wrapBoxed URI) result
    touchManagedPtr base
    freeMem uriString'
    return result'

data URINewWithBaseMethodInfo
instance (signature ~ (T.Text -> m URI), MonadIO m) => O.MethodInfo URINewWithBaseMethodInfo URI signature where
    overloadedMethod _ = uRINewWithBase

-- method URI::set_fragment
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "fragment", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "the fragment", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_fragment" soup_uri_set_fragment :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- fragment : TBasicType TUTF8
    IO ()

{- |
Sets /@uri@/\'s fragment to /@fragment@/.
-}
uRISetFragment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> Maybe (T.Text)
    {- ^ /@fragment@/: the fragment -}
    -> m ()
uRISetFragment uri fragment = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    maybeFragment <- case fragment of
        Nothing -> return nullPtr
        Just jFragment -> do
            jFragment' <- textToCString jFragment
            return jFragment'
    soup_uri_set_fragment uri' maybeFragment
    touchManagedPtr uri
    freeMem maybeFragment
    return ()

data URISetFragmentMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.MethodInfo URISetFragmentMethodInfo URI signature where
    overloadedMethod _ = uRISetFragment

-- method URI::set_host
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "host", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "the hostname or IP address, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_host" soup_uri_set_host :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- host : TBasicType TUTF8
    IO ()

{- |
Sets /@uri@/\'s host to /@host@/.

If /@host@/ is an IPv6 IP address, it should not include the brackets
required by the URI syntax; they will be added automatically when
converting /@uri@/ to a string.

http and https URIs should not have a 'Nothing' /@host@/.
-}
uRISetHost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> Maybe (T.Text)
    {- ^ /@host@/: the hostname or IP address, or 'Nothing' -}
    -> m ()
uRISetHost uri host = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    maybeHost <- case host of
        Nothing -> return nullPtr
        Just jHost -> do
            jHost' <- textToCString jHost
            return jHost'
    soup_uri_set_host uri' maybeHost
    touchManagedPtr uri
    freeMem maybeHost
    return ()

data URISetHostMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.MethodInfo URISetHostMethodInfo URI signature where
    overloadedMethod _ = uRISetHost

-- method URI::set_password
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "password", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "the password, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_password" soup_uri_set_password :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- password : TBasicType TUTF8
    IO ()

{- |
Sets /@uri@/\'s password to /@password@/.
-}
uRISetPassword ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> Maybe (T.Text)
    {- ^ /@password@/: the password, or 'Nothing' -}
    -> m ()
uRISetPassword uri password = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    maybePassword <- case password of
        Nothing -> return nullPtr
        Just jPassword -> do
            jPassword' <- textToCString jPassword
            return jPassword'
    soup_uri_set_password uri' maybePassword
    touchManagedPtr uri
    freeMem maybePassword
    return ()

data URISetPasswordMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.MethodInfo URISetPasswordMethodInfo URI signature where
    overloadedMethod _ = uRISetPassword

-- method URI::set_path
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the non-%NULL path", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_path" soup_uri_set_path :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

{- |
Sets /@uri@/\'s path to /@path@/.
-}
uRISetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> T.Text
    {- ^ /@path@/: the non-'Nothing' path -}
    -> m ()
uRISetPath uri path = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    path' <- textToCString path
    soup_uri_set_path uri' path'
    touchManagedPtr uri
    freeMem path'
    return ()

data URISetPathMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo URISetPathMethodInfo URI signature where
    overloadedMethod _ = uRISetPath

-- method URI::set_port
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "port", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the port, or 0", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_port" soup_uri_set_port :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    Word32 ->                               -- port : TBasicType TUInt
    IO ()

{- |
Sets /@uri@/\'s port to /@port@/. If /@port@/ is 0, /@uri@/ will not have an
explicitly-specified port.
-}
uRISetPort ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> Word32
    {- ^ /@port@/: the port, or 0 -}
    -> m ()
uRISetPort uri port = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    soup_uri_set_port uri' port
    touchManagedPtr uri
    return ()

data URISetPortMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo URISetPortMethodInfo URI signature where
    overloadedMethod _ = uRISetPort

-- method URI::set_query
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "query", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "the query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_query" soup_uri_set_query :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- query : TBasicType TUTF8
    IO ()

{- |
Sets /@uri@/\'s query to /@query@/.
-}
uRISetQuery ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> Maybe (T.Text)
    {- ^ /@query@/: the query -}
    -> m ()
uRISetQuery uri query = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    maybeQuery <- case query of
        Nothing -> return nullPtr
        Just jQuery -> do
            jQuery' <- textToCString jQuery
            return jQuery'
    soup_uri_set_query uri' maybeQuery
    touchManagedPtr uri
    freeMem maybeQuery
    return ()

data URISetQueryMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.MethodInfo URISetQueryMethodInfo URI signature where
    overloadedMethod _ = uRISetQuery

-- method URI::set_query_from_form
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "form", argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GHashTable containing HTML form\ninformation", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_query_from_form" soup_uri_set_query_from_form :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    Ptr (GHashTable CString CString) ->     -- form : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    IO ()

{- |
Sets /@uri@/\'s query to the result of encoding /@form@/ according to the
HTML form rules. See 'GI.Soup.Functions.formEncodeHash' for more information.
-}
uRISetQueryFromForm ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> Map.Map T.Text T.Text
    {- ^ /@form@/: a 'GI.GLib.Structs.HashTable.HashTable' containing HTML form
information -}
    -> m ()
uRISetQueryFromForm uri form = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    let form' = Map.toList form
    form'' <- mapFirstA textToCString form'
    form''' <- mapSecondA textToCString form''
    let form'''' = mapFirst cstringPackPtr form'''
    let form''''' = mapSecond cstringPackPtr form''''
    form'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) form'''''
    soup_uri_set_query_from_form uri' form''''''
    touchManagedPtr uri
    unrefGHashTable form''''''
    return ()

data URISetQueryFromFormMethodInfo
instance (signature ~ (Map.Map T.Text T.Text -> m ()), MonadIO m) => O.MethodInfo URISetQueryFromFormMethodInfo URI signature where
    overloadedMethod _ = uRISetQueryFromForm

-- method URI::set_scheme
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "scheme", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the URI scheme", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_scheme" soup_uri_set_scheme :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO ()

{- |
Sets /@uri@/\'s scheme to /@scheme@/. This will also set /@uri@/\'s port to
the default port for /@scheme@/, if known.
-}
uRISetScheme ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> T.Text
    {- ^ /@scheme@/: the URI scheme -}
    -> m ()
uRISetScheme uri scheme = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    scheme' <- textToCString scheme
    soup_uri_set_scheme uri' scheme'
    touchManagedPtr uri
    freeMem scheme'
    return ()

data URISetSchemeMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo URISetSchemeMethodInfo URI signature where
    overloadedMethod _ = uRISetScheme

-- method URI::set_user
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "user", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "the username, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_set_user" soup_uri_set_user :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- user : TBasicType TUTF8
    IO ()

{- |
Sets /@uri@/\'s user to /@user@/.
-}
uRISetUser ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> Maybe (T.Text)
    {- ^ /@user@/: the username, or 'Nothing' -}
    -> m ()
uRISetUser uri user = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    maybeUser <- case user of
        Nothing -> return nullPtr
        Just jUser -> do
            jUser' <- textToCString jUser
            return jUser'
    soup_uri_set_user uri' maybeUser
    touchManagedPtr uri
    freeMem maybeUser
    return ()

data URISetUserMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.MethodInfo URISetUserMethodInfo URI signature where
    overloadedMethod _ = uRISetUser

-- method URI::to_string
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "just_path_and_query", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "if %TRUE, output just the path and query portions", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_to_string" soup_uri_to_string :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CInt ->                                 -- just_path_and_query : TBasicType TBoolean
    IO CString

{- |
Returns a string representing /@uri@/.

If /@justPathAndQuery@/ is 'True', this concatenates the path and query
together. That is, it constructs the string that would be needed in
the Request-Line of an HTTP request for /@uri@/.

Note that the output will never contain a password, even if /@uri@/
does.
-}
uRIToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> Bool
    {- ^ /@justPathAndQuery@/: if 'True', output just the path and query portions -}
    -> m T.Text
    {- ^ __Returns:__ a string representing /@uri@/, which the caller must free. -}
uRIToString uri justPathAndQuery = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    let justPathAndQuery' = (fromIntegral . fromEnum) justPathAndQuery
    result <- soup_uri_to_string uri' justPathAndQuery'
    checkUnexpectedReturnNULL "uRIToString" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr uri
    return result'

data URIToStringMethodInfo
instance (signature ~ (Bool -> m T.Text), MonadIO m) => O.MethodInfo URIToStringMethodInfo URI signature where
    overloadedMethod _ = uRIToString

-- method URI::uses_default_port
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "uri", argType = TInterface (Name {namespace = "Soup", name = "URI"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #SoupURI", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_uses_default_port" soup_uri_uses_default_port :: 
    Ptr URI ->                              -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CInt

{- |
Tests if /@uri@/ uses the default port for its scheme. (Eg, 80 for
http.) (This only works for http, https and ftp; libsoup does not know
the default ports of other protocols.)
-}
uRIUsesDefaultPort ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    {- ^ /@uri@/: a 'GI.Soup.Structs.URI.URI' -}
    -> m Bool
    {- ^ __Returns:__ 'True' or 'False' -}
uRIUsesDefaultPort uri = liftIO $ do
    uri' <- unsafeManagedPtrGetPtr uri
    result <- soup_uri_uses_default_port uri'
    let result' = (/= 0) result
    touchManagedPtr uri
    return result'

data URIUsesDefaultPortMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo URIUsesDefaultPortMethodInfo URI signature where
    overloadedMethod _ = uRIUsesDefaultPort

-- method URI::decode
-- method type : MemberFunction
-- Args : [Arg {argCName = "part", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a URI part", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_decode" soup_uri_decode :: 
    CString ->                              -- part : TBasicType TUTF8
    IO CString

{- |
Fully %\<!-- -->-decodes /@part@/.

In the past, this would return 'Nothing' if /@part@/ contained invalid
percent-encoding, but now it just ignores the problem (as
'GI.Soup.Structs.URI.uRINew' already did).
-}
uRIDecode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@part@/: a URI part -}
    -> m T.Text
    {- ^ __Returns:__ the decoded URI part. -}
uRIDecode part = liftIO $ do
    part' <- textToCString part
    result <- soup_uri_decode part'
    checkUnexpectedReturnNULL "uRIDecode" result
    result' <- cstringToText result
    freeMem result
    freeMem part'
    return result'

-- method URI::encode
-- method type : MemberFunction
-- Args : [Arg {argCName = "part", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a URI part", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "escape_extra", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "additional reserved characters to\nescape (or %NULL)", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_encode" soup_uri_encode :: 
    CString ->                              -- part : TBasicType TUTF8
    CString ->                              -- escape_extra : TBasicType TUTF8
    IO CString

{- |
This %\<!-- -->-encodes the given URI part and returns the escaped
version in allocated memory, which the caller must free when it is
done.
-}
uRIEncode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@part@/: a URI part -}
    -> Maybe (T.Text)
    {- ^ /@escapeExtra@/: additional reserved characters to
escape (or 'Nothing') -}
    -> m T.Text
    {- ^ __Returns:__ the encoded URI part -}
uRIEncode part escapeExtra = liftIO $ do
    part' <- textToCString part
    maybeEscapeExtra <- case escapeExtra of
        Nothing -> return nullPtr
        Just jEscapeExtra -> do
            jEscapeExtra' <- textToCString jEscapeExtra
            return jEscapeExtra'
    result <- soup_uri_encode part' maybeEscapeExtra
    checkUnexpectedReturnNULL "uRIEncode" result
    result' <- cstringToText result
    freeMem result
    freeMem part'
    freeMem maybeEscapeExtra
    return result'

-- method URI::normalize
-- method type : MemberFunction
-- Args : [Arg {argCName = "part", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a URI part", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "unescape_extra", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "reserved characters to unescape (or %NULL)", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_uri_normalize" soup_uri_normalize :: 
    CString ->                              -- part : TBasicType TUTF8
    CString ->                              -- unescape_extra : TBasicType TUTF8
    IO CString

{- |
%\<!-- -->-decodes any \"unreserved\" characters (or characters in
/@unescapeExtra@/) in /@part@/, and %\<!-- -->-encodes any non-ASCII
characters, spaces, and non-printing characters in /@part@/.

\"Unreserved\" characters are those that are not allowed to be used
for punctuation according to the URI spec. For example, letters are
unreserved, so 'GI.Soup.Functions.uriNormalize' will turn
\<literal>http:\/\/example.com\/foo\/b%\<!-- -->61r\<\/literal> into
\<literal>http:\/\/example.com\/foo\/bar\<\/literal>, which is guaranteed
to mean the same thing. However, \"\/\" is \"reserved\", so
\<literal>http:\/\/example.com\/foo%\<!-- -->2Fbar\<\/literal> would not
be changed, because it might mean something different to the
server.

In the past, this would return 'Nothing' if /@part@/ contained invalid
percent-encoding, but now it just ignores the problem (as
'GI.Soup.Structs.URI.uRINew' already did).
-}
uRINormalize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@part@/: a URI part -}
    -> Maybe (T.Text)
    {- ^ /@unescapeExtra@/: reserved characters to unescape (or 'Nothing') -}
    -> m T.Text
    {- ^ __Returns:__ the normalized URI part -}
uRINormalize part unescapeExtra = liftIO $ do
    part' <- textToCString part
    maybeUnescapeExtra <- case unescapeExtra of
        Nothing -> return nullPtr
        Just jUnescapeExtra -> do
            jUnescapeExtra' <- textToCString jUnescapeExtra
            return jUnescapeExtra'
    result <- soup_uri_normalize part' maybeUnescapeExtra
    checkUnexpectedReturnNULL "uRINormalize" result
    result' <- cstringToText result
    freeMem result
    freeMem part'
    freeMem maybeUnescapeExtra
    return result'

type family ResolveURIMethod (t :: Symbol) (o :: *) :: * where
    ResolveURIMethod "copy" o = URICopyMethodInfo
    ResolveURIMethod "copyHost" o = URICopyHostMethodInfo
    ResolveURIMethod "equal" o = URIEqualMethodInfo
    ResolveURIMethod "free" o = URIFreeMethodInfo
    ResolveURIMethod "hostEqual" o = URIHostEqualMethodInfo
    ResolveURIMethod "hostHash" o = URIHostHashMethodInfo
    ResolveURIMethod "newWithBase" o = URINewWithBaseMethodInfo
    ResolveURIMethod "toString" o = URIToStringMethodInfo
    ResolveURIMethod "usesDefaultPort" o = URIUsesDefaultPortMethodInfo
    ResolveURIMethod "getFragment" o = URIGetFragmentMethodInfo
    ResolveURIMethod "getHost" o = URIGetHostMethodInfo
    ResolveURIMethod "getPassword" o = URIGetPasswordMethodInfo
    ResolveURIMethod "getPath" o = URIGetPathMethodInfo
    ResolveURIMethod "getPort" o = URIGetPortMethodInfo
    ResolveURIMethod "getQuery" o = URIGetQueryMethodInfo
    ResolveURIMethod "getScheme" o = URIGetSchemeMethodInfo
    ResolveURIMethod "getUser" o = URIGetUserMethodInfo
    ResolveURIMethod "setFragment" o = URISetFragmentMethodInfo
    ResolveURIMethod "setHost" o = URISetHostMethodInfo
    ResolveURIMethod "setPassword" o = URISetPasswordMethodInfo
    ResolveURIMethod "setPath" o = URISetPathMethodInfo
    ResolveURIMethod "setPort" o = URISetPortMethodInfo
    ResolveURIMethod "setQuery" o = URISetQueryMethodInfo
    ResolveURIMethod "setQueryFromForm" o = URISetQueryFromFormMethodInfo
    ResolveURIMethod "setScheme" o = URISetSchemeMethodInfo
    ResolveURIMethod "setUser" o = URISetUserMethodInfo
    ResolveURIMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveURIMethod t URI, O.MethodInfo info URI p) => O.IsLabelProxy t (URI -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveURIMethod t URI, O.MethodInfo info URI p) => O.IsLabel t (URI -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif