{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Soup.Structs.URI.URI' represents a (parsed) URI. t'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 t'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 t'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 'P.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-'P.Nothing'
-- (trying to parse an http URI with no /@host@/ will return 'P.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-'P.Nothing'. For http\/https URIs, /@path@/ will never be
-- an empty string either; if the input URI has no path, the parsed
-- t'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,
-- t'GI.Soup.Structs.URI.URI' should leave /@user@/, /@password@/, and /@host@/ partially-encoded
-- as well, but this would be more annoying than useful.)

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Soup.Structs.URI
    ( 

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


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveURIMethod                        ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    URICopyMethodInfo                       ,
#endif
    uRICopy                                 ,


-- ** copyHost #method:copyHost#

#if defined(ENABLE_OVERLOADING)
    URICopyHostMethodInfo                   ,
#endif
    uRICopyHost                             ,


-- ** decode #method:decode#

    uRIDecode                               ,


-- ** encode #method:encode#

    uRIEncode                               ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    URIEqualMethodInfo                      ,
#endif
    uRIEqual                                ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    URIFreeMethodInfo                       ,
#endif
    uRIFree                                 ,


-- ** getFragment #method:getFragment#

#if defined(ENABLE_OVERLOADING)
    URIGetFragmentMethodInfo                ,
#endif
    uRIGetFragment                          ,


-- ** getHost #method:getHost#

#if defined(ENABLE_OVERLOADING)
    URIGetHostMethodInfo                    ,
#endif
    uRIGetHost                              ,


-- ** getPassword #method:getPassword#

#if defined(ENABLE_OVERLOADING)
    URIGetPasswordMethodInfo                ,
#endif
    uRIGetPassword                          ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    URIGetPathMethodInfo                    ,
#endif
    uRIGetPath                              ,


-- ** getPort #method:getPort#

#if defined(ENABLE_OVERLOADING)
    URIGetPortMethodInfo                    ,
#endif
    uRIGetPort                              ,


-- ** getQuery #method:getQuery#

#if defined(ENABLE_OVERLOADING)
    URIGetQueryMethodInfo                   ,
#endif
    uRIGetQuery                             ,


-- ** getScheme #method:getScheme#

#if defined(ENABLE_OVERLOADING)
    URIGetSchemeMethodInfo                  ,
#endif
    uRIGetScheme                            ,


-- ** getUser #method:getUser#

#if defined(ENABLE_OVERLOADING)
    URIGetUserMethodInfo                    ,
#endif
    uRIGetUser                              ,


-- ** hostEqual #method:hostEqual#

#if defined(ENABLE_OVERLOADING)
    URIHostEqualMethodInfo                  ,
#endif
    uRIHostEqual                            ,


-- ** hostHash #method:hostHash#

#if defined(ENABLE_OVERLOADING)
    URIHostHashMethodInfo                   ,
#endif
    uRIHostHash                             ,


-- ** new #method:new#

    uRINew                                  ,


-- ** newWithBase #method:newWithBase#

    uRINewWithBase                          ,


-- ** normalize #method:normalize#

    uRINormalize                            ,


-- ** setFragment #method:setFragment#

#if defined(ENABLE_OVERLOADING)
    URISetFragmentMethodInfo                ,
#endif
    uRISetFragment                          ,


-- ** setHost #method:setHost#

#if defined(ENABLE_OVERLOADING)
    URISetHostMethodInfo                    ,
#endif
    uRISetHost                              ,


-- ** setPassword #method:setPassword#

#if defined(ENABLE_OVERLOADING)
    URISetPasswordMethodInfo                ,
#endif
    uRISetPassword                          ,


-- ** setPath #method:setPath#

#if defined(ENABLE_OVERLOADING)
    URISetPathMethodInfo                    ,
#endif
    uRISetPath                              ,


-- ** setPort #method:setPort#

#if defined(ENABLE_OVERLOADING)
    URISetPortMethodInfo                    ,
#endif
    uRISetPort                              ,


-- ** setQuery #method:setQuery#

#if defined(ENABLE_OVERLOADING)
    URISetQueryMethodInfo                   ,
#endif
    uRISetQuery                             ,


-- ** setQueryFromForm #method:setQueryFromForm#

#if defined(ENABLE_OVERLOADING)
    URISetQueryFromFormMethodInfo           ,
#endif
    uRISetQueryFromForm                     ,


-- ** setScheme #method:setScheme#

#if defined(ENABLE_OVERLOADING)
    URISetSchemeMethodInfo                  ,
#endif
    uRISetScheme                            ,


-- ** setUser #method:setUser#

#if defined(ENABLE_OVERLOADING)
    URISetUserMethodInfo                    ,
#endif
    uRISetUser                              ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    URIToStringMethodInfo                   ,
#endif
    uRIToString                             ,


-- ** usesDefaultPort #method:usesDefaultPort#

#if defined(ENABLE_OVERLOADING)
    URIUsesDefaultPortMethodInfo            ,
#endif
    uRIUsesDefaultPort                      ,




 -- * Properties
-- ** fragment #attr:fragment#
-- | a fragment identifier within /@path@/, or 'P.Nothing'

    clearURIFragment                        ,
    getURIFragment                          ,
    setURIFragment                          ,
#if defined(ENABLE_OVERLOADING)
    uRI_fragment                            ,
#endif


-- ** host #attr:host#
-- | the hostname or IP address, or 'P.Nothing'

    clearURIHost                            ,
    getURIHost                              ,
    setURIHost                              ,
#if defined(ENABLE_OVERLOADING)
    uRI_host                                ,
#endif


-- ** password #attr:password#
-- | a password, or 'P.Nothing'

    clearURIPassword                        ,
    getURIPassword                          ,
    setURIPassword                          ,
#if defined(ENABLE_OVERLOADING)
    uRI_password                            ,
#endif


-- ** path #attr:path#
-- | the path on /@host@/

    clearURIPath                            ,
    getURIPath                              ,
    setURIPath                              ,
#if defined(ENABLE_OVERLOADING)
    uRI_path                                ,
#endif


-- ** port #attr:port#
-- | the port number on /@host@/

    getURIPort                              ,
    setURIPort                              ,
#if defined(ENABLE_OVERLOADING)
    uRI_port                                ,
#endif


-- ** query #attr:query#
-- | a query for /@path@/, or 'P.Nothing'

    clearURIQuery                           ,
    getURIQuery                             ,
    setURIQuery                             ,
#if defined(ENABLE_OVERLOADING)
    uRI_query                               ,
#endif


-- ** scheme #attr:scheme#
-- | the URI scheme (eg, \"http\")

    clearURIScheme                          ,
    getURIScheme                            ,
    setURIScheme                            ,
#if defined(ENABLE_OVERLOADING)
    uRI_scheme                              ,
#endif


-- ** user #attr:user#
-- | a username, or 'P.Nothing'

    clearURIUser                            ,
    getURIUser                              ,
    setURIUser                              ,
#if defined(ENABLE_OVERLOADING)
    uRI_user                                ,
#endif




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
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
import qualified GHC.OverloadedLabels as OL


-- | Memory-managed wrapper type.
newtype URI = URI (SP.ManagedPtr URI)
    deriving (URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c== :: URI -> URI -> Bool
Eq)

instance SP.ManagedPtrNewtype URI where
    toManagedPtr :: URI -> ManagedPtr URI
toManagedPtr (URI ManagedPtr URI
p) = ManagedPtr URI
p

foreign import ccall "soup_uri_get_type" c_soup_uri_get_type :: 
    IO GType

type instance O.ParentTypes URI = '[]
instance O.HasParentTypes URI

instance B.Types.TypedObject URI where
    glibType :: IO GType
glibType = IO GType
c_soup_uri_get_type

instance B.Types.GBoxed URI

-- | Convert 'URI' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue URI where
    toGValue :: URI -> IO GValue
toGValue URI
o = do
        GType
gtype <- IO GType
c_soup_uri_get_type
        URI -> (Ptr URI -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr URI
o (GType -> (GValue -> Ptr URI -> IO ()) -> Ptr URI -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr URI -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO URI
fromGValue GValue
gv = do
        Ptr URI
ptr <- GValue -> IO (Ptr URI)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr URI)
        (ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr URI -> URI
URI Ptr URI
ptr
        
    

-- | Construct a `URI` struct initialized to zero.
newZeroURI :: MonadIO m => m URI
newZeroURI :: m URI
newZeroURI = IO URI -> m URI
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr URI)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
64 IO (Ptr URI) -> (Ptr URI -> IO URI) -> IO URI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr URI -> URI
URI

instance tag ~ 'AttrSet => Constructible URI tag where
    new :: (ManagedPtr URI -> URI) -> [AttrOp URI tag] -> m URI
new ManagedPtr URI -> URI
_ [AttrOp URI tag]
attrs = do
        URI
o <- m URI
forall (m :: * -> *). MonadIO m => m URI
newZeroURI
        URI -> [AttrOp URI 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set URI
o [AttrOp URI tag]
[AttrOp URI 'AttrSet]
attrs
        URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
o


-- | Get the value of the “@scheme@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRI #scheme
-- @
getURIScheme :: MonadIO m => URI -> m (Maybe T.Text)
getURIScheme :: URI -> m (Maybe Text)
getURIScheme URI
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@scheme@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' uRI [ #scheme 'Data.GI.Base.Attributes.:=' value ]
-- @
setURIScheme :: MonadIO m => URI -> CString -> m ()
setURIScheme :: URI -> CString -> m ()
setURIScheme URI
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
val :: CString)

-- | Set the value of the “@scheme@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #scheme
-- @
clearURIScheme :: MonadIO m => URI -> m ()
clearURIScheme :: URI -> m ()
clearURIScheme URI
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

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

uRI_scheme :: AttrLabelProxy "scheme"
uRI_scheme = AttrLabelProxy

#endif


-- | Get the value of the “@user@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRI #user
-- @
getURIUser :: MonadIO m => URI -> m (Maybe T.Text)
getURIUser :: URI -> m (Maybe Text)
getURIUser URI
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@user@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' uRI [ #user 'Data.GI.Base.Attributes.:=' value ]
-- @
setURIUser :: MonadIO m => URI -> CString -> m ()
setURIUser :: URI -> CString -> m ()
setURIUser URI
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
val :: CString)

-- | Set the value of the “@user@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #user
-- @
clearURIUser :: MonadIO m => URI -> m ()
clearURIUser :: URI -> m ()
clearURIUser URI
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

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

uRI_user :: AttrLabelProxy "user"
uRI_user = AttrLabelProxy

#endif


-- | Get the value of the “@password@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRI #password
-- @
getURIPassword :: MonadIO m => URI -> m (Maybe T.Text)
getURIPassword :: URI -> m (Maybe Text)
getURIPassword URI
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@password@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' uRI [ #password 'Data.GI.Base.Attributes.:=' value ]
-- @
setURIPassword :: MonadIO m => URI -> CString -> m ()
setURIPassword :: URI -> CString -> m ()
setURIPassword URI
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
val :: CString)

-- | Set the value of the “@password@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #password
-- @
clearURIPassword :: MonadIO m => URI -> m ()
clearURIPassword :: URI -> m ()
clearURIPassword URI
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

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

uRI_password :: AttrLabelProxy "password"
uRI_password = AttrLabelProxy

#endif


-- | Get the value of the “@host@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRI #host
-- @
getURIHost :: MonadIO m => URI -> m (Maybe T.Text)
getURIHost :: URI -> m (Maybe Text)
getURIHost URI
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@host@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' uRI [ #host 'Data.GI.Base.Attributes.:=' value ]
-- @
setURIHost :: MonadIO m => URI -> CString -> m ()
setURIHost :: URI -> CString -> m ()
setURIHost URI
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
val :: CString)

-- | Set the value of the “@host@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #host
-- @
clearURIHost :: MonadIO m => URI -> m ()
clearURIHost :: URI -> m ()
clearURIHost URI
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
forall a. Ptr a
FP.nullPtr :: CString)

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

uRI_host :: AttrLabelProxy "host"
uRI_host = AttrLabelProxy

#endif


-- | Get the value of the “@port@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRI #port
-- @
getURIPort :: MonadIO m => URI -> m Word32
getURIPort :: URI -> m Word32
getURIPort URI
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO Word32) -> IO Word32)
-> (Ptr URI -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr URI
ptr Ptr URI -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@port@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' uRI [ #port 'Data.GI.Base.Attributes.:=' value ]
-- @
setURIPort :: MonadIO m => URI -> Word32 -> m ()
setURIPort :: URI -> Word32 -> m ()
setURIPort URI
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data URIPortFieldInfo
instance AttrInfo URIPortFieldInfo where
    type AttrBaseTypeConstraint URIPortFieldInfo = (~) URI
    type AttrAllowedOps URIPortFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint URIPortFieldInfo = (~) Word32
    type AttrTransferTypeConstraint URIPortFieldInfo = (~)Word32
    type AttrTransferType URIPortFieldInfo = Word32
    type AttrGetType URIPortFieldInfo = Word32
    type AttrLabel URIPortFieldInfo = "port"
    type AttrOrigin URIPortFieldInfo = URI
    attrGet = getURIPort
    attrSet = setURIPort
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

uRI_port :: AttrLabelProxy "port"
uRI_port = AttrLabelProxy

#endif


-- | Get the value of the “@path@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRI #path
-- @
getURIPath :: MonadIO m => URI -> m (Maybe T.Text)
getURIPath :: URI -> m (Maybe Text)
getURIPath URI
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@path@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' uRI [ #path 'Data.GI.Base.Attributes.:=' value ]
-- @
setURIPath :: MonadIO m => URI -> CString -> m ()
setURIPath :: URI -> CString -> m ()
setURIPath URI
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CString
val :: CString)

-- | Set the value of the “@path@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #path
-- @
clearURIPath :: MonadIO m => URI -> m ()
clearURIPath :: URI -> m ()
clearURIPath URI
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CString
forall a. Ptr a
FP.nullPtr :: CString)

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

uRI_path :: AttrLabelProxy "path"
uRI_path = AttrLabelProxy

#endif


-- | Get the value of the “@query@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRI #query
-- @
getURIQuery :: MonadIO m => URI -> m (Maybe T.Text)
getURIQuery :: URI -> m (Maybe Text)
getURIQuery URI
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@query@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' uRI [ #query 'Data.GI.Base.Attributes.:=' value ]
-- @
setURIQuery :: MonadIO m => URI -> CString -> m ()
setURIQuery :: URI -> CString -> m ()
setURIQuery URI
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CString
val :: CString)

-- | Set the value of the “@query@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #query
-- @
clearURIQuery :: MonadIO m => URI -> m ()
clearURIQuery :: URI -> m ()
clearURIQuery URI
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CString
forall a. Ptr a
FP.nullPtr :: CString)

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

uRI_query :: AttrLabelProxy "query"
uRI_query = AttrLabelProxy

#endif


-- | Get the value of the “@fragment@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRI #fragment
-- @
getURIFragment :: MonadIO m => URI -> m (Maybe T.Text)
getURIFragment :: URI -> m (Maybe Text)
getURIFragment URI
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr URI -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@fragment@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' uRI [ #fragment 'Data.GI.Base.Attributes.:=' value ]
-- @
setURIFragment :: MonadIO m => URI -> CString -> m ()
setURIFragment :: URI -> CString -> m ()
setURIFragment URI
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (CString
val :: CString)

-- | Set the value of the “@fragment@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #fragment
-- @
clearURIFragment :: MonadIO m => URI -> m ()
clearURIFragment :: URI -> m ()
clearURIFragment URI
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ URI -> (Ptr URI -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr URI
s ((Ptr URI -> IO ()) -> IO ()) -> (Ptr URI -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr URI
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr URI
ptr Ptr URI -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (CString
forall a. Ptr a
FP.nullPtr :: CString)

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

uRI_fragment :: AttrLabelProxy "fragment"
uRI_fragment = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
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, *)])
#endif

-- 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 'P.Nothing' for /@uriString@/ if you want to get back an
-- \"empty\" t'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 t'GI.Soup.Structs.URI.URI', or 'P.Nothing' if the given string
    --  was found to be invalid.
uRINew :: Maybe Text -> m (Maybe URI)
uRINew Maybe Text
uriString = IO (Maybe URI) -> m (Maybe URI)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe URI) -> m (Maybe URI))
-> IO (Maybe URI) -> m (Maybe URI)
forall a b. (a -> b) -> a -> b
$ do
    CString
maybeUriString <- case Maybe Text
uriString of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jUriString -> do
            CString
jUriString' <- Text -> IO CString
textToCString Text
jUriString
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jUriString'
    Ptr URI
result <- CString -> IO (Ptr URI)
soup_uri_new CString
maybeUriString
    Maybe URI
maybeResult <- Ptr URI -> (Ptr URI -> IO URI) -> IO (Maybe URI)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr URI
result ((Ptr URI -> IO URI) -> IO (Maybe URI))
-> (Ptr URI -> IO URI) -> IO (Maybe URI)
forall a b. (a -> b) -> a -> b
$ \Ptr URI
result' -> do
        URI
result'' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr URI -> URI
URI) Ptr URI
result'
        URI -> IO URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeUriString
    Maybe URI -> IO (Maybe URI)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe URI
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method URI::new_with_base
-- method type : Constructor
-- 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 t'GI.Soup.Structs.URI.URI'.
uRINewWithBase :: URI -> Text -> m URI
uRINewWithBase URI
base Text
uriString = IO URI -> m URI
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
base' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
base
    CString
uriString' <- Text -> IO CString
textToCString Text
uriString
    Ptr URI
result <- Ptr URI -> CString -> IO (Ptr URI)
soup_uri_new_with_base Ptr URI
base' CString
uriString'
    Text -> Ptr URI -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRINewWithBase" Ptr URI
result
    URI
result' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr URI -> URI
URI) Ptr URI
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
base
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uriString'
    URI -> IO URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m URI
    -- ^ __Returns:__ a copy of /@uri@/, which must be freed with 'GI.Soup.Structs.URI.uRIFree'
uRICopy :: URI -> m URI
uRICopy URI
uri = IO URI -> m URI
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Ptr URI
result <- Ptr URI -> IO (Ptr URI)
soup_uri_copy Ptr URI
uri'
    Text -> Ptr URI -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRICopy" Ptr URI
result
    URI
result' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr URI -> URI
URI) Ptr URI
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    URI -> IO URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result'

#if defined(ENABLE_OVERLOADING)
data URICopyMethodInfo
instance (signature ~ (m URI), MonadIO m) => O.MethodInfo URICopyMethodInfo URI signature where
    overloadedMethod = uRICopy

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m URI
    -- ^ __Returns:__ the new t'GI.Soup.Structs.URI.URI'
uRICopyHost :: URI -> m URI
uRICopyHost URI
uri = IO URI -> m URI
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Ptr URI
result <- Ptr URI -> IO (Ptr URI)
soup_uri_copy_host Ptr URI
uri'
    Text -> Ptr URI -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRICopyHost" Ptr URI
result
    URI
result' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr URI -> URI
URI) Ptr URI
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    URI -> IO URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result'

#if defined(ENABLE_OVERLOADING)
data URICopyHostMethodInfo
instance (signature ~ (m URI), MonadIO m) => O.MethodInfo URICopyHostMethodInfo URI signature where
    overloadedMethod = uRICopyHost

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> URI
    -- ^ /@uri2@/: another t'GI.Soup.Structs.URI.URI'
    -> m Bool
    -- ^ __Returns:__ 'P.True' or 'P.False'
uRIEqual :: URI -> URI -> m Bool
uRIEqual URI
uri1 URI
uri2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri1' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri1
    Ptr URI
uri2' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri2
    CInt
result <- Ptr URI -> Ptr URI -> IO CInt
soup_uri_equal Ptr URI
uri1' Ptr URI
uri2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri1
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m ()
uRIFree :: URI -> m ()
uRIFree URI
uri = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Ptr URI -> IO ()
soup_uri_free Ptr URI
uri'
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data URIFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo URIFreeMethodInfo URI signature where
    overloadedMethod = uRIFree

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m T.Text
    -- ^ __Returns:__ /@uri@/\'s fragment.
uRIGetFragment :: URI -> m Text
uRIGetFragment URI
uri = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
result <- Ptr URI -> IO CString
soup_uri_get_fragment Ptr URI
uri'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIGetFragment" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m T.Text
    -- ^ __Returns:__ /@uri@/\'s host.
uRIGetHost :: URI -> m Text
uRIGetHost URI
uri = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
result <- Ptr URI -> IO CString
soup_uri_get_host Ptr URI
uri'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIGetHost" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m T.Text
    -- ^ __Returns:__ /@uri@/\'s password.
uRIGetPassword :: URI -> m Text
uRIGetPassword URI
uri = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
result <- Ptr URI -> IO CString
soup_uri_get_password Ptr URI
uri'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIGetPassword" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m T.Text
    -- ^ __Returns:__ /@uri@/\'s path.
uRIGetPath :: URI -> m Text
uRIGetPath URI
uri = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
result <- Ptr URI -> IO CString
soup_uri_get_path Ptr URI
uri'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIGetPath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m Word32
    -- ^ __Returns:__ /@uri@/\'s port.
uRIGetPort :: URI -> m Word32
uRIGetPort URI
uri = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Word32
result <- Ptr URI -> IO Word32
soup_uri_get_port Ptr URI
uri'
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m T.Text
    -- ^ __Returns:__ /@uri@/\'s query.
uRIGetQuery :: URI -> m Text
uRIGetQuery URI
uri = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
result <- Ptr URI -> IO CString
soup_uri_get_query Ptr URI
uri'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIGetQuery" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m T.Text
    -- ^ __Returns:__ /@uri@/\'s scheme.
uRIGetScheme :: URI -> m Text
uRIGetScheme URI
uri = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
result <- Ptr URI -> IO CString
soup_uri_get_scheme Ptr URI
uri'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIGetScheme" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m T.Text
    -- ^ __Returns:__ /@uri@/\'s user.
uRIGetUser :: URI -> m Text
uRIGetUser URI
uri = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
result <- Ptr URI -> IO CString
soup_uri_get_user Ptr URI
uri'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIGetUser" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI' with a non-'P.Nothing' /@host@/ member
    -> URI
    -- ^ /@v2@/: a t'GI.Soup.Structs.URI.URI' with a non-'P.Nothing' /@host@/ member
    -> m Bool
    -- ^ __Returns:__ whether or not the URIs are equal in scheme, host,
    -- and port.
uRIHostEqual :: URI -> URI -> m Bool
uRIHostEqual URI
v1 URI
v2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
v1' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
v1
    Ptr URI
v2' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
v2
    CInt
result <- Ptr URI -> Ptr URI -> IO CInt
soup_uri_host_equal Ptr URI
v1' Ptr URI
v2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
v1
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
v2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI' with a non-'P.Nothing' /@host@/ member
    -> m Word32
    -- ^ __Returns:__ a hash
uRIHostHash :: URI -> m Word32
uRIHostHash URI
key = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
key' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
key
    Word32
result <- Ptr URI -> IO Word32
soup_uri_host_hash Ptr URI
key'
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
key
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> Maybe (T.Text)
    -- ^ /@fragment@/: the fragment
    -> m ()
uRISetFragment :: URI -> Maybe Text -> m ()
uRISetFragment URI
uri Maybe Text
fragment = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
maybeFragment <- case Maybe Text
fragment of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jFragment -> do
            CString
jFragment' <- Text -> IO CString
textToCString Text
jFragment
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jFragment'
    Ptr URI -> CString -> IO ()
soup_uri_set_fragment Ptr URI
uri' CString
maybeFragment
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeFragment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 'P.Nothing' /@host@/.
uRISetHost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    URI
    -- ^ /@uri@/: a t'GI.Soup.Structs.URI.URI'
    -> Maybe (T.Text)
    -- ^ /@host@/: the hostname or IP address, or 'P.Nothing'
    -> m ()
uRISetHost :: URI -> Maybe Text -> m ()
uRISetHost URI
uri Maybe Text
host = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
maybeHost <- case Maybe Text
host of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jHost -> do
            CString
jHost' <- Text -> IO CString
textToCString Text
jHost
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jHost'
    Ptr URI -> CString -> IO ()
soup_uri_set_host Ptr URI
uri' CString
maybeHost
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeHost
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> Maybe (T.Text)
    -- ^ /@password@/: the password, or 'P.Nothing'
    -> m ()
uRISetPassword :: URI -> Maybe Text -> m ()
uRISetPassword URI
uri Maybe Text
password = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
maybePassword <- case Maybe Text
password of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPassword -> do
            CString
jPassword' <- Text -> IO CString
textToCString Text
jPassword
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPassword'
    Ptr URI -> CString -> IO ()
soup_uri_set_password Ptr URI
uri' CString
maybePassword
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePassword
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> T.Text
    -- ^ /@path@/: the non-'P.Nothing' path
    -> m ()
uRISetPath :: URI -> Text -> m ()
uRISetPath URI
uri Text
path = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr URI -> CString -> IO ()
soup_uri_set_path Ptr URI
uri' CString
path'
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> Word32
    -- ^ /@port@/: the port, or 0
    -> m ()
uRISetPort :: URI -> Word32 -> m ()
uRISetPort URI
uri Word32
port = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Ptr URI -> Word32 -> IO ()
soup_uri_set_port Ptr URI
uri' Word32
port
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> Maybe (T.Text)
    -- ^ /@query@/: the query
    -> m ()
uRISetQuery :: URI -> Maybe Text -> m ()
uRISetQuery URI
uri Maybe Text
query = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
maybeQuery <- case Maybe Text
query of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jQuery -> do
            CString
jQuery' <- Text -> IO CString
textToCString Text
jQuery
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jQuery'
    Ptr URI -> CString -> IO ()
soup_uri_set_query Ptr URI
uri' CString
maybeQuery
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeQuery
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> Map.Map T.Text T.Text
    -- ^ /@form@/: a t'GI.GLib.Structs.HashTable.HashTable' containing HTML form
    -- information
    -> m ()
uRISetQueryFromForm :: URI -> Map Text Text -> m ()
uRISetQueryFromForm URI
uri Map Text Text
form = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    let form' :: [(Text, Text)]
form' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
form
    [(CString, Text)]
form'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
form'
    [(CString, CString)]
form''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
form''
    let form'''' :: [(PtrWrapped CString, CString)]
form'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
form'''
    let form''''' :: [(PtrWrapped CString, PtrWrapped CString)]
form''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
form''''
    Ptr (GHashTable CString CString)
form'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
form'''''
    Ptr URI -> Ptr (GHashTable CString CString) -> IO ()
soup_uri_set_query_from_form Ptr URI
uri' Ptr (GHashTable CString CString)
form''''''
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
form''''''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> T.Text
    -- ^ /@scheme@/: the URI scheme
    -> m ()
uRISetScheme :: URI -> Text -> m ()
uRISetScheme URI
uri Text
scheme = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    Ptr URI -> CString -> IO ()
soup_uri_set_scheme Ptr URI
uri' CString
scheme'
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> Maybe (T.Text)
    -- ^ /@user@/: the username, or 'P.Nothing'
    -> m ()
uRISetUser :: URI -> Maybe Text -> m ()
uRISetUser URI
uri Maybe Text
user = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
maybeUser <- case Maybe Text
user of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jUser -> do
            CString
jUser' <- Text -> IO CString
textToCString Text
jUser
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jUser'
    Ptr URI -> CString -> IO ()
soup_uri_set_user Ptr URI
uri' CString
maybeUser
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeUser
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- 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 'P.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 t'GI.Soup.Structs.URI.URI'
    -> Bool
    -- ^ /@justPathAndQuery@/: if 'P.True', output just the path and query portions
    -> m T.Text
    -- ^ __Returns:__ a string representing /@uri@/, which the caller must free.
uRIToString :: URI -> Bool -> m Text
uRIToString URI
uri Bool
justPathAndQuery = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    let justPathAndQuery' :: CInt
justPathAndQuery' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
justPathAndQuery
    CString
result <- Ptr URI -> CInt -> IO CString
soup_uri_to_string Ptr URI
uri' CInt
justPathAndQuery'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

#endif

-- 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 t'GI.Soup.Structs.URI.URI'
    -> m Bool
    -- ^ __Returns:__ 'P.True' or 'P.False'
uRIUsesDefaultPort :: URI -> m Bool
uRIUsesDefaultPort URI
uri = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CInt
result <- Ptr URI -> IO CInt
soup_uri_uses_default_port Ptr URI
uri'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- 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 'P.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 :: Text -> m Text
uRIDecode Text
part = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    CString
part' <- Text -> IO CString
textToCString Text
part
    CString
result <- CString -> IO CString
soup_uri_decode CString
part'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIDecode" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
part'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- 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 'P.Nothing')
    -> m T.Text
    -- ^ __Returns:__ the encoded URI part
uRIEncode :: Text -> Maybe Text -> m Text
uRIEncode Text
part Maybe Text
escapeExtra = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    CString
part' <- Text -> IO CString
textToCString Text
part
    CString
maybeEscapeExtra <- case Maybe Text
escapeExtra of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEscapeExtra -> do
            CString
jEscapeExtra' <- Text -> IO CString
textToCString Text
jEscapeExtra
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEscapeExtra'
    CString
result <- CString -> CString -> IO CString
soup_uri_encode CString
part' CString
maybeEscapeExtra
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRIEncode" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
part'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEscapeExtra
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- 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 'P.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 'P.Nothing')
    -> m T.Text
    -- ^ __Returns:__ the normalized URI part
uRINormalize :: Text -> Maybe Text -> m Text
uRINormalize Text
part Maybe Text
unescapeExtra = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    CString
part' <- Text -> IO CString
textToCString Text
part
    CString
maybeUnescapeExtra <- case Maybe Text
unescapeExtra of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jUnescapeExtra -> do
            CString
jUnescapeExtra' <- Text -> IO CString
textToCString Text
jUnescapeExtra
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jUnescapeExtra'
    CString
result <- CString -> CString -> IO CString
soup_uri_normalize CString
part' CString
maybeUnescapeExtra
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uRINormalize" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
part'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeUnescapeExtra
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
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 "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) => OL.IsLabel t (URI -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif