{-# 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.Gst.Structs.Uri.Uri' object can be used to parse and split a URI string into its
-- constituent parts. Two t'GI.Gst.Structs.Uri.Uri' objects can be joined to make a new t'GI.Gst.Structs.Uri.Uri'
-- using the algorithm described in RFC3986.

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

module GI.Gst.Structs.Uri
    ( 

-- * Exported types
    Uri(..)                                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveUriMethod                        ,
#endif


-- ** appendPath #method:appendPath#

#if defined(ENABLE_OVERLOADING)
    UriAppendPathMethodInfo                 ,
#endif
    uriAppendPath                           ,


-- ** appendPathSegment #method:appendPathSegment#

#if defined(ENABLE_OVERLOADING)
    UriAppendPathSegmentMethodInfo          ,
#endif
    uriAppendPathSegment                    ,


-- ** construct #method:construct#

    uriConstruct                            ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    UriEqualMethodInfo                      ,
#endif
    uriEqual                                ,


-- ** fromString #method:fromString#

    uriFromString                           ,


-- ** fromStringWithBase #method:fromStringWithBase#

#if defined(ENABLE_OVERLOADING)
    UriFromStringWithBaseMethodInfo         ,
#endif
    uriFromStringWithBase                   ,


-- ** getFragment #method:getFragment#

#if defined(ENABLE_OVERLOADING)
    UriGetFragmentMethodInfo                ,
#endif
    uriGetFragment                          ,


-- ** getHost #method:getHost#

#if defined(ENABLE_OVERLOADING)
    UriGetHostMethodInfo                    ,
#endif
    uriGetHost                              ,


-- ** getLocation #method:getLocation#

    uriGetLocation                          ,


-- ** getMediaFragmentTable #method:getMediaFragmentTable#

#if defined(ENABLE_OVERLOADING)
    UriGetMediaFragmentTableMethodInfo      ,
#endif
    uriGetMediaFragmentTable                ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    UriGetPathMethodInfo                    ,
#endif
    uriGetPath                              ,


-- ** getPathSegments #method:getPathSegments#

#if defined(ENABLE_OVERLOADING)
    UriGetPathSegmentsMethodInfo            ,
#endif
    uriGetPathSegments                      ,


-- ** getPathString #method:getPathString#

#if defined(ENABLE_OVERLOADING)
    UriGetPathStringMethodInfo              ,
#endif
    uriGetPathString                        ,


-- ** getPort #method:getPort#

#if defined(ENABLE_OVERLOADING)
    UriGetPortMethodInfo                    ,
#endif
    uriGetPort                              ,


-- ** getProtocol #method:getProtocol#

    uriGetProtocol                          ,


-- ** getQueryKeys #method:getQueryKeys#

#if defined(ENABLE_OVERLOADING)
    UriGetQueryKeysMethodInfo               ,
#endif
    uriGetQueryKeys                         ,


-- ** getQueryString #method:getQueryString#

#if defined(ENABLE_OVERLOADING)
    UriGetQueryStringMethodInfo             ,
#endif
    uriGetQueryString                       ,


-- ** getQueryTable #method:getQueryTable#

#if defined(ENABLE_OVERLOADING)
    UriGetQueryTableMethodInfo              ,
#endif
    uriGetQueryTable                        ,


-- ** getQueryValue #method:getQueryValue#

#if defined(ENABLE_OVERLOADING)
    UriGetQueryValueMethodInfo              ,
#endif
    uriGetQueryValue                        ,


-- ** getScheme #method:getScheme#

#if defined(ENABLE_OVERLOADING)
    UriGetSchemeMethodInfo                  ,
#endif
    uriGetScheme                            ,


-- ** getUserinfo #method:getUserinfo#

#if defined(ENABLE_OVERLOADING)
    UriGetUserinfoMethodInfo                ,
#endif
    uriGetUserinfo                          ,


-- ** hasProtocol #method:hasProtocol#

    uriHasProtocol                          ,


-- ** isNormalized #method:isNormalized#

#if defined(ENABLE_OVERLOADING)
    UriIsNormalizedMethodInfo               ,
#endif
    uriIsNormalized                         ,


-- ** isValid #method:isValid#

    uriIsValid                              ,


-- ** isWritable #method:isWritable#

#if defined(ENABLE_OVERLOADING)
    UriIsWritableMethodInfo                 ,
#endif
    uriIsWritable                           ,


-- ** join #method:join#

#if defined(ENABLE_OVERLOADING)
    UriJoinMethodInfo                       ,
#endif
    uriJoin                                 ,


-- ** joinStrings #method:joinStrings#

    uriJoinStrings                          ,


-- ** makeWritable #method:makeWritable#

#if defined(ENABLE_OVERLOADING)
    UriMakeWritableMethodInfo               ,
#endif
    uriMakeWritable                         ,


-- ** new #method:new#

    uriNew                                  ,


-- ** newWithBase #method:newWithBase#

#if defined(ENABLE_OVERLOADING)
    UriNewWithBaseMethodInfo                ,
#endif
    uriNewWithBase                          ,


-- ** normalize #method:normalize#

#if defined(ENABLE_OVERLOADING)
    UriNormalizeMethodInfo                  ,
#endif
    uriNormalize                            ,


-- ** protocolIsSupported #method:protocolIsSupported#

    uriProtocolIsSupported                  ,


-- ** protocolIsValid #method:protocolIsValid#

    uriProtocolIsValid                      ,


-- ** queryHasKey #method:queryHasKey#

#if defined(ENABLE_OVERLOADING)
    UriQueryHasKeyMethodInfo                ,
#endif
    uriQueryHasKey                          ,


-- ** removeQueryKey #method:removeQueryKey#

#if defined(ENABLE_OVERLOADING)
    UriRemoveQueryKeyMethodInfo             ,
#endif
    uriRemoveQueryKey                       ,


-- ** setFragment #method:setFragment#

#if defined(ENABLE_OVERLOADING)
    UriSetFragmentMethodInfo                ,
#endif
    uriSetFragment                          ,


-- ** setHost #method:setHost#

#if defined(ENABLE_OVERLOADING)
    UriSetHostMethodInfo                    ,
#endif
    uriSetHost                              ,


-- ** setPath #method:setPath#

#if defined(ENABLE_OVERLOADING)
    UriSetPathMethodInfo                    ,
#endif
    uriSetPath                              ,


-- ** setPathSegments #method:setPathSegments#

#if defined(ENABLE_OVERLOADING)
    UriSetPathSegmentsMethodInfo            ,
#endif
    uriSetPathSegments                      ,


-- ** setPathString #method:setPathString#

#if defined(ENABLE_OVERLOADING)
    UriSetPathStringMethodInfo              ,
#endif
    uriSetPathString                        ,


-- ** setPort #method:setPort#

#if defined(ENABLE_OVERLOADING)
    UriSetPortMethodInfo                    ,
#endif
    uriSetPort                              ,


-- ** setQueryString #method:setQueryString#

#if defined(ENABLE_OVERLOADING)
    UriSetQueryStringMethodInfo             ,
#endif
    uriSetQueryString                       ,


-- ** setQueryTable #method:setQueryTable#

#if defined(ENABLE_OVERLOADING)
    UriSetQueryTableMethodInfo              ,
#endif
    uriSetQueryTable                        ,


-- ** setQueryValue #method:setQueryValue#

#if defined(ENABLE_OVERLOADING)
    UriSetQueryValueMethodInfo              ,
#endif
    uriSetQueryValue                        ,


-- ** setScheme #method:setScheme#

#if defined(ENABLE_OVERLOADING)
    UriSetSchemeMethodInfo                  ,
#endif
    uriSetScheme                            ,


-- ** setUserinfo #method:setUserinfo#

#if defined(ENABLE_OVERLOADING)
    UriSetUserinfoMethodInfo                ,
#endif
    uriSetUserinfo                          ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    UriToStringMethodInfo                   ,
#endif
    uriToString                             ,




    ) 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

import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums

-- | 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 "gst_uri_get_type" c_gst_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_gst_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_gst_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
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Uri
type instance O.AttributeList Uri = UriAttributeList
type UriAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method Uri::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The scheme for the new URI."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "userinfo"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The user-info for the new URI."
--                 , 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 host name for the new URI."
--                 , 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 number for the new URI or %GST_URI_NO_PORT."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The path for the new URI with '/' separating path\n                     elements."
--                 , 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 string for the new URI with '&' separating\n                      query elements. Elements containing '&' characters\n                      should encode them as \"&percnt;26\"."
--                 , 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 name for the new URI."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Uri" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_new" gst_uri_new :: 
    CString ->                              -- scheme : TBasicType TUTF8
    CString ->                              -- userinfo : TBasicType TUTF8
    CString ->                              -- host : TBasicType TUTF8
    Word32 ->                               -- port : TBasicType TUInt
    CString ->                              -- path : TBasicType TUTF8
    CString ->                              -- query : TBasicType TUTF8
    CString ->                              -- fragment : TBasicType TUTF8
    IO (Ptr Uri)

-- | Creates a new t'GI.Gst.Structs.Uri.Uri' object with the given URI parts. The path and query
-- strings will be broken down into their elements. All strings should not be
-- escaped except where indicated.
-- 
-- /Since: 1.6/
uriNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@scheme@/: The scheme for the new URI.
    -> Maybe (T.Text)
    -- ^ /@userinfo@/: The user-info for the new URI.
    -> Maybe (T.Text)
    -- ^ /@host@/: The host name for the new URI.
    -> Word32
    -- ^ /@port@/: The port number for the new URI or 'GI.Gst.Constants.URI_NO_PORT'.
    -> Maybe (T.Text)
    -- ^ /@path@/: The path for the new URI with \'\/\' separating path
    --                      elements.
    -> Maybe (T.Text)
    -- ^ /@query@/: The query string for the new URI with \'&\' separating
    --                       query elements. Elements containing \'&\' characters
    --                       should encode them as \"&percnt;26\".
    -> Maybe (T.Text)
    -- ^ /@fragment@/: The fragment name for the new URI.
    -> m Uri
    -- ^ __Returns:__ A new t'GI.Gst.Structs.Uri.Uri' object.
uriNew :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Word32
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> m Uri
uriNew Maybe Text
scheme Maybe Text
userinfo Maybe Text
host Word32
port Maybe Text
path Maybe Text
query Maybe Text
fragment = 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 CChar
maybeScheme <- case Maybe Text
scheme of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jScheme -> do
            Ptr CChar
jScheme' <- Text -> IO (Ptr CChar)
textToCString Text
jScheme
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jScheme'
    Ptr CChar
maybeUserinfo <- case Maybe Text
userinfo of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jUserinfo -> do
            Ptr CChar
jUserinfo' <- Text -> IO (Ptr CChar)
textToCString Text
jUserinfo
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jUserinfo'
    Ptr CChar
maybeHost <- case Maybe Text
host of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jHost -> do
            Ptr CChar
jHost' <- Text -> IO (Ptr CChar)
textToCString Text
jHost
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jHost'
    Ptr CChar
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            Ptr CChar
jPath' <- Text -> IO (Ptr CChar)
textToCString Text
jPath
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPath'
    Ptr CChar
maybeQuery <- case Maybe Text
query of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jQuery -> do
            Ptr CChar
jQuery' <- Text -> IO (Ptr CChar)
textToCString Text
jQuery
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jQuery'
    Ptr CChar
maybeFragment <- case Maybe Text
fragment of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jFragment -> do
            Ptr CChar
jFragment' <- Text -> IO (Ptr CChar)
textToCString Text
jFragment
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jFragment'
    Ptr Uri
result <- Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Word32
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> IO (Ptr Uri)
gst_uri_new Ptr CChar
maybeScheme Ptr CChar
maybeUserinfo Ptr CChar
maybeHost Word32
port Ptr CChar
maybePath Ptr CChar
maybeQuery Ptr CChar
maybeFragment
    Text -> Ptr Uri -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uriNew" 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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeScheme
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeUserinfo
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeHost
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePath
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeQuery
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeFragment
    Uri -> IO Uri
forall (m :: * -> *) a. Monad m => a -> m a
return Uri
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::append_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "relative_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Relative path to append to the end of the current path."
--                 , 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 "gst_uri_append_path" gst_uri_append_path :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- relative_path : TBasicType TUTF8
    IO CInt

-- | Append a path onto the end of the path in the URI. The path is not
-- normalized, call @/gst_uri_normalize/@() to normalize the path.
-- 
-- /Since: 1.6/
uriAppendPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@relativePath@/: Relative path to append to the end of the current path.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the path was appended successfully.
uriAppendPath :: Uri -> Text -> m Bool
uriAppendPath Uri
uri Text
relativePath = 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
    Ptr CChar
relativePath' <- Text -> IO (Ptr CChar)
textToCString Text
relativePath
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_append_path Ptr Uri
uri' Ptr CChar
relativePath'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
relativePath'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::append_path_segment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path_segment"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The path segment string to append to the URI path."
--                 , 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 "gst_uri_append_path_segment" gst_uri_append_path_segment :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- path_segment : TBasicType TUTF8
    IO CInt

-- | Append a single path segment onto the end of the URI path.
-- 
-- /Since: 1.6/
uriAppendPathSegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@pathSegment@/: The path segment string to append to the URI path.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the path was appended successfully.
uriAppendPathSegment :: Uri -> Text -> m Bool
uriAppendPathSegment Uri
uri Text
pathSegment = 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
    Ptr CChar
pathSegment' <- Text -> IO (Ptr CChar)
textToCString Text
pathSegment
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_append_path_segment Ptr Uri
uri' Ptr CChar
pathSegment'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
pathSegment'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "first"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "First #GstUri to compare."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "second"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Second #GstUri to compare."
--                 , 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 "gst_uri_equal" gst_uri_equal :: 
    Ptr Uri ->                              -- first : TInterface (Name {namespace = "Gst", name = "Uri"})
    Ptr Uri ->                              -- second : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CInt

-- | Compares two t'GI.Gst.Structs.Uri.Uri' objects to see if they represent the same normalized
-- URI.
-- 
-- /Since: 1.6/
uriEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@first@/: First t'GI.Gst.Structs.Uri.Uri' to compare.
    -> Uri
    -- ^ /@second@/: Second t'GI.Gst.Structs.Uri.Uri' to compare.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the normalized versions of the two URI\'s would be equal.
uriEqual :: Uri -> Uri -> m Bool
uriEqual Uri
first Uri
second = 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
first' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
first
    Ptr Uri
second' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
second
    CInt
result <- Ptr Uri -> Ptr Uri -> IO CInt
gst_uri_equal Ptr Uri
first' Ptr Uri
second'
    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
first
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
second
    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::from_string_with_base
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "base"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The base URI to join the new URI with."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The URI string to parse."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Uri" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_from_string_with_base" gst_uri_from_string_with_base :: 
    Ptr Uri ->                              -- base : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- uri : TBasicType TUTF8
    IO (Ptr Uri)

-- | Like 'GI.Gst.Functions.uriFromString' but also joins with a base URI.
-- 
-- /Since: 1.6/
uriFromStringWithBase ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@base@/: The base URI to join the new URI with.
    -> T.Text
    -- ^ /@uri@/: The URI string to parse.
    -> m Uri
    -- ^ __Returns:__ A new t'GI.Gst.Structs.Uri.Uri' object.
uriFromStringWithBase :: Uri -> Text -> m Uri
uriFromStringWithBase Uri
base Text
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
base' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
base
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    Ptr Uri
result <- Ptr Uri -> Ptr CChar -> IO (Ptr Uri)
gst_uri_from_string_with_base Ptr Uri
base' Ptr CChar
uri'
    Text -> Ptr Uri -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uriFromStringWithBase" 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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
    Uri -> IO Uri
forall (m :: * -> *) a. Monad m => a -> m a
return Uri
result'

#if defined(ENABLE_OVERLOADING)
data UriFromStringWithBaseMethodInfo
instance (signature ~ (T.Text -> m Uri), MonadIO m) => O.MethodInfo UriFromStringWithBaseMethodInfo Uri signature where
    overloadedMethod = uriFromStringWithBase

#endif

-- method Uri::get_fragment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "This #GstUri object."
--                 , 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 "gst_uri_get_fragment" gst_uri_get_fragment :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CString

-- | Get the fragment name from the URI or 'P.Nothing' if it doesn\'t exist.
-- If /@uri@/ is 'P.Nothing' then returns 'P.Nothing'.
-- 
-- /Since: 1.6/
uriGetFragment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: This t'GI.Gst.Structs.Uri.Uri' object.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The host name from the t'GI.Gst.Structs.Uri.Uri' object or 'P.Nothing'.
uriGetFragment :: Uri -> m (Maybe Text)
uriGetFragment Uri
uri = 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
$ do
    Ptr Uri
uri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
uri
    Ptr CChar
result <- Ptr Uri -> IO (Ptr CChar)
gst_uri_get_fragment Ptr Uri
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetFragmentMethodInfo
instance (signature ~ (m (Maybe 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 = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "This #GstUri object."
--                 , 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 "gst_uri_get_host" gst_uri_get_host :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CString

-- | Get the host name from the URI or 'P.Nothing' if it doesn\'t exist.
-- If /@uri@/ is 'P.Nothing' then returns 'P.Nothing'.
-- 
-- /Since: 1.6/
uriGetHost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: This t'GI.Gst.Structs.Uri.Uri' object.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The host name from the t'GI.Gst.Structs.Uri.Uri' object or 'P.Nothing'.
uriGetHost :: Uri -> m (Maybe Text)
uriGetHost Uri
uri = 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
$ do
    Ptr Uri
uri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
uri
    Ptr CChar
result <- Ptr Uri -> IO (Ptr CChar)
gst_uri_get_host Ptr Uri
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetHostMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo UriGetHostMethodInfo Uri signature where
    overloadedMethod = uriGetHost

#endif

-- method Uri::get_media_fragment_table
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to get the fragment table from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGHash (TBasicType TUTF8) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_get_media_fragment_table" gst_uri_get_media_fragment_table :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO (Ptr (GHashTable CString CString))

-- | Get the media fragment table from the URI, as defined by \"Media Fragments URI 1.0\".
-- Hash table returned by this API is a list of \"key-value\" pairs, and the each
-- pair is generated by splitting \"URI fragment\" per \"&\" sub-delims, then \"key\"
-- and \"value\" are split by \"=\" sub-delims. The \"key\" returned by this API may
-- be undefined keyword by standard.
-- A value may be 'P.Nothing' to indicate that the key should appear in the fragment
-- string in the URI, but does not have a value. Free the returned t'GI.GLib.Structs.HashTable.HashTable'
-- with @/g_hash_table_unref/@() when it is no longer required.
-- Modifying this hash table does not affect the fragment in the URI.
-- 
-- See more about Media Fragments URI 1.0 (W3C) at https:\/\/www.w3.org\/TR\/media-frags\/
-- 
-- /Since: 1.12/
uriGetMediaFragmentTable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to get the fragment table from.
    -> m (Maybe (Map.Map T.Text T.Text))
    -- ^ __Returns:__ The
    --          fragment hash table from the URI.
uriGetMediaFragmentTable :: Uri -> m (Maybe (Map Text Text))
uriGetMediaFragmentTable Uri
uri = IO (Maybe (Map Text Text)) -> m (Maybe (Map Text Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Map Text Text)) -> m (Maybe (Map Text Text)))
-> IO (Maybe (Map Text Text)) -> m (Maybe (Map Text 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
    Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result <- Ptr Uri -> IO (Ptr (GHashTable (Ptr CChar) (Ptr CChar)))
gst_uri_get_media_fragment_table Ptr Uri
uri'
    Maybe (Map Text Text)
maybeResult <- Ptr (GHashTable (Ptr CChar) (Ptr CChar))
-> (Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO (Map Text Text))
-> IO (Maybe (Map Text Text))
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result ((Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO (Map Text Text))
 -> IO (Maybe (Map Text Text)))
-> (Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO (Map Text Text))
-> IO (Maybe (Map Text Text))
forall a b. (a -> b) -> a -> b
$ \Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result' -> do
        [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
result'' <- Ptr (GHashTable (Ptr CChar) (Ptr CChar))
-> IO [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result'
        let result''' :: [(Ptr CChar, PtrWrapped (Ptr CChar))]
result''' = (PtrWrapped (Ptr CChar) -> Ptr CChar)
-> [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
-> [(Ptr CChar, PtrWrapped (Ptr CChar))]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped (Ptr CChar) -> Ptr CChar
cstringUnpackPtr [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
result''
        [(Text, PtrWrapped (Ptr CChar))]
result'''' <- (Ptr CChar -> IO Text)
-> [(Ptr CChar, PtrWrapped (Ptr CChar))]
-> IO [(Text, PtrWrapped (Ptr CChar))]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText [(Ptr CChar, PtrWrapped (Ptr CChar))]
result'''
        let result''''' :: [(Text, Ptr CChar)]
result''''' = (PtrWrapped (Ptr CChar) -> Ptr CChar)
-> [(Text, PtrWrapped (Ptr CChar))] -> [(Text, Ptr CChar)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped (Ptr CChar) -> Ptr CChar
cstringUnpackPtr [(Text, PtrWrapped (Ptr CChar))]
result''''
        [(Text, Text)]
result'''''' <- (Ptr CChar -> IO Text) -> [(Text, Ptr CChar)] -> IO [(Text, Text)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText [(Text, Ptr CChar)]
result'''''
        let result''''''' :: Map Text Text
result''''''' = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
result''''''
        Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result'
        Map Text Text -> IO (Map Text Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text Text
result'''''''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe (Map Text Text) -> IO (Maybe (Map Text Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map Text Text)
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetMediaFragmentTableMethodInfo
instance (signature ~ (m (Maybe (Map.Map T.Text T.Text))), MonadIO m) => O.MethodInfo UriGetMediaFragmentTableMethodInfo Uri signature where
    overloadedMethod = uriGetMediaFragmentTable

#endif

-- method Uri::get_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to get the path from."
--                 , 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 "gst_uri_get_path" gst_uri_get_path :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CString

-- | Extract the path string from the URI object.
-- 
-- /Since: 1.6/
uriGetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to get the path from.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The path from the URI. Once finished
    --                                      with the string should be 'GI.GLib.Functions.free'\'d.
uriGetPath :: Uri -> m (Maybe Text)
uriGetPath Uri
uri = 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
$ do
    Ptr Uri
uri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
uri
    Ptr CChar
result <- Ptr Uri -> IO (Ptr CChar)
gst_uri_get_path Ptr Uri
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetPathMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo UriGetPathMethodInfo Uri signature where
    overloadedMethod = uriGetPath

#endif

-- method Uri::get_path_segments
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to get the path from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_get_path_segments" gst_uri_get_path_segments :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO (Ptr (GList CString))

-- | Get a list of path segments from the URI.
-- 
-- /Since: 1.6/
uriGetPathSegments ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to get the path from.
    -> m [T.Text]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of path segment
    --          strings or 'P.Nothing' if no path segments are available. Free the list
    --          when no longer needed with g_list_free_full(list, g_free).
uriGetPathSegments :: Uri -> m [Text]
uriGetPathSegments 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
    Ptr (GList (Ptr CChar))
result <- Ptr Uri -> IO (Ptr (GList (Ptr CChar)))
gst_uri_get_path_segments Ptr Uri
uri'
    [Ptr CChar]
result' <- Ptr (GList (Ptr CChar)) -> IO [Ptr CChar]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr CChar))
result
    [Text]
result'' <- (Ptr CChar -> IO Text) -> [Ptr CChar] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText [Ptr CChar]
result'
    (Ptr CChar -> IO ()) -> Ptr (GList (Ptr CChar)) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList (Ptr CChar))
result
    Ptr (GList (Ptr CChar)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr CChar))
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 UriGetPathSegmentsMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.MethodInfo UriGetPathSegmentsMethodInfo Uri signature where
    overloadedMethod = uriGetPathSegments

#endif

-- method Uri::get_path_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to get the path from."
--                 , 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 "gst_uri_get_path_string" gst_uri_get_path_string :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CString

-- | Extract the path string from the URI object as a percent encoded URI path.
-- 
-- /Since: 1.6/
uriGetPathString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to get the path from.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The path from the URI. Once finished
    --                                      with the string should be 'GI.GLib.Functions.free'\'d.
uriGetPathString :: Uri -> m (Maybe Text)
uriGetPathString Uri
uri = 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
$ do
    Ptr Uri
uri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
uri
    Ptr CChar
result <- Ptr Uri -> IO (Ptr CChar)
gst_uri_get_path_string Ptr Uri
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetPathStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo UriGetPathStringMethodInfo Uri signature where
    overloadedMethod = uriGetPathString

#endif

-- method Uri::get_port
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "This #GstUri object."
--                 , 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 "gst_uri_get_port" gst_uri_get_port :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO Word32

-- | Get the port number from the URI or 'GI.Gst.Constants.URI_NO_PORT' if it doesn\'t exist.
-- If /@uri@/ is 'P.Nothing' then returns 'GI.Gst.Constants.URI_NO_PORT'.
-- 
-- /Since: 1.6/
uriGetPort ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: This t'GI.Gst.Structs.Uri.Uri' object.
    -> m Word32
    -- ^ __Returns:__ The port number from the t'GI.Gst.Structs.Uri.Uri' object or 'GI.Gst.Constants.URI_NO_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
gst_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_keys
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to examine."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_get_query_keys" gst_uri_get_query_keys :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO (Ptr (GList CString))

-- | Get a list of the query keys from the URI.
-- 
-- /Since: 1.6/
uriGetQueryKeys ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to examine.
    -> m [T.Text]
    -- ^ __Returns:__ A list of keys from
    --          the URI query. Free the list with @/g_list_free()/@.
uriGetQueryKeys :: Uri -> m [Text]
uriGetQueryKeys 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
    Ptr (GList (Ptr CChar))
result <- Ptr Uri -> IO (Ptr (GList (Ptr CChar)))
gst_uri_get_query_keys Ptr Uri
uri'
    [Ptr CChar]
result' <- Ptr (GList (Ptr CChar)) -> IO [Ptr CChar]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr CChar))
result
    [Text]
result'' <- (Ptr CChar -> IO Text) -> [Ptr CChar] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText [Ptr CChar]
result'
    Ptr (GList (Ptr CChar)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr CChar))
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 UriGetQueryKeysMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.MethodInfo UriGetQueryKeysMethodInfo Uri signature where
    overloadedMethod = uriGetQueryKeys

#endif

-- method Uri::get_query_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to get the query string from."
--                 , 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 "gst_uri_get_query_string" gst_uri_get_query_string :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CString

-- | Get a percent encoded URI query string from the /@uri@/.
-- 
-- /Since: 1.6/
uriGetQueryString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to get the query string from.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ A percent encoded query string. Use
    --                                      'GI.GLib.Functions.free' when no longer needed.
uriGetQueryString :: Uri -> m (Maybe Text)
uriGetQueryString Uri
uri = 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
$ do
    Ptr Uri
uri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
uri
    Ptr CChar
result <- Ptr Uri -> IO (Ptr CChar)
gst_uri_get_query_string Ptr Uri
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetQueryStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo UriGetQueryStringMethodInfo Uri signature where
    overloadedMethod = uriGetQueryString

#endif

-- method Uri::get_query_table
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to get the query table from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGHash (TBasicType TUTF8) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_get_query_table" gst_uri_get_query_table :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO (Ptr (GHashTable CString CString))

-- | Get the query table from the URI. Keys and values in the table are freed
-- with g_free when they are deleted. A value may be 'P.Nothing' to indicate that
-- the key should appear in the query string in the URI, but does not have a
-- value. Free the returned t'GI.GLib.Structs.HashTable.HashTable' with @/g_hash_table_unref/@() when it is
-- no longer required. Modifying this hash table will modify the query in the
-- URI.
-- 
-- /Since: 1.6/
uriGetQueryTable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to get the query table from.
    -> m (Maybe (Map.Map T.Text T.Text))
    -- ^ __Returns:__ The query
    --          hash table from the URI.
uriGetQueryTable :: Uri -> m (Maybe (Map Text Text))
uriGetQueryTable Uri
uri = IO (Maybe (Map Text Text)) -> m (Maybe (Map Text Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Map Text Text)) -> m (Maybe (Map Text Text)))
-> IO (Maybe (Map Text Text)) -> m (Maybe (Map Text 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
    Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result <- Ptr Uri -> IO (Ptr (GHashTable (Ptr CChar) (Ptr CChar)))
gst_uri_get_query_table Ptr Uri
uri'
    Maybe (Map Text Text)
maybeResult <- Ptr (GHashTable (Ptr CChar) (Ptr CChar))
-> (Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO (Map Text Text))
-> IO (Maybe (Map Text Text))
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result ((Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO (Map Text Text))
 -> IO (Maybe (Map Text Text)))
-> (Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO (Map Text Text))
-> IO (Maybe (Map Text Text))
forall a b. (a -> b) -> a -> b
$ \Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result' -> do
        [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
result'' <- Ptr (GHashTable (Ptr CChar) (Ptr CChar))
-> IO [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result'
        let result''' :: [(Ptr CChar, PtrWrapped (Ptr CChar))]
result''' = (PtrWrapped (Ptr CChar) -> Ptr CChar)
-> [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
-> [(Ptr CChar, PtrWrapped (Ptr CChar))]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped (Ptr CChar) -> Ptr CChar
cstringUnpackPtr [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
result''
        [(Text, PtrWrapped (Ptr CChar))]
result'''' <- (Ptr CChar -> IO Text)
-> [(Ptr CChar, PtrWrapped (Ptr CChar))]
-> IO [(Text, PtrWrapped (Ptr CChar))]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText [(Ptr CChar, PtrWrapped (Ptr CChar))]
result'''
        let result''''' :: [(Text, Ptr CChar)]
result''''' = (PtrWrapped (Ptr CChar) -> Ptr CChar)
-> [(Text, PtrWrapped (Ptr CChar))] -> [(Text, Ptr CChar)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped (Ptr CChar) -> Ptr CChar
cstringUnpackPtr [(Text, PtrWrapped (Ptr CChar))]
result''''
        [(Text, Text)]
result'''''' <- (Ptr CChar -> IO Text) -> [(Text, Ptr CChar)] -> IO [(Text, Text)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText [(Text, Ptr CChar)]
result'''''
        let result''''''' :: Map Text Text
result''''''' = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
result''''''
        Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr CChar) (Ptr CChar))
result'
        Map Text Text -> IO (Map Text Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text Text
result'''''''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe (Map Text Text) -> IO (Maybe (Map Text Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map Text Text)
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetQueryTableMethodInfo
instance (signature ~ (m (Maybe (Map.Map T.Text T.Text))), MonadIO m) => O.MethodInfo UriGetQueryTableMethodInfo Uri signature where
    overloadedMethod = uriGetQueryTable

#endif

-- method Uri::get_query_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to examine."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query_key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key to lookup." , 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 "gst_uri_get_query_value" gst_uri_get_query_value :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- query_key : TBasicType TUTF8
    IO CString

-- | Get the value associated with the /@queryKey@/ key. Will return 'P.Nothing' if the
-- key has no value or if the key does not exist in the URI query table. Because
-- 'P.Nothing' is returned for both missing keys and keys with no value, you should
-- use 'GI.Gst.Structs.Uri.uriQueryHasKey' to determine if a key is present in the URI
-- query.
-- 
-- /Since: 1.6/
uriGetQueryValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to examine.
    -> T.Text
    -- ^ /@queryKey@/: The key to lookup.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The value for the given key, or 'P.Nothing' if not found.
uriGetQueryValue :: Uri -> Text -> m (Maybe Text)
uriGetQueryValue Uri
uri Text
queryKey = 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
$ do
    Ptr Uri
uri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
uri
    Ptr CChar
queryKey' <- Text -> IO (Ptr CChar)
textToCString Text
queryKey
    Ptr CChar
result <- Ptr Uri -> Ptr CChar -> IO (Ptr CChar)
gst_uri_get_query_value Ptr Uri
uri' Ptr CChar
queryKey'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
queryKey'
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

#endif

-- method Uri::get_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "This #GstUri object."
--                 , 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 "gst_uri_get_scheme" gst_uri_get_scheme :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CString

-- | Get the scheme name from the URI or 'P.Nothing' if it doesn\'t exist.
-- If /@uri@/ is 'P.Nothing' then returns 'P.Nothing'.
uriGetScheme ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: This t'GI.Gst.Structs.Uri.Uri' object.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The scheme from the t'GI.Gst.Structs.Uri.Uri' object or 'P.Nothing'.
uriGetScheme :: Uri -> m (Maybe Text)
uriGetScheme Uri
uri = 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
$ do
    Ptr Uri
uri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
uri
    Ptr CChar
result <- Ptr Uri -> IO (Ptr CChar)
gst_uri_get_scheme Ptr Uri
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetSchemeMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo UriGetSchemeMethodInfo Uri signature where
    overloadedMethod = uriGetScheme

#endif

-- method Uri::get_userinfo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "This #GstUri object."
--                 , 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 "gst_uri_get_userinfo" gst_uri_get_userinfo :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CString

-- | Get the userinfo (usually in the form \"username:password\") from the URI
-- or 'P.Nothing' if it doesn\'t exist. If /@uri@/ is 'P.Nothing' then returns 'P.Nothing'.
-- 
-- /Since: 1.6/
uriGetUserinfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: This t'GI.Gst.Structs.Uri.Uri' object.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The userinfo from the t'GI.Gst.Structs.Uri.Uri' object or 'P.Nothing'.
uriGetUserinfo :: Uri -> m (Maybe Text)
uriGetUserinfo Uri
uri = 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
$ do
    Ptr Uri
uri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
uri
    Ptr CChar
result <- Ptr Uri -> IO (Ptr CChar)
gst_uri_get_userinfo Ptr Uri
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
uri
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriGetUserinfoMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo UriGetUserinfoMethodInfo Uri signature where
    overloadedMethod = uriGetUserinfo

#endif

-- method Uri::is_normalized
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #GstUri to test to see if it is normalized."
--                 , 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 "gst_uri_is_normalized" gst_uri_is_normalized :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CInt

-- | Tests the /@uri@/ to see if it is normalized. A 'P.Nothing' /@uri@/ is considered to be
-- normalized.
-- 
-- /Since: 1.6/
uriIsNormalized ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to test to see if it is normalized.
    -> m Bool
    -- ^ __Returns:__ TRUE if the URI is normalized or is 'P.Nothing'.
uriIsNormalized :: Uri -> m Bool
uriIsNormalized 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
gst_uri_is_normalized 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 UriIsNormalizedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo UriIsNormalizedMethodInfo Uri signature where
    overloadedMethod = uriIsNormalized

#endif

-- method Uri::is_writable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri object to test."
--                 , 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 "gst_uri_is_writable" gst_uri_is_writable :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CInt

-- | Check if it is safe to write to this t'GI.Gst.Structs.Uri.Uri'.
-- 
-- Check if the refcount of /@uri@/ is exactly 1, meaning that no other
-- reference exists to the t'GI.Gst.Structs.Uri.Uri' and that the t'GI.Gst.Structs.Uri.Uri' is therefore writable.
-- 
-- Modification of a t'GI.Gst.Structs.Uri.Uri' should only be done after verifying that it is
-- writable.
-- 
-- /Since: 1.6/
uriIsWritable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' object to test.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if it is safe to write to the object.
uriIsWritable :: Uri -> m Bool
uriIsWritable 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
gst_uri_is_writable 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 UriIsWritableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo UriIsWritableMethodInfo Uri signature where
    overloadedMethod = uriIsWritable

#endif

-- method Uri::join
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "base_uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The base URI to join another to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref_uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The reference URI to join onto the\n                                      base URI."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Uri" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_join" gst_uri_join :: 
    Ptr Uri ->                              -- base_uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    Ptr Uri ->                              -- ref_uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO (Ptr Uri)

-- | Join a reference URI onto a base URI using the method from RFC 3986.
-- If either URI is 'P.Nothing' then the other URI will be returned with the ref count
-- increased.
-- 
-- /Since: 1.6/
uriJoin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@baseUri@/: The base URI to join another to.
    -> Maybe (Uri)
    -- ^ /@refUri@/: The reference URI to join onto the
    --                                       base URI.
    -> m (Maybe Uri)
    -- ^ __Returns:__ A t'GI.Gst.Structs.Uri.Uri' which represents the base
    --                                      with the reference URI joined on.
uriJoin :: Uri -> Maybe Uri -> m (Maybe Uri)
uriJoin Uri
baseUri Maybe Uri
refUri = 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
    Ptr Uri
baseUri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
baseUri
    Ptr Uri
maybeRefUri <- case Maybe Uri
refUri of
        Maybe Uri
Nothing -> Ptr Uri -> IO (Ptr Uri)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Uri
forall a. Ptr a
nullPtr
        Just Uri
jRefUri -> do
            Ptr Uri
jRefUri' <- Uri -> IO (Ptr Uri)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Uri
jRefUri
            Ptr Uri -> IO (Ptr Uri)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Uri
jRefUri'
    Ptr Uri
result <- Ptr Uri -> Ptr Uri -> IO (Ptr Uri)
gst_uri_join Ptr Uri
baseUri' Ptr Uri
maybeRefUri
    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''
    Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Uri
baseUri
    Maybe Uri -> (Uri -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Uri
refUri Uri -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Uri -> IO (Maybe Uri)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Uri
maybeResult

#if defined(ENABLE_OVERLOADING)
data UriJoinMethodInfo
instance (signature ~ (Maybe (Uri) -> m (Maybe Uri)), MonadIO m) => O.MethodInfo UriJoinMethodInfo Uri signature where
    overloadedMethod = uriJoin

#endif

-- method Uri::make_writable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri object to make writable."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Uri" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_make_writable" gst_uri_make_writable :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO (Ptr Uri)

-- | Make the t'GI.Gst.Structs.Uri.Uri' writable.
-- 
-- Checks if /@uri@/ is writable, and if so the original object is returned. If
-- not, then a writable copy is made and returned. This gives away the
-- reference to /@uri@/ and returns a reference to the new t'GI.Gst.Structs.Uri.Uri'.
-- If /@uri@/ is 'P.Nothing' then 'P.Nothing' is returned.
-- 
-- /Since: 1.6/
uriMakeWritable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' object to make writable.
    -> m Uri
    -- ^ __Returns:__ A writable version of /@uri@/.
uriMakeWritable :: Uri -> m Uri
uriMakeWritable 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, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Uri
uri
    Ptr Uri
result <- Ptr Uri -> IO (Ptr Uri)
gst_uri_make_writable Ptr Uri
uri'
    Text -> Ptr Uri -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uriMakeWritable" 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 UriMakeWritableMethodInfo
instance (signature ~ (m Uri), MonadIO m) => O.MethodInfo UriMakeWritableMethodInfo Uri signature where
    overloadedMethod = uriMakeWritable

#endif

-- method Uri::new_with_base
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "base"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The base URI to join the new URI to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The scheme for the new URI."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "userinfo"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The user-info for the new URI."
--                 , 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 host name for the new URI."
--                 , 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 number for the new URI or %GST_URI_NO_PORT."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The path for the new URI with '/' separating path\n                     elements."
--                 , 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 string for the new URI with '&' separating\n                      query elements. Elements containing '&' characters\n                      should encode them as \"&percnt;26\"."
--                 , 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 name for the new URI."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Uri" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_new_with_base" gst_uri_new_with_base :: 
    Ptr Uri ->                              -- base : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- scheme : TBasicType TUTF8
    CString ->                              -- userinfo : TBasicType TUTF8
    CString ->                              -- host : TBasicType TUTF8
    Word32 ->                               -- port : TBasicType TUInt
    CString ->                              -- path : TBasicType TUTF8
    CString ->                              -- query : TBasicType TUTF8
    CString ->                              -- fragment : TBasicType TUTF8
    IO (Ptr Uri)

-- | Like 'GI.Gst.Structs.Uri.uriNew', but joins the new URI onto a base URI.
-- 
-- /Since: 1.6/
uriNewWithBase ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@base@/: The base URI to join the new URI to.
    -> Maybe (T.Text)
    -- ^ /@scheme@/: The scheme for the new URI.
    -> Maybe (T.Text)
    -- ^ /@userinfo@/: The user-info for the new URI.
    -> Maybe (T.Text)
    -- ^ /@host@/: The host name for the new URI.
    -> Word32
    -- ^ /@port@/: The port number for the new URI or 'GI.Gst.Constants.URI_NO_PORT'.
    -> Maybe (T.Text)
    -- ^ /@path@/: The path for the new URI with \'\/\' separating path
    --                      elements.
    -> Maybe (T.Text)
    -- ^ /@query@/: The query string for the new URI with \'&\' separating
    --                       query elements. Elements containing \'&\' characters
    --                       should encode them as \"&percnt;26\".
    -> Maybe (T.Text)
    -- ^ /@fragment@/: The fragment name for the new URI.
    -> m Uri
    -- ^ __Returns:__ The new URI joined onto /@base@/.
uriNewWithBase :: Uri
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Word32
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> m Uri
uriNewWithBase Uri
base Maybe Text
scheme Maybe Text
userinfo Maybe Text
host Word32
port Maybe Text
path Maybe Text
query Maybe Text
fragment = 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
    Ptr CChar
maybeScheme <- case Maybe Text
scheme of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jScheme -> do
            Ptr CChar
jScheme' <- Text -> IO (Ptr CChar)
textToCString Text
jScheme
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jScheme'
    Ptr CChar
maybeUserinfo <- case Maybe Text
userinfo of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jUserinfo -> do
            Ptr CChar
jUserinfo' <- Text -> IO (Ptr CChar)
textToCString Text
jUserinfo
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jUserinfo'
    Ptr CChar
maybeHost <- case Maybe Text
host of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jHost -> do
            Ptr CChar
jHost' <- Text -> IO (Ptr CChar)
textToCString Text
jHost
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jHost'
    Ptr CChar
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            Ptr CChar
jPath' <- Text -> IO (Ptr CChar)
textToCString Text
jPath
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPath'
    Ptr CChar
maybeQuery <- case Maybe Text
query of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jQuery -> do
            Ptr CChar
jQuery' <- Text -> IO (Ptr CChar)
textToCString Text
jQuery
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jQuery'
    Ptr CChar
maybeFragment <- case Maybe Text
fragment of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jFragment -> do
            Ptr CChar
jFragment' <- Text -> IO (Ptr CChar)
textToCString Text
jFragment
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jFragment'
    Ptr Uri
result <- Ptr Uri
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Word32
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> IO (Ptr Uri)
gst_uri_new_with_base Ptr Uri
base' Ptr CChar
maybeScheme Ptr CChar
maybeUserinfo Ptr CChar
maybeHost Word32
port Ptr CChar
maybePath Ptr CChar
maybeQuery Ptr CChar
maybeFragment
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeScheme
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeUserinfo
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeHost
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePath
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeQuery
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeFragment
    Uri -> IO Uri
forall (m :: * -> *) a. Monad m => a -> m a
return Uri
result'

#if defined(ENABLE_OVERLOADING)
data UriNewWithBaseMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Word32 -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> m Uri), MonadIO m) => O.MethodInfo UriNewWithBaseMethodInfo Uri signature where
    overloadedMethod = uriNewWithBase

#endif

-- method Uri::normalize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to normalize."
--                 , 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 "gst_uri_normalize" gst_uri_normalize :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CInt

-- | Normalization will remove extra path segments (\".\" and \"..\") from the URI. It
-- will also convert the scheme and host name to lower case and any
-- percent-encoded values to uppercase.
-- 
-- The t'GI.Gst.Structs.Uri.Uri' object must be writable. Check with 'GI.Gst.Structs.Uri.uriIsWritable' or use
-- 'GI.Gst.Structs.Uri.uriMakeWritable' first.
-- 
-- /Since: 1.6/
uriNormalize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to normalize.
    -> m Bool
    -- ^ __Returns:__ TRUE if the URI was modified.
uriNormalize :: Uri -> m Bool
uriNormalize 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
gst_uri_normalize 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 UriNormalizeMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo UriNormalizeMethodInfo Uri signature where
    overloadedMethod = uriNormalize

#endif

-- method Uri::query_has_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to examine."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query_key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key to lookup." , 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 "gst_uri_query_has_key" gst_uri_query_has_key :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- query_key : TBasicType TUTF8
    IO CInt

-- | Check if there is a query table entry for the /@queryKey@/ key.
-- 
-- /Since: 1.6/
uriQueryHasKey ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to examine.
    -> T.Text
    -- ^ /@queryKey@/: The key to lookup.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@queryKey@/ exists in the URI query table.
uriQueryHasKey :: Uri -> Text -> m Bool
uriQueryHasKey Uri
uri Text
queryKey = 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
    Ptr CChar
queryKey' <- Text -> IO (Ptr CChar)
textToCString Text
queryKey
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_query_has_key Ptr Uri
uri' Ptr CChar
queryKey'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
queryKey'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::remove_query_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query_key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key to remove." , 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 "gst_uri_remove_query_key" gst_uri_remove_query_key :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- query_key : TBasicType TUTF8
    IO CInt

-- | Remove an entry from the query table by key.
-- 
-- /Since: 1.6/
uriRemoveQueryKey ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@queryKey@/: The key to remove.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the key existed in the table and was removed.
uriRemoveQueryKey :: Uri -> Text -> m Bool
uriRemoveQueryKey Uri
uri Text
queryKey = 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
    Ptr CChar
queryKey' <- Text -> IO (Ptr CChar)
textToCString Text
queryKey
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_remove_query_key Ptr Uri
uri' Ptr CChar
queryKey'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
queryKey'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::set_fragment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , 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 string to set."
--                 , 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 "gst_uri_set_fragment" gst_uri_set_fragment :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- fragment : TBasicType TUTF8
    IO CInt

-- | Sets the fragment string in the URI. Use a value of 'P.Nothing' in /@fragment@/ to
-- unset the fragment string.
-- 
-- /Since: 1.6/
uriSetFragment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> Maybe (T.Text)
    -- ^ /@fragment@/: The fragment string to set.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the fragment was set\/unset successfully.
uriSetFragment :: Uri -> Maybe Text -> m Bool
uriSetFragment Uri
uri Maybe Text
fragment = 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
    Ptr CChar
maybeFragment <- case Maybe Text
fragment of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jFragment -> do
            Ptr CChar
jFragment' <- Text -> IO (Ptr CChar)
textToCString Text
jFragment
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jFragment'
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_set_fragment Ptr Uri
uri' Ptr CChar
maybeFragment
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeFragment
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data UriSetFragmentMethodInfo
instance (signature ~ (Maybe (T.Text) -> m Bool), 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 = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new host string to set or %NULL to unset."
--                 , 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 "gst_uri_set_host" gst_uri_set_host :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- host : TBasicType TUTF8
    IO CInt

-- | Set or unset the host for the URI.
-- 
-- /Since: 1.6/
uriSetHost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@host@/: The new host string to set or 'P.Nothing' to unset.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the host was set\/unset successfully.
uriSetHost :: Uri -> Text -> m Bool
uriSetHost Uri
uri Text
host = 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
    Ptr CChar
host' <- Text -> IO (Ptr CChar)
textToCString Text
host
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_set_host Ptr Uri
uri' Ptr CChar
host'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
host'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::set_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , 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 new path to set with path segments separated by '/', or use %NULL\n       to unset the path."
--                 , 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 "gst_uri_set_path" gst_uri_set_path :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- path : TBasicType TUTF8
    IO CInt

-- | Sets or unsets the path in the URI.
-- 
-- /Since: 1.6/
uriSetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@path@/: The new path to set with path segments separated by \'\/\', or use 'P.Nothing'
    --        to unset the path.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the path was set successfully.
uriSetPath :: Uri -> Text -> m Bool
uriSetPath Uri
uri Text
path = 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
    Ptr CChar
path' <- Text -> IO (Ptr CChar)
textToCString Text
path
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_set_path Ptr Uri
uri' Ptr CChar
path'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
path'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::set_path_segments
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path_segments"
--           , argType = TGList (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new\n                path list to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_set_path_segments" gst_uri_set_path_segments :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    Ptr (GList CString) ->                  -- path_segments : TGList (TBasicType TUTF8)
    IO CInt

-- | Replace the path segments list in the URI.
-- 
-- /Since: 1.6/
uriSetPathSegments ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> [T.Text]
    -- ^ /@pathSegments@/: The new
    --                 path list to set.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the path segments were set successfully.
uriSetPathSegments :: Uri -> [Text] -> m Bool
uriSetPathSegments Uri
uri [Text]
pathSegments = 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
    [Ptr CChar]
pathSegments' <- (Text -> IO (Ptr CChar)) -> [Text] -> IO [Ptr CChar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO (Ptr CChar)
textToCString [Text]
pathSegments
    Ptr (GList (Ptr CChar))
pathSegments'' <- [Ptr CChar] -> IO (Ptr (GList (Ptr CChar)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr CChar]
pathSegments'
    CInt
result <- Ptr Uri -> Ptr (GList (Ptr CChar)) -> IO CInt
gst_uri_set_path_segments Ptr Uri
uri' Ptr (GList (Ptr CChar))
pathSegments''
    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 UriSetPathSegmentsMethodInfo
instance (signature ~ ([T.Text] -> m Bool), MonadIO m) => O.MethodInfo UriSetPathSegmentsMethodInfo Uri signature where
    overloadedMethod = uriSetPathSegments

#endif

-- method Uri::set_path_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , 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 new percent encoded path to set with path segments separated by\n'/', or use %NULL to unset the path."
--                 , 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 "gst_uri_set_path_string" gst_uri_set_path_string :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- path : TBasicType TUTF8
    IO CInt

-- | Sets or unsets the path in the URI.
-- 
-- /Since: 1.6/
uriSetPathString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@path@/: The new percent encoded path to set with path segments separated by
    -- \'\/\', or use 'P.Nothing' to unset the path.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the path was set successfully.
uriSetPathString :: Uri -> Text -> m Bool
uriSetPathString Uri
uri Text
path = 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
    Ptr CChar
path' <- Text -> IO (Ptr CChar)
textToCString Text
path
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_set_path_string Ptr Uri
uri' Ptr CChar
path'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
path'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::set_port
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , 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 new port number to set or %GST_URI_NO_PORT to unset."
--                 , 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 "gst_uri_set_port" gst_uri_set_port :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    Word32 ->                               -- port : TBasicType TUInt
    IO CInt

-- | Set or unset the port number for the URI.
-- 
-- /Since: 1.6/
uriSetPort ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> Word32
    -- ^ /@port@/: The new port number to set or 'GI.Gst.Constants.URI_NO_PORT' to unset.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the port number was set\/unset successfully.
uriSetPort :: Uri -> Word32 -> m Bool
uriSetPort Uri
uri Word32
port = 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 -> Word32 -> IO CInt
gst_uri_set_port Ptr Uri
uri' Word32
port
    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 UriSetPortMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.MethodInfo UriSetPortMethodInfo Uri signature where
    overloadedMethod = uriSetPort

#endif

-- method Uri::set_query_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The new percent encoded query string to use to populate the query\n       table, or use %NULL to unset the query table."
--                 , 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 "gst_uri_set_query_string" gst_uri_set_query_string :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- query : TBasicType TUTF8
    IO CInt

-- | Sets or unsets the query table in the URI.
-- 
-- /Since: 1.6/
uriSetQueryString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@query@/: The new percent encoded query string to use to populate the query
    --        table, or use 'P.Nothing' to unset the query table.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the query table was set successfully.
uriSetQueryString :: Uri -> Text -> m Bool
uriSetQueryString Uri
uri Text
query = 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
    Ptr CChar
query' <- Text -> IO (Ptr CChar)
textToCString Text
query
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_set_query_string Ptr Uri
uri' Ptr CChar
query'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
query'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::set_query_table
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query_table"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new\n              query table to use."
--                 , 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 "gst_uri_set_query_table" gst_uri_set_query_table :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    Ptr (GHashTable CString CString) ->     -- query_table : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    IO CInt

-- | Set the query table to use in the URI. The old table is unreferenced and a
-- reference to the new one is used instead. A value if 'P.Nothing' for /@queryTable@/
-- will remove the query string from the URI.
-- 
-- /Since: 1.6/
uriSetQueryTable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> Maybe (Map.Map T.Text T.Text)
    -- ^ /@queryTable@/: The new
    --               query table to use.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the new table was successfully used for the query table.
uriSetQueryTable :: Uri -> Maybe (Map Text Text) -> m Bool
uriSetQueryTable Uri
uri Maybe (Map Text Text)
queryTable = 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
    Ptr (GHashTable (Ptr CChar) (Ptr CChar))
maybeQueryTable <- case Maybe (Map Text Text)
queryTable of
        Maybe (Map Text Text)
Nothing -> Ptr (GHashTable (Ptr CChar) (Ptr CChar))
-> IO (Ptr (GHashTable (Ptr CChar) (Ptr CChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable (Ptr CChar) (Ptr CChar))
forall a. Ptr a
nullPtr
        Just Map Text Text
jQueryTable -> do
            let jQueryTable' :: [(Text, Text)]
jQueryTable' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
jQueryTable
            [(Ptr CChar, Text)]
jQueryTable'' <- (Text -> IO (Ptr CChar))
-> [(Text, Text)] -> IO [(Ptr CChar, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO (Ptr CChar)
textToCString [(Text, Text)]
jQueryTable'
            [(Ptr CChar, Ptr CChar)]
jQueryTable''' <- (Text -> IO (Ptr CChar))
-> [(Ptr CChar, Text)] -> IO [(Ptr CChar, Ptr CChar)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO (Ptr CChar)
textToCString [(Ptr CChar, Text)]
jQueryTable''
            let jQueryTable'''' :: [(PtrWrapped (Ptr CChar), Ptr CChar)]
jQueryTable'''' = (Ptr CChar -> PtrWrapped (Ptr CChar))
-> [(Ptr CChar, Ptr CChar)]
-> [(PtrWrapped (Ptr CChar), Ptr CChar)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst Ptr CChar -> PtrWrapped (Ptr CChar)
cstringPackPtr [(Ptr CChar, Ptr CChar)]
jQueryTable'''
            let jQueryTable''''' :: [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
jQueryTable''''' = (Ptr CChar -> PtrWrapped (Ptr CChar))
-> [(PtrWrapped (Ptr CChar), Ptr CChar)]
-> [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond Ptr CChar -> PtrWrapped (Ptr CChar)
cstringPackPtr [(PtrWrapped (Ptr CChar), Ptr CChar)]
jQueryTable''''
            Ptr (GHashTable (Ptr CChar) (Ptr CChar))
jQueryTable'''''' <- GHashFunc (Ptr CChar)
-> GEqualFunc (Ptr CChar)
-> Maybe (GDestroyNotify (Ptr CChar))
-> Maybe (GDestroyNotify (Ptr CChar))
-> [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
-> IO (Ptr (GHashTable (Ptr CChar) (Ptr CChar)))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc (Ptr CChar)
gStrHash GEqualFunc (Ptr CChar)
gStrEqual (GDestroyNotify (Ptr CChar) -> Maybe (GDestroyNotify (Ptr CChar))
forall a. a -> Maybe a
Just GDestroyNotify (Ptr CChar)
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify (Ptr CChar) -> Maybe (GDestroyNotify (Ptr CChar))
forall a. a -> Maybe a
Just GDestroyNotify (Ptr CChar)
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped (Ptr CChar), PtrWrapped (Ptr CChar))]
jQueryTable'''''
            Ptr (GHashTable (Ptr CChar) (Ptr CChar))
-> IO (Ptr (GHashTable (Ptr CChar) (Ptr CChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable (Ptr CChar) (Ptr CChar))
jQueryTable''''''
    CInt
result <- Ptr Uri -> Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO CInt
gst_uri_set_query_table Ptr Uri
uri' Ptr (GHashTable (Ptr CChar) (Ptr CChar))
maybeQueryTable
    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
    Ptr (GHashTable (Ptr CChar) (Ptr CChar)) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr CChar) (Ptr CChar))
maybeQueryTable
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data UriSetQueryTableMethodInfo
instance (signature ~ (Maybe (Map.Map T.Text T.Text) -> m Bool), MonadIO m) => O.MethodInfo UriSetQueryTableMethodInfo Uri signature where
    overloadedMethod = uriSetQueryTable

#endif

-- method Uri::set_query_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query_key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the query entry."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query_value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value for the key."
--                 , 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 "gst_uri_set_query_value" gst_uri_set_query_value :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- query_key : TBasicType TUTF8
    CString ->                              -- query_value : TBasicType TUTF8
    IO CInt

-- | This inserts or replaces a key in the query table. A /@queryValue@/ of 'P.Nothing'
-- indicates that the key has no associated value, but will still be present in
-- the query string.
-- 
-- /Since: 1.6/
uriSetQueryValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@queryKey@/: The key for the query entry.
    -> Maybe (T.Text)
    -- ^ /@queryValue@/: The value for the key.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the query table was successfully updated.
uriSetQueryValue :: Uri -> Text -> Maybe Text -> m Bool
uriSetQueryValue Uri
uri Text
queryKey Maybe Text
queryValue = 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
    Ptr CChar
queryKey' <- Text -> IO (Ptr CChar)
textToCString Text
queryKey
    Ptr CChar
maybeQueryValue <- case Maybe Text
queryValue of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jQueryValue -> do
            Ptr CChar
jQueryValue' <- Text -> IO (Ptr CChar)
textToCString Text
jQueryValue
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jQueryValue'
    CInt
result <- Ptr Uri -> Ptr CChar -> Ptr CChar -> IO CInt
gst_uri_set_query_value Ptr Uri
uri' Ptr CChar
queryKey' Ptr CChar
maybeQueryValue
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
queryKey'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeQueryValue
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data UriSetQueryValueMethodInfo
instance (signature ~ (T.Text -> Maybe (T.Text) -> m Bool), MonadIO m) => O.MethodInfo UriSetQueryValueMethodInfo Uri signature where
    overloadedMethod = uriSetQueryValue

#endif

-- method Uri::set_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , 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 new scheme to set or %NULL to unset the scheme."
--                 , 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 "gst_uri_set_scheme" gst_uri_set_scheme :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO CInt

-- | Set or unset the scheme for the URI.
-- 
-- /Since: 1.6/
uriSetScheme ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@scheme@/: The new scheme to set or 'P.Nothing' to unset the scheme.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the scheme was set\/unset successfully.
uriSetScheme :: Uri -> Text -> m Bool
uriSetScheme Uri
uri Text
scheme = 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
    Ptr CChar
scheme' <- Text -> IO (Ptr CChar)
textToCString Text
scheme
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_set_scheme Ptr Uri
uri' Ptr CChar
scheme'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
scheme'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::set_userinfo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstUri to modify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "userinfo"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The new user-information string to set or %NULL to unset."
--                 , 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 "gst_uri_set_userinfo" gst_uri_set_userinfo :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    CString ->                              -- userinfo : TBasicType TUTF8
    IO CInt

-- | Set or unset the user information for the URI.
-- 
-- /Since: 1.6/
uriSetUserinfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: The t'GI.Gst.Structs.Uri.Uri' to modify.
    -> T.Text
    -- ^ /@userinfo@/: The new user-information string to set or 'P.Nothing' to unset.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the user information was set\/unset successfully.
uriSetUserinfo :: Uri -> Text -> m Bool
uriSetUserinfo Uri
uri Text
userinfo = 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
    Ptr CChar
userinfo' <- Text -> IO (Ptr CChar)
textToCString Text
userinfo
    CInt
result <- Ptr Uri -> Ptr CChar -> IO CInt
gst_uri_set_userinfo Ptr Uri
uri' Ptr CChar
userinfo'
    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
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
userinfo'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

-- method Uri::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Gst" , name = "Uri" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "This #GstUri to convert to a string."
--                 , 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 "gst_uri_to_string" gst_uri_to_string :: 
    Ptr Uri ->                              -- uri : TInterface (Name {namespace = "Gst", name = "Uri"})
    IO CString

-- | Convert the URI to a string.
-- 
-- Returns the URI as held in this object as a @/gchar/@* nul-terminated string.
-- The caller should 'GI.GLib.Functions.free' the string once they are finished with it.
-- The string is put together as described in RFC 3986.
-- 
-- /Since: 1.6/
uriToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Uri
    -- ^ /@uri@/: This t'GI.Gst.Structs.Uri.Uri' to convert to a string.
    -> m T.Text
    -- ^ __Returns:__ The string version of the URI.
uriToString :: Uri -> m Text
uriToString 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
    Ptr CChar
result <- Ptr Uri -> IO (Ptr CChar)
gst_uri_to_string Ptr Uri
uri'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uriToString" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
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 ~ (m T.Text), MonadIO m) => O.MethodInfo UriToStringMethodInfo Uri signature where
    overloadedMethod = uriToString

#endif

-- method Uri::construct
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "protocol"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Protocol for URI" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "location"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Location for URI" , 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 "gst_uri_construct" gst_uri_construct :: 
    CString ->                              -- protocol : TBasicType TUTF8
    CString ->                              -- location : TBasicType TUTF8
    IO CString

{-# DEPRECATED uriConstruct ["Use GstURI instead."] #-}
-- | Constructs a URI for a given valid protocol and location.
-- 
-- Free-function: g_free
uriConstruct ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@protocol@/: Protocol for URI
    -> T.Text
    -- ^ /@location@/: Location for URI
    -> m T.Text
    -- ^ __Returns:__ a new string for this URI. Returns 'P.Nothing' if the
    --     given URI protocol is not valid, or the given location is 'P.Nothing'.
uriConstruct :: Text -> Text -> m Text
uriConstruct Text
protocol Text
location = 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 CChar
protocol' <- Text -> IO (Ptr CChar)
textToCString Text
protocol
    Ptr CChar
location' <- Text -> IO (Ptr CChar)
textToCString Text
location
    Ptr CChar
result <- Ptr CChar -> Ptr CChar -> IO (Ptr CChar)
gst_uri_construct Ptr CChar
protocol' Ptr CChar
location'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uriConstruct" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
protocol'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
location'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::from_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The URI string to parse."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Uri" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_uri_from_string" gst_uri_from_string :: 
    CString ->                              -- uri : TBasicType TUTF8
    IO (Ptr Uri)

-- | Parses a URI string into a new t'GI.Gst.Structs.Uri.Uri' object. Will return NULL if the URI
-- cannot be parsed.
-- 
-- /Since: 1.6/
uriFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: The URI string to parse.
    -> m (Maybe Uri)
    -- ^ __Returns:__ A new t'GI.Gst.Structs.Uri.Uri' object, or NULL.
uriFromString :: Text -> m (Maybe Uri)
uriFromString Text
uri = 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
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    Ptr Uri
result <- Ptr CChar -> IO (Ptr Uri)
gst_uri_from_string Ptr CChar
uri'
    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''
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
    Maybe Uri -> IO (Maybe Uri)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Uri
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::get_location
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A URI string" , 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 "gst_uri_get_location" gst_uri_get_location :: 
    CString ->                              -- uri : TBasicType TUTF8
    IO CString

-- | Extracts the location out of a given valid URI, ie. the protocol and \":\/\/\"
-- are stripped from the URI, which means that the location returned includes
-- the hostname if one is specified. The returned string must be freed using
-- 'GI.GLib.Functions.free'.
-- 
-- Free-function: g_free
uriGetLocation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: A URI string
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the location for this URI. Returns
    --     'P.Nothing' if the URI isn\'t valid. If the URI does not contain a location, an
    --     empty string is returned.
uriGetLocation :: Text -> m (Maybe Text)
uriGetLocation Text
uri = 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
$ do
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    Ptr CChar
result <- Ptr CChar -> IO (Ptr CChar)
gst_uri_get_location Ptr CChar
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::get_protocol
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A URI string" , 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 "gst_uri_get_protocol" gst_uri_get_protocol :: 
    CString ->                              -- uri : TBasicType TUTF8
    IO CString

-- | Extracts the protocol out of a given valid URI. The returned string must be
-- freed using 'GI.GLib.Functions.free'.
uriGetProtocol ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: A URI string
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The protocol for this URI.
uriGetProtocol :: Text -> m (Maybe Text)
uriGetProtocol Text
uri = 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
$ do
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    Ptr CChar
result <- Ptr CChar -> IO (Ptr CChar)
gst_uri_get_protocol Ptr CChar
uri'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::has_protocol
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI string" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a protocol string (e.g. \"http\")"
--                 , 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 "gst_uri_has_protocol" gst_uri_has_protocol :: 
    CString ->                              -- uri : TBasicType TUTF8
    CString ->                              -- protocol : TBasicType TUTF8
    IO CInt

-- | Checks if the protocol of a given valid URI matches /@protocol@/.
uriHasProtocol ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: a URI string
    -> T.Text
    -- ^ /@protocol@/: a protocol string (e.g. \"http\")
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the protocol matches.
uriHasProtocol :: Text -> Text -> m Bool
uriHasProtocol Text
uri Text
protocol = 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 CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    Ptr CChar
protocol' <- Text -> IO (Ptr CChar)
textToCString Text
protocol
    CInt
result <- Ptr CChar -> Ptr CChar -> IO CInt
gst_uri_has_protocol Ptr CChar
uri' Ptr CChar
protocol'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
protocol'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::is_valid
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A URI string" , 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 "gst_uri_is_valid" gst_uri_is_valid :: 
    CString ->                              -- uri : TBasicType TUTF8
    IO CInt

-- | Tests if the given string is a valid URI identifier. URIs start with a valid
-- scheme followed by \":\" and maybe a string identifying the location.
uriIsValid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: A URI string
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the string is a valid URI
uriIsValid :: Text -> m Bool
uriIsValid Text
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 CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    CInt
result <- Ptr CChar -> IO CInt
gst_uri_is_valid Ptr CChar
uri'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::join_strings
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "base_uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The percent-encoded base URI."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref_uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The percent-encoded reference URI to join to the @base_uri."
--                 , 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 "gst_uri_join_strings" gst_uri_join_strings :: 
    CString ->                              -- base_uri : TBasicType TUTF8
    CString ->                              -- ref_uri : TBasicType TUTF8
    IO CString

-- | This is a convenience function to join two URI strings and return the result.
-- The returned string should be 'GI.GLib.Functions.free'\'d after use.
-- 
-- /Since: 1.6/
uriJoinStrings ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@baseUri@/: The percent-encoded base URI.
    -> T.Text
    -- ^ /@refUri@/: The percent-encoded reference URI to join to the /@baseUri@/.
    -> m T.Text
    -- ^ __Returns:__ A string representing the percent-encoded join of
    --          the two URIs.
uriJoinStrings :: Text -> Text -> m Text
uriJoinStrings Text
baseUri Text
refUri = 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 CChar
baseUri' <- Text -> IO (Ptr CChar)
textToCString Text
baseUri
    Ptr CChar
refUri' <- Text -> IO (Ptr CChar)
textToCString Text
refUri
    Ptr CChar
result <- Ptr CChar -> Ptr CChar -> IO (Ptr CChar)
gst_uri_join_strings Ptr CChar
baseUri' Ptr CChar
refUri'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"uriJoinStrings" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
baseUri'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
refUri'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::protocol_is_supported
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "URIType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether to check for a source or a sink"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Protocol that should be checked for (e.g. \"http\" or \"smb\")"
--                 , 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 "gst_uri_protocol_is_supported" gst_uri_protocol_is_supported :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "URIType"})
    CString ->                              -- protocol : TBasicType TUTF8
    IO CInt

-- | Checks if an element exists that supports the given URI protocol. Note
-- that a positive return value does not imply that a subsequent call to
-- 'GI.Gst.Objects.Element.elementMakeFromUri' is guaranteed to work.
uriProtocolIsSupported ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.URIType
    -- ^ /@type@/: Whether to check for a source or a sink
    -> T.Text
    -- ^ /@protocol@/: Protocol that should be checked for (e.g. \"http\" or \"smb\")
    -> m Bool
    -- ^ __Returns:__ 'P.True'
uriProtocolIsSupported :: URIType -> Text -> m Bool
uriProtocolIsSupported URIType
type_ Text
protocol = 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
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (URIType -> Int) -> URIType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIType -> Int
forall a. Enum a => a -> Int
fromEnum) URIType
type_
    Ptr CChar
protocol' <- Text -> IO (Ptr CChar)
textToCString Text
protocol
    CInt
result <- CUInt -> Ptr CChar -> IO CInt
gst_uri_protocol_is_supported CUInt
type_' Ptr CChar
protocol'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
protocol'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Uri::protocol_is_valid
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "protocol"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A string" , 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 "gst_uri_protocol_is_valid" gst_uri_protocol_is_valid :: 
    CString ->                              -- protocol : TBasicType TUTF8
    IO CInt

-- | Tests if the given string is a valid protocol identifier. Protocols
-- must consist of alphanumeric characters, \'+\', \'-\' and \'.\' and must
-- start with a alphabetic character. See RFC 3986 Section 3.1.
uriProtocolIsValid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@protocol@/: A string
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the string is a valid protocol identifier, 'P.False' otherwise.
uriProtocolIsValid :: Text -> m Bool
uriProtocolIsValid Text
protocol = 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 CChar
protocol' <- Text -> IO (Ptr CChar)
textToCString Text
protocol
    CInt
result <- Ptr CChar -> IO CInt
gst_uri_protocol_is_valid Ptr CChar
protocol'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
protocol'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveUriMethod (t :: Symbol) (o :: *) :: * where
    ResolveUriMethod "appendPath" o = UriAppendPathMethodInfo
    ResolveUriMethod "appendPathSegment" o = UriAppendPathSegmentMethodInfo
    ResolveUriMethod "equal" o = UriEqualMethodInfo
    ResolveUriMethod "fromStringWithBase" o = UriFromStringWithBaseMethodInfo
    ResolveUriMethod "isNormalized" o = UriIsNormalizedMethodInfo
    ResolveUriMethod "isWritable" o = UriIsWritableMethodInfo
    ResolveUriMethod "join" o = UriJoinMethodInfo
    ResolveUriMethod "makeWritable" o = UriMakeWritableMethodInfo
    ResolveUriMethod "newWithBase" o = UriNewWithBaseMethodInfo
    ResolveUriMethod "normalize" o = UriNormalizeMethodInfo
    ResolveUriMethod "queryHasKey" o = UriQueryHasKeyMethodInfo
    ResolveUriMethod "removeQueryKey" o = UriRemoveQueryKeyMethodInfo
    ResolveUriMethod "toString" o = UriToStringMethodInfo
    ResolveUriMethod "getFragment" o = UriGetFragmentMethodInfo
    ResolveUriMethod "getHost" o = UriGetHostMethodInfo
    ResolveUriMethod "getMediaFragmentTable" o = UriGetMediaFragmentTableMethodInfo
    ResolveUriMethod "getPath" o = UriGetPathMethodInfo
    ResolveUriMethod "getPathSegments" o = UriGetPathSegmentsMethodInfo
    ResolveUriMethod "getPathString" o = UriGetPathStringMethodInfo
    ResolveUriMethod "getPort" o = UriGetPortMethodInfo
    ResolveUriMethod "getQueryKeys" o = UriGetQueryKeysMethodInfo
    ResolveUriMethod "getQueryString" o = UriGetQueryStringMethodInfo
    ResolveUriMethod "getQueryTable" o = UriGetQueryTableMethodInfo
    ResolveUriMethod "getQueryValue" o = UriGetQueryValueMethodInfo
    ResolveUriMethod "getScheme" o = UriGetSchemeMethodInfo
    ResolveUriMethod "getUserinfo" o = UriGetUserinfoMethodInfo
    ResolveUriMethod "setFragment" o = UriSetFragmentMethodInfo
    ResolveUriMethod "setHost" o = UriSetHostMethodInfo
    ResolveUriMethod "setPath" o = UriSetPathMethodInfo
    ResolveUriMethod "setPathSegments" o = UriSetPathSegmentsMethodInfo
    ResolveUriMethod "setPathString" o = UriSetPathStringMethodInfo
    ResolveUriMethod "setPort" o = UriSetPortMethodInfo
    ResolveUriMethod "setQueryString" o = UriSetQueryStringMethodInfo
    ResolveUriMethod "setQueryTable" o = UriSetQueryTableMethodInfo
    ResolveUriMethod "setQueryValue" o = UriSetQueryValueMethodInfo
    ResolveUriMethod "setScheme" o = UriSetSchemeMethodInfo
    ResolveUriMethod "setUserinfo" o = UriSetUserinfoMethodInfo
    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