{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Queries can be performed on pads ('GI.Gst.Objects.Pad.padQuery') and elements
-- ('GI.Gst.Objects.Element.elementQuery'). Please note that some queries might need a running
-- pipeline to work.
-- 
-- Queries can be created using the gst_query_new_*() functions.
-- Query values can be set using gst_query_set_*(), and parsed using
-- gst_query_parse_*() helpers.
-- 
-- The following example shows how to query the duration of a pipeline:
-- 
-- === /C code/
-- >
-- >  GstQuery *query;
-- >  gboolean res;
-- >  query = gst_query_new_duration (GST_FORMAT_TIME);
-- >  res = gst_element_query (pipeline, query);
-- >  if (res) {
-- >    gint64 duration;
-- >    gst_query_parse_duration (query, NULL, &duration);
-- >    g_print ("duration = %"GST_TIME_FORMAT, GST_TIME_ARGS (duration));
-- >  } else {
-- >    g_print ("duration query failed...");
-- >  }
-- >  gst_query_unref (query);
-- 

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

module GI.Gst.Structs.Query
    ( 

-- * Exported types
    Query(..)                               ,
    newZeroQuery                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveQueryMethod                      ,
#endif


-- ** addAllocationMeta #method:addAllocationMeta#

#if defined(ENABLE_OVERLOADING)
    QueryAddAllocationMetaMethodInfo        ,
#endif
    queryAddAllocationMeta                  ,


-- ** addAllocationParam #method:addAllocationParam#

#if defined(ENABLE_OVERLOADING)
    QueryAddAllocationParamMethodInfo       ,
#endif
    queryAddAllocationParam                 ,


-- ** addAllocationPool #method:addAllocationPool#

#if defined(ENABLE_OVERLOADING)
    QueryAddAllocationPoolMethodInfo        ,
#endif
    queryAddAllocationPool                  ,


-- ** addBufferingRange #method:addBufferingRange#

#if defined(ENABLE_OVERLOADING)
    QueryAddBufferingRangeMethodInfo        ,
#endif
    queryAddBufferingRange                  ,


-- ** addSchedulingMode #method:addSchedulingMode#

#if defined(ENABLE_OVERLOADING)
    QueryAddSchedulingModeMethodInfo        ,
#endif
    queryAddSchedulingMode                  ,


-- ** findAllocationMeta #method:findAllocationMeta#

#if defined(ENABLE_OVERLOADING)
    QueryFindAllocationMetaMethodInfo       ,
#endif
    queryFindAllocationMeta                 ,


-- ** getNAllocationMetas #method:getNAllocationMetas#

#if defined(ENABLE_OVERLOADING)
    QueryGetNAllocationMetasMethodInfo      ,
#endif
    queryGetNAllocationMetas                ,


-- ** getNAllocationParams #method:getNAllocationParams#

#if defined(ENABLE_OVERLOADING)
    QueryGetNAllocationParamsMethodInfo     ,
#endif
    queryGetNAllocationParams               ,


-- ** getNAllocationPools #method:getNAllocationPools#

#if defined(ENABLE_OVERLOADING)
    QueryGetNAllocationPoolsMethodInfo      ,
#endif
    queryGetNAllocationPools                ,


-- ** getNBufferingRanges #method:getNBufferingRanges#

#if defined(ENABLE_OVERLOADING)
    QueryGetNBufferingRangesMethodInfo      ,
#endif
    queryGetNBufferingRanges                ,


-- ** getNSchedulingModes #method:getNSchedulingModes#

#if defined(ENABLE_OVERLOADING)
    QueryGetNSchedulingModesMethodInfo      ,
#endif
    queryGetNSchedulingModes                ,


-- ** getStructure #method:getStructure#

#if defined(ENABLE_OVERLOADING)
    QueryGetStructureMethodInfo             ,
#endif
    queryGetStructure                       ,


-- ** hasSchedulingMode #method:hasSchedulingMode#

#if defined(ENABLE_OVERLOADING)
    QueryHasSchedulingModeMethodInfo        ,
#endif
    queryHasSchedulingMode                  ,


-- ** hasSchedulingModeWithFlags #method:hasSchedulingModeWithFlags#

#if defined(ENABLE_OVERLOADING)
    QueryHasSchedulingModeWithFlagsMethodInfo,
#endif
    queryHasSchedulingModeWithFlags         ,


-- ** newAcceptCaps #method:newAcceptCaps#

    queryNewAcceptCaps                      ,


-- ** newAllocation #method:newAllocation#

    queryNewAllocation                      ,


-- ** newBitrate #method:newBitrate#

    queryNewBitrate                         ,


-- ** newBuffering #method:newBuffering#

    queryNewBuffering                       ,


-- ** newCaps #method:newCaps#

    queryNewCaps                            ,


-- ** newContext #method:newContext#

    queryNewContext                         ,


-- ** newConvert #method:newConvert#

    queryNewConvert                         ,


-- ** newCustom #method:newCustom#

    queryNewCustom                          ,


-- ** newDrain #method:newDrain#

    queryNewDrain                           ,


-- ** newDuration #method:newDuration#

    queryNewDuration                        ,


-- ** newFormats #method:newFormats#

    queryNewFormats                         ,


-- ** newLatency #method:newLatency#

    queryNewLatency                         ,


-- ** newPosition #method:newPosition#

    queryNewPosition                        ,


-- ** newScheduling #method:newScheduling#

    queryNewScheduling                      ,


-- ** newSeeking #method:newSeeking#

    queryNewSeeking                         ,


-- ** newSegment #method:newSegment#

    queryNewSegment                         ,


-- ** newUri #method:newUri#

    queryNewUri                             ,


-- ** parseAcceptCaps #method:parseAcceptCaps#

#if defined(ENABLE_OVERLOADING)
    QueryParseAcceptCapsMethodInfo          ,
#endif
    queryParseAcceptCaps                    ,


-- ** parseAcceptCapsResult #method:parseAcceptCapsResult#

#if defined(ENABLE_OVERLOADING)
    QueryParseAcceptCapsResultMethodInfo    ,
#endif
    queryParseAcceptCapsResult              ,


-- ** parseAllocation #method:parseAllocation#

#if defined(ENABLE_OVERLOADING)
    QueryParseAllocationMethodInfo          ,
#endif
    queryParseAllocation                    ,


-- ** parseBitrate #method:parseBitrate#

#if defined(ENABLE_OVERLOADING)
    QueryParseBitrateMethodInfo             ,
#endif
    queryParseBitrate                       ,


-- ** parseBufferingPercent #method:parseBufferingPercent#

#if defined(ENABLE_OVERLOADING)
    QueryParseBufferingPercentMethodInfo    ,
#endif
    queryParseBufferingPercent              ,


-- ** parseBufferingRange #method:parseBufferingRange#

#if defined(ENABLE_OVERLOADING)
    QueryParseBufferingRangeMethodInfo      ,
#endif
    queryParseBufferingRange                ,


-- ** parseBufferingStats #method:parseBufferingStats#

#if defined(ENABLE_OVERLOADING)
    QueryParseBufferingStatsMethodInfo      ,
#endif
    queryParseBufferingStats                ,


-- ** parseCaps #method:parseCaps#

#if defined(ENABLE_OVERLOADING)
    QueryParseCapsMethodInfo                ,
#endif
    queryParseCaps                          ,


-- ** parseCapsResult #method:parseCapsResult#

#if defined(ENABLE_OVERLOADING)
    QueryParseCapsResultMethodInfo          ,
#endif
    queryParseCapsResult                    ,


-- ** parseContext #method:parseContext#

#if defined(ENABLE_OVERLOADING)
    QueryParseContextMethodInfo             ,
#endif
    queryParseContext                       ,


-- ** parseContextType #method:parseContextType#

#if defined(ENABLE_OVERLOADING)
    QueryParseContextTypeMethodInfo         ,
#endif
    queryParseContextType                   ,


-- ** parseConvert #method:parseConvert#

#if defined(ENABLE_OVERLOADING)
    QueryParseConvertMethodInfo             ,
#endif
    queryParseConvert                       ,


-- ** parseDuration #method:parseDuration#

#if defined(ENABLE_OVERLOADING)
    QueryParseDurationMethodInfo            ,
#endif
    queryParseDuration                      ,


-- ** parseLatency #method:parseLatency#

#if defined(ENABLE_OVERLOADING)
    QueryParseLatencyMethodInfo             ,
#endif
    queryParseLatency                       ,


-- ** parseNFormats #method:parseNFormats#

#if defined(ENABLE_OVERLOADING)
    QueryParseNFormatsMethodInfo            ,
#endif
    queryParseNFormats                      ,


-- ** parseNthAllocationMeta #method:parseNthAllocationMeta#

#if defined(ENABLE_OVERLOADING)
    QueryParseNthAllocationMetaMethodInfo   ,
#endif
    queryParseNthAllocationMeta             ,


-- ** parseNthAllocationParam #method:parseNthAllocationParam#

#if defined(ENABLE_OVERLOADING)
    QueryParseNthAllocationParamMethodInfo  ,
#endif
    queryParseNthAllocationParam            ,


-- ** parseNthAllocationPool #method:parseNthAllocationPool#

#if defined(ENABLE_OVERLOADING)
    QueryParseNthAllocationPoolMethodInfo   ,
#endif
    queryParseNthAllocationPool             ,


-- ** parseNthBufferingRange #method:parseNthBufferingRange#

#if defined(ENABLE_OVERLOADING)
    QueryParseNthBufferingRangeMethodInfo   ,
#endif
    queryParseNthBufferingRange             ,


-- ** parseNthFormat #method:parseNthFormat#

#if defined(ENABLE_OVERLOADING)
    QueryParseNthFormatMethodInfo           ,
#endif
    queryParseNthFormat                     ,


-- ** parseNthSchedulingMode #method:parseNthSchedulingMode#

#if defined(ENABLE_OVERLOADING)
    QueryParseNthSchedulingModeMethodInfo   ,
#endif
    queryParseNthSchedulingMode             ,


-- ** parsePosition #method:parsePosition#

#if defined(ENABLE_OVERLOADING)
    QueryParsePositionMethodInfo            ,
#endif
    queryParsePosition                      ,


-- ** parseScheduling #method:parseScheduling#

#if defined(ENABLE_OVERLOADING)
    QueryParseSchedulingMethodInfo          ,
#endif
    queryParseScheduling                    ,


-- ** parseSeeking #method:parseSeeking#

#if defined(ENABLE_OVERLOADING)
    QueryParseSeekingMethodInfo             ,
#endif
    queryParseSeeking                       ,


-- ** parseSegment #method:parseSegment#

#if defined(ENABLE_OVERLOADING)
    QueryParseSegmentMethodInfo             ,
#endif
    queryParseSegment                       ,


-- ** parseUri #method:parseUri#

#if defined(ENABLE_OVERLOADING)
    QueryParseUriMethodInfo                 ,
#endif
    queryParseUri                           ,


-- ** parseUriRedirection #method:parseUriRedirection#

#if defined(ENABLE_OVERLOADING)
    QueryParseUriRedirectionMethodInfo      ,
#endif
    queryParseUriRedirection                ,


-- ** parseUriRedirectionPermanent #method:parseUriRedirectionPermanent#

#if defined(ENABLE_OVERLOADING)
    QueryParseUriRedirectionPermanentMethodInfo,
#endif
    queryParseUriRedirectionPermanent       ,


-- ** removeNthAllocationMeta #method:removeNthAllocationMeta#

#if defined(ENABLE_OVERLOADING)
    QueryRemoveNthAllocationMetaMethodInfo  ,
#endif
    queryRemoveNthAllocationMeta            ,


-- ** removeNthAllocationParam #method:removeNthAllocationParam#

#if defined(ENABLE_OVERLOADING)
    QueryRemoveNthAllocationParamMethodInfo ,
#endif
    queryRemoveNthAllocationParam           ,


-- ** removeNthAllocationPool #method:removeNthAllocationPool#

#if defined(ENABLE_OVERLOADING)
    QueryRemoveNthAllocationPoolMethodInfo  ,
#endif
    queryRemoveNthAllocationPool            ,


-- ** setAcceptCapsResult #method:setAcceptCapsResult#

#if defined(ENABLE_OVERLOADING)
    QuerySetAcceptCapsResultMethodInfo      ,
#endif
    querySetAcceptCapsResult                ,


-- ** setBitrate #method:setBitrate#

#if defined(ENABLE_OVERLOADING)
    QuerySetBitrateMethodInfo               ,
#endif
    querySetBitrate                         ,


-- ** setBufferingPercent #method:setBufferingPercent#

#if defined(ENABLE_OVERLOADING)
    QuerySetBufferingPercentMethodInfo      ,
#endif
    querySetBufferingPercent                ,


-- ** setBufferingRange #method:setBufferingRange#

#if defined(ENABLE_OVERLOADING)
    QuerySetBufferingRangeMethodInfo        ,
#endif
    querySetBufferingRange                  ,


-- ** setBufferingStats #method:setBufferingStats#

#if defined(ENABLE_OVERLOADING)
    QuerySetBufferingStatsMethodInfo        ,
#endif
    querySetBufferingStats                  ,


-- ** setCapsResult #method:setCapsResult#

#if defined(ENABLE_OVERLOADING)
    QuerySetCapsResultMethodInfo            ,
#endif
    querySetCapsResult                      ,


-- ** setContext #method:setContext#

#if defined(ENABLE_OVERLOADING)
    QuerySetContextMethodInfo               ,
#endif
    querySetContext                         ,


-- ** setConvert #method:setConvert#

#if defined(ENABLE_OVERLOADING)
    QuerySetConvertMethodInfo               ,
#endif
    querySetConvert                         ,


-- ** setDuration #method:setDuration#

#if defined(ENABLE_OVERLOADING)
    QuerySetDurationMethodInfo              ,
#endif
    querySetDuration                        ,


-- ** setFormatsv #method:setFormatsv#

#if defined(ENABLE_OVERLOADING)
    QuerySetFormatsvMethodInfo              ,
#endif
    querySetFormatsv                        ,


-- ** setLatency #method:setLatency#

#if defined(ENABLE_OVERLOADING)
    QuerySetLatencyMethodInfo               ,
#endif
    querySetLatency                         ,


-- ** setNthAllocationParam #method:setNthAllocationParam#

#if defined(ENABLE_OVERLOADING)
    QuerySetNthAllocationParamMethodInfo    ,
#endif
    querySetNthAllocationParam              ,


-- ** setNthAllocationPool #method:setNthAllocationPool#

#if defined(ENABLE_OVERLOADING)
    QuerySetNthAllocationPoolMethodInfo     ,
#endif
    querySetNthAllocationPool               ,


-- ** setPosition #method:setPosition#

#if defined(ENABLE_OVERLOADING)
    QuerySetPositionMethodInfo              ,
#endif
    querySetPosition                        ,


-- ** setScheduling #method:setScheduling#

#if defined(ENABLE_OVERLOADING)
    QuerySetSchedulingMethodInfo            ,
#endif
    querySetScheduling                      ,


-- ** setSeeking #method:setSeeking#

#if defined(ENABLE_OVERLOADING)
    QuerySetSeekingMethodInfo               ,
#endif
    querySetSeeking                         ,


-- ** setSegment #method:setSegment#

#if defined(ENABLE_OVERLOADING)
    QuerySetSegmentMethodInfo               ,
#endif
    querySetSegment                         ,


-- ** setUri #method:setUri#

#if defined(ENABLE_OVERLOADING)
    QuerySetUriMethodInfo                   ,
#endif
    querySetUri                             ,


-- ** setUriRedirection #method:setUriRedirection#

#if defined(ENABLE_OVERLOADING)
    QuerySetUriRedirectionMethodInfo        ,
#endif
    querySetUriRedirection                  ,


-- ** setUriRedirectionPermanent #method:setUriRedirectionPermanent#

#if defined(ENABLE_OVERLOADING)
    QuerySetUriRedirectionPermanentMethodInfo,
#endif
    querySetUriRedirectionPermanent         ,


-- ** writableStructure #method:writableStructure#

#if defined(ENABLE_OVERLOADING)
    QueryWritableStructureMethodInfo        ,
#endif
    queryWritableStructure                  ,




 -- * Properties
-- ** miniObject #attr:miniObject#
-- | The parent t'GI.Gst.Structs.MiniObject.MiniObject' type

    getQueryMiniObject                      ,
#if defined(ENABLE_OVERLOADING)
    query_miniObject                        ,
#endif


-- ** type #attr:type#
-- | the t'GI.Gst.Enums.QueryType'

    getQueryType                            ,
#if defined(ENABLE_OVERLOADING)
    query_type                              ,
#endif
    setQueryType                            ,




    ) 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
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Objects.Allocator as Gst.Allocator
import {-# SOURCE #-} qualified GI.Gst.Objects.BufferPool as Gst.BufferPool
import {-# SOURCE #-} qualified GI.Gst.Structs.AllocationParams as Gst.AllocationParams
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.Context as Gst.Context
import {-# SOURCE #-} qualified GI.Gst.Structs.MiniObject as Gst.MiniObject
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

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

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

foreign import ccall "gst_query_get_type" c_gst_query_get_type :: 
    IO GType

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

instance B.Types.TypedObject Query where
    glibType :: IO GType
glibType = IO GType
c_gst_query_get_type

instance B.Types.GBoxed Query

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

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

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


-- | Get the value of the “@mini_object@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' query #miniObject
-- @
getQueryMiniObject :: MonadIO m => Query -> m Gst.MiniObject.MiniObject
getQueryMiniObject :: Query -> m MiniObject
getQueryMiniObject Query
s = IO MiniObject -> m MiniObject
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MiniObject -> m MiniObject) -> IO MiniObject -> m MiniObject
forall a b. (a -> b) -> a -> b
$ Query -> (Ptr Query -> IO MiniObject) -> IO MiniObject
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Query
s ((Ptr Query -> IO MiniObject) -> IO MiniObject)
-> (Ptr Query -> IO MiniObject) -> IO MiniObject
forall a b. (a -> b) -> a -> b
$ \Ptr Query
ptr -> do
    let val :: Ptr MiniObject
val = Ptr Query
ptr Ptr Query -> Int -> Ptr MiniObject
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Gst.MiniObject.MiniObject)
    MiniObject
val' <- ((ManagedPtr MiniObject -> MiniObject)
-> Ptr MiniObject -> IO MiniObject
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MiniObject -> MiniObject
Gst.MiniObject.MiniObject) Ptr MiniObject
val
    MiniObject -> IO MiniObject
forall (m :: * -> *) a. Monad m => a -> m a
return MiniObject
val'

#if defined(ENABLE_OVERLOADING)
data QueryMiniObjectFieldInfo
instance AttrInfo QueryMiniObjectFieldInfo where
    type AttrBaseTypeConstraint QueryMiniObjectFieldInfo = (~) Query
    type AttrAllowedOps QueryMiniObjectFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint QueryMiniObjectFieldInfo = (~) (Ptr Gst.MiniObject.MiniObject)
    type AttrTransferTypeConstraint QueryMiniObjectFieldInfo = (~)(Ptr Gst.MiniObject.MiniObject)
    type AttrTransferType QueryMiniObjectFieldInfo = (Ptr Gst.MiniObject.MiniObject)
    type AttrGetType QueryMiniObjectFieldInfo = Gst.MiniObject.MiniObject
    type AttrLabel QueryMiniObjectFieldInfo = "mini_object"
    type AttrOrigin QueryMiniObjectFieldInfo = Query
    attrGet = getQueryMiniObject
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

query_miniObject :: AttrLabelProxy "miniObject"
query_miniObject = AttrLabelProxy

#endif


-- | Get the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' query #type
-- @
getQueryType :: MonadIO m => Query -> m Gst.Enums.QueryType
getQueryType :: Query -> m QueryType
getQueryType Query
s = IO QueryType -> m QueryType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO QueryType -> m QueryType) -> IO QueryType -> m QueryType
forall a b. (a -> b) -> a -> b
$ Query -> (Ptr Query -> IO QueryType) -> IO QueryType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Query
s ((Ptr Query -> IO QueryType) -> IO QueryType)
-> (Ptr Query -> IO QueryType) -> IO QueryType
forall a b. (a -> b) -> a -> b
$ \Ptr Query
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Query
ptr Ptr Query -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) :: IO CUInt
    let val' :: QueryType
val' = (Int -> QueryType
forall a. Enum a => Int -> a
toEnum (Int -> QueryType) -> (CUInt -> Int) -> CUInt -> QueryType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    QueryType -> IO QueryType
forall (m :: * -> *) a. Monad m => a -> m a
return QueryType
val'

-- | Set the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' query [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setQueryType :: MonadIO m => Query -> Gst.Enums.QueryType -> m ()
setQueryType :: Query -> QueryType -> m ()
setQueryType Query
s QueryType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Query -> (Ptr Query -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Query
s ((Ptr Query -> IO ()) -> IO ()) -> (Ptr Query -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Query
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (QueryType -> Int) -> QueryType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryType -> Int
forall a. Enum a => a -> Int
fromEnum) QueryType
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Query
ptr Ptr Query -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data QueryTypeFieldInfo
instance AttrInfo QueryTypeFieldInfo where
    type AttrBaseTypeConstraint QueryTypeFieldInfo = (~) Query
    type AttrAllowedOps QueryTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint QueryTypeFieldInfo = (~) Gst.Enums.QueryType
    type AttrTransferTypeConstraint QueryTypeFieldInfo = (~)Gst.Enums.QueryType
    type AttrTransferType QueryTypeFieldInfo = Gst.Enums.QueryType
    type AttrGetType QueryTypeFieldInfo = Gst.Enums.QueryType
    type AttrLabel QueryTypeFieldInfo = "type"
    type AttrOrigin QueryTypeFieldInfo = Query
    attrGet = getQueryType
    attrSet = setQueryType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

query_type :: AttrLabelProxy "type"
query_type = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Query
type instance O.AttributeList Query = QueryAttributeList
type QueryAttributeList = ('[ '("miniObject", QueryMiniObjectFieldInfo), '("type", QueryTypeFieldInfo)] :: [(Symbol, *)])
#endif

-- method Query::new_accept_caps
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a fixed #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_accept_caps" gst_query_new_accept_caps :: 
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Query)

-- | Constructs a new query object for querying if /@caps@/ are accepted.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewAcceptCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Caps.Caps
    -- ^ /@caps@/: a fixed t'GI.Gst.Structs.Caps.Caps'
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewAcceptCaps :: Caps -> m Query
queryNewAcceptCaps Caps
caps = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Query
result <- Ptr Caps -> IO (Ptr Query)
gst_query_new_accept_caps Ptr Caps
caps'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewAcceptCaps" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_allocation
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the negotiated caps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "need_pool"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return a pool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_allocation" gst_query_new_allocation :: 
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    CInt ->                                 -- need_pool : TBasicType TBoolean
    IO (Ptr Query)

-- | Constructs a new query object for querying the allocation properties.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewAllocation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Caps.Caps
    -- ^ /@caps@/: the negotiated caps
    -> Bool
    -- ^ /@needPool@/: return a pool
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewAllocation :: Caps -> Bool -> m Query
queryNewAllocation Caps
caps Bool
needPool = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    let needPool' :: CInt
needPool' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
needPool
    Ptr Query
result <- Ptr Caps -> CInt -> IO (Ptr Query)
gst_query_new_allocation Ptr Caps
caps' CInt
needPool'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewAllocation" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_bitrate
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_bitrate" gst_query_new_bitrate :: 
    IO (Ptr Query)

-- | Constructs a new query object for querying the bitrate.
-- 
-- Free-function: @/gst_query_unref()/@
-- 
-- /Since: 1.16/
queryNewBitrate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewBitrate :: m Query
queryNewBitrate  = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
result <- IO (Ptr Query)
gst_query_new_bitrate
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewBitrate" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_buffering
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default #GstFormat for the new query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_buffering" gst_query_new_buffering :: 
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO (Ptr Query)

-- | Constructs a new query object for querying the buffering status of
-- a stream.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewBuffering ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    -- ^ /@format@/: the default t'GI.Gst.Enums.Format' for the new query
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewBuffering :: Format -> m Query
queryNewBuffering Format
format = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query
result <- CUInt -> IO (Ptr Query)
gst_query_new_buffering CUInt
format'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewBuffering" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_caps
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_caps" gst_query_new_caps :: 
    Ptr Gst.Caps.Caps ->                    -- filter : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Query)

-- | Constructs a new query object for querying the caps.
-- 
-- The CAPS query should return the allowable caps for a pad in the context
-- of the element\'s state, its link to other elements, and the devices or files
-- it has opened. These caps must be a subset of the pad template caps. In the
-- NULL state with no links, the CAPS query should ideally return the same caps
-- as the pad template. In rare circumstances, an object property can affect
-- the caps returned by the CAPS query, but this is discouraged.
-- 
-- For most filters, the caps returned by CAPS query is directly affected by the
-- allowed caps on other pads. For demuxers and decoders, the caps returned by
-- the srcpad\'s getcaps function is directly related to the stream data. Again,
-- the CAPS query should return the most specific caps it reasonably can, since this
-- helps with autoplugging.
-- 
-- The /@filter@/ is used to restrict the result caps, only the caps matching
-- /@filter@/ should be returned from the CAPS query. Specifying a filter might
-- greatly reduce the amount of processing an element needs to do.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Caps.Caps
    -- ^ /@filter@/: a filter
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewCaps :: Caps -> m Query
queryNewCaps Caps
filter = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
filter' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
filter
    Ptr Query
result <- Ptr Caps -> IO (Ptr Query)
gst_query_new_caps Ptr Caps
filter'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewCaps" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
filter
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_context
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Context type to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_context" gst_query_new_context :: 
    CString ->                              -- context_type : TBasicType TUTF8
    IO (Ptr Query)

-- | Constructs a new query object for querying the pipeline-local context.
-- 
-- Free-function: @/gst_query_unref()/@
-- 
-- /Since: 1.2/
queryNewContext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@contextType@/: Context type to query
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewContext :: Text -> m Query
queryNewContext Text
contextType = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    CString
contextType' <- Text -> IO CString
textToCString Text
contextType
    Ptr Query
result <- CString -> IO (Ptr Query)
gst_query_new_context CString
contextType'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewContext" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contextType'
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_convert
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source #GstFormat for the new query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to convert"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target #GstFormat"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_convert" gst_query_new_convert :: 
    CUInt ->                                -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- value : TBasicType TInt64
    CUInt ->                                -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO (Ptr Query)

-- | Constructs a new convert query object. Use @/gst_query_unref()/@
-- when done with it. A convert query is used to ask for a conversion between
-- one format and another.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewConvert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    -- ^ /@srcFormat@/: the source t'GI.Gst.Enums.Format' for the new query
    -> Int64
    -- ^ /@value@/: the value to convert
    -> Gst.Enums.Format
    -- ^ /@destFormat@/: the target t'GI.Gst.Enums.Format'
    -> m Query
    -- ^ __Returns:__ a t'GI.Gst.Structs.Query.Query'
queryNewConvert :: Format -> Int64 -> Format -> m Query
queryNewConvert Format
srcFormat Int64
value Format
destFormat = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    let srcFormat' :: CUInt
srcFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
srcFormat
    let destFormat' :: CUInt
destFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
destFormat
    Ptr Query
result <- CUInt -> Int64 -> CUInt -> IO (Ptr Query)
gst_query_new_convert CUInt
srcFormat' Int64
value CUInt
destFormat'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewConvert" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_custom
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "QueryType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the query type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a structure for the query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_custom" gst_query_new_custom :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "QueryType"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Query)

-- | Constructs a new custom query object. Use @/gst_query_unref()/@
-- when done with it.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewCustom ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.QueryType
    -- ^ /@type@/: the query type
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@structure@/: a structure for the query
    -> m (Maybe Query)
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewCustom :: QueryType -> Maybe Structure -> m (Maybe Query)
queryNewCustom QueryType
type_ Maybe Structure
structure = IO (Maybe Query) -> m (Maybe Query)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Query) -> m (Maybe Query))
-> IO (Maybe Query) -> m (Maybe Query)
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) -> (QueryType -> Int) -> QueryType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryType -> Int
forall a. Enum a => a -> Int
fromEnum) QueryType
type_
    Ptr Structure
maybeStructure <- case Maybe Structure
structure of
        Maybe Structure
Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just Structure
jStructure -> do
            Ptr Structure
jStructure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jStructure
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jStructure'
    Ptr Query
result <- CUInt -> Ptr Structure -> IO (Ptr Query)
gst_query_new_custom CUInt
type_' Ptr Structure
maybeStructure
    Maybe Query
maybeResult <- Ptr Query -> (Ptr Query -> IO Query) -> IO (Maybe Query)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Query
result ((Ptr Query -> IO Query) -> IO (Maybe Query))
-> (Ptr Query -> IO Query) -> IO (Maybe Query)
forall a b. (a -> b) -> a -> b
$ \Ptr Query
result' -> do
        Query
result'' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result'
        Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result''
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
structure Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Query -> IO (Maybe Query)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Query
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_drain
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_drain" gst_query_new_drain :: 
    IO (Ptr Query)

-- | Constructs a new query object for querying the drain state.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewDrain ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewDrain :: m Query
queryNewDrain  = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
result <- IO (Ptr Query)
gst_query_new_drain
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewDrain" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_duration
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat for this duration query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_duration" gst_query_new_duration :: 
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO (Ptr Query)

-- | Constructs a new stream duration query object to query in the given format.
-- Use @/gst_query_unref()/@ when done with it. A duration query will give the
-- total length of the stream.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewDuration ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' for this duration query
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewDuration :: Format -> m Query
queryNewDuration Format
format = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query
result <- CUInt -> IO (Ptr Query)
gst_query_new_duration CUInt
format'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewDuration" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_formats
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_formats" gst_query_new_formats :: 
    IO (Ptr Query)

-- | Constructs a new query object for querying formats of
-- the stream.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewFormats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewFormats :: m Query
queryNewFormats  = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
result <- IO (Ptr Query)
gst_query_new_formats
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewFormats" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_latency
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_latency" gst_query_new_latency :: 
    IO (Ptr Query)

-- | Constructs a new latency query object.
-- Use @/gst_query_unref()/@ when done with it. A latency query is usually performed
-- by sinks to compensate for additional latency introduced by elements in the
-- pipeline.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewLatency ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Query
    -- ^ __Returns:__ a t'GI.Gst.Structs.Query.Query'
queryNewLatency :: m Query
queryNewLatency  = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
result <- IO (Ptr Query)
gst_query_new_latency
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewLatency" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_position
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default #GstFormat for the new query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_position" gst_query_new_position :: 
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO (Ptr Query)

-- | Constructs a new query stream position query object. Use @/gst_query_unref()/@
-- when done with it. A position query is used to query the current position
-- of playback in the streams, in some format.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewPosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    -- ^ /@format@/: the default t'GI.Gst.Enums.Format' for the new query
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewPosition :: Format -> m Query
queryNewPosition Format
format = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query
result <- CUInt -> IO (Ptr Query)
gst_query_new_position CUInt
format'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewPosition" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_scheduling
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_scheduling" gst_query_new_scheduling :: 
    IO (Ptr Query)

-- | Constructs a new query object for querying the scheduling properties.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewScheduling ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewScheduling :: m Query
queryNewScheduling  = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
result <- IO (Ptr Query)
gst_query_new_scheduling
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewScheduling" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_seeking
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default #GstFormat for the new query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_seeking" gst_query_new_seeking :: 
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO (Ptr Query)

-- | Constructs a new query object for querying seeking properties of
-- the stream.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewSeeking ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    -- ^ /@format@/: the default t'GI.Gst.Enums.Format' for the new query
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewSeeking :: Format -> m Query
queryNewSeeking Format
format = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query
result <- CUInt -> IO (Ptr Query)
gst_query_new_seeking CUInt
format'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewSeeking" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_segment
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat for the new query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_segment" gst_query_new_segment :: 
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO (Ptr Query)

-- | Constructs a new segment query object. Use @/gst_query_unref()/@
-- when done with it. A segment query is used to discover information about the
-- currently configured segment for playback.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewSegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' for the new query
    -> m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewSegment :: Format -> m Query
queryNewSegment Format
format = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query
result <- CUInt -> IO (Ptr Query)
gst_query_new_segment CUInt
format'
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewSegment" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::new_uri
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_new_uri" gst_query_new_uri :: 
    IO (Ptr Query)

-- | Constructs a new query URI query object. Use @/gst_query_unref()/@
-- when done with it. An URI query is used to query the current URI
-- that is used by the source or sink.
-- 
-- Free-function: @/gst_query_unref()/@
queryNewUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Query
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Query.Query'
queryNewUri :: m Query
queryNewUri  = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
result <- IO (Ptr Query)
gst_query_new_uri
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryNewUri" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Query::add_allocation_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "api"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the metadata API" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "API specific parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_add_allocation_meta" gst_query_add_allocation_meta :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CGType ->                               -- api : TBasicType TGType
    Ptr Gst.Structure.Structure ->          -- params : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Add /@api@/ with /@params@/ as one of the supported metadata API to /@query@/.
queryAddAllocationMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> GType
    -- ^ /@api@/: the metadata API
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@params@/: API specific parameters
    -> m ()
queryAddAllocationMeta :: Query -> GType -> Maybe Structure -> m ()
queryAddAllocationMeta Query
query GType
api Maybe Structure
params = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let api' :: CGType
api' = GType -> CGType
gtypeToCGType GType
api
    Ptr Structure
maybeParams <- case Maybe Structure
params of
        Maybe Structure
Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just Structure
jParams -> do
            Ptr Structure
jParams' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
jParams
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jParams'
    Ptr Query -> CGType -> Ptr Structure -> IO ()
gst_query_add_allocation_meta Ptr Query
query' CGType
api' Ptr Structure
maybeParams
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
params Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QueryAddAllocationMetaMethodInfo
instance (signature ~ (GType -> Maybe (Gst.Structure.Structure) -> m ()), MonadIO m) => O.MethodInfo QueryAddAllocationMetaMethodInfo Query signature where
    overloadedMethod = queryAddAllocationMeta

#endif

-- method Query::add_allocation_param
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Allocator" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the memory allocator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "AllocationParams" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAllocationParams"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_add_allocation_param" gst_query_add_allocation_param :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr Gst.Allocator.Allocator ->          -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

-- | Add /@allocator@/ and its /@params@/ as a supported memory allocator.
queryAddAllocationParam ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Allocator.IsAllocator a) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> Maybe (a)
    -- ^ /@allocator@/: the memory allocator
    -> Maybe (Gst.AllocationParams.AllocationParams)
    -- ^ /@params@/: a t'GI.Gst.Structs.AllocationParams.AllocationParams'
    -> m ()
queryAddAllocationParam :: Query -> Maybe a -> Maybe AllocationParams -> m ()
queryAddAllocationParam Query
query Maybe a
allocator Maybe AllocationParams
params = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Allocator
maybeAllocator <- case Maybe a
allocator of
        Maybe a
Nothing -> Ptr Allocator -> IO (Ptr Allocator)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Allocator
forall a. Ptr a
nullPtr
        Just a
jAllocator -> do
            Ptr Allocator
jAllocator' <- a -> IO (Ptr Allocator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAllocator
            Ptr Allocator -> IO (Ptr Allocator)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Allocator
jAllocator'
    Ptr AllocationParams
maybeParams <- case Maybe AllocationParams
params of
        Maybe AllocationParams
Nothing -> Ptr AllocationParams -> IO (Ptr AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AllocationParams
forall a. Ptr a
nullPtr
        Just AllocationParams
jParams -> do
            Ptr AllocationParams
jParams' <- AllocationParams -> IO (Ptr AllocationParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AllocationParams
jParams
            Ptr AllocationParams -> IO (Ptr AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AllocationParams
jParams'
    Ptr Query -> Ptr Allocator -> Ptr AllocationParams -> IO ()
gst_query_add_allocation_param Ptr Query
query' Ptr Allocator
maybeAllocator Ptr AllocationParams
maybeParams
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
allocator a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe AllocationParams -> (AllocationParams -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe AllocationParams
params AllocationParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QueryAddAllocationParamMethodInfo
instance (signature ~ (Maybe (a) -> Maybe (Gst.AllocationParams.AllocationParams) -> m ()), MonadIO m, Gst.Allocator.IsAllocator a) => O.MethodInfo QueryAddAllocationParamMethodInfo Query signature where
    overloadedMethod = queryAddAllocationParam

#endif

-- method Query::add_allocation_pool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_ALLOCATION."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the min buffers" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the max buffers" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_add_allocation_pool" gst_query_add_allocation_pool :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr Gst.BufferPool.BufferPool ->        -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    Word32 ->                               -- size : TBasicType TUInt
    Word32 ->                               -- min_buffers : TBasicType TUInt
    Word32 ->                               -- max_buffers : TBasicType TUInt
    IO ()

-- | Set the pool parameters in /@query@/.
queryAddAllocationPool ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.BufferPool.IsBufferPool a) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_ALLOCATION.
    -> Maybe (a)
    -- ^ /@pool@/: the t'GI.Gst.Objects.BufferPool.BufferPool'
    -> Word32
    -- ^ /@size@/: the buffer size
    -> Word32
    -- ^ /@minBuffers@/: the min buffers
    -> Word32
    -- ^ /@maxBuffers@/: the max buffers
    -> m ()
queryAddAllocationPool :: Query -> Maybe a -> Word32 -> Word32 -> Word32 -> m ()
queryAddAllocationPool Query
query Maybe a
pool Word32
size Word32
minBuffers Word32
maxBuffers = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr BufferPool
maybePool <- case Maybe a
pool of
        Maybe a
Nothing -> Ptr BufferPool -> IO (Ptr BufferPool)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr BufferPool
forall a. Ptr a
nullPtr
        Just a
jPool -> do
            Ptr BufferPool
jPool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jPool
            Ptr BufferPool -> IO (Ptr BufferPool)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr BufferPool
jPool'
    Ptr Query -> Ptr BufferPool -> Word32 -> Word32 -> Word32 -> IO ()
gst_query_add_allocation_pool Ptr Query
query' Ptr BufferPool
maybePool Word32
size Word32
minBuffers Word32
maxBuffers
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
pool a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QueryAddAllocationPoolMethodInfo
instance (signature ~ (Maybe (a) -> Word32 -> Word32 -> Word32 -> m ()), MonadIO m, Gst.BufferPool.IsBufferPool a) => O.MethodInfo QueryAddAllocationPoolMethodInfo Query signature where
    overloadedMethod = queryAddAllocationPool

#endif

-- method Query::add_buffering_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_BUFFERING type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start position of the range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "stop position of the range"
--                 , 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_query_add_buffering_range" gst_query_add_buffering_range :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Int64 ->                                -- start : TBasicType TInt64
    Int64 ->                                -- stop : TBasicType TInt64
    IO CInt

-- | Set the buffering-ranges array field in /@query@/. The current last
-- start position of the array should be inferior to /@start@/.
queryAddBufferingRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_BUFFERING type query t'GI.Gst.Structs.Query.Query'
    -> Int64
    -- ^ /@start@/: start position of the range
    -> Int64
    -- ^ /@stop@/: stop position of the range
    -> m Bool
    -- ^ __Returns:__ a t'P.Bool' indicating if the range was added or not.
queryAddBufferingRange :: Query -> Int64 -> Int64 -> m Bool
queryAddBufferingRange Query
query Int64
start Int64
stop = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CInt
result <- Ptr Query -> Int64 -> Int64 -> IO CInt
gst_query_add_buffering_range Ptr Query
query' Int64
start Int64
stop
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data QueryAddBufferingRangeMethodInfo
instance (signature ~ (Int64 -> Int64 -> m Bool), MonadIO m) => O.MethodInfo QueryAddBufferingRangeMethodInfo Query signature where
    overloadedMethod = queryAddBufferingRange

#endif

-- method Query::add_scheduling_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_SCHEDULING type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPadMode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_add_scheduling_mode" gst_query_add_scheduling_mode :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "PadMode"})
    IO ()

-- | Add /@mode@/ as one of the supported scheduling modes to /@query@/.
queryAddSchedulingMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_SCHEDULING type query t'GI.Gst.Structs.Query.Query'
    -> Gst.Enums.PadMode
    -- ^ /@mode@/: a t'GI.Gst.Enums.PadMode'
    -> m ()
queryAddSchedulingMode :: Query -> PadMode -> m ()
queryAddSchedulingMode Query
query PadMode
mode = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PadMode -> Int) -> PadMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PadMode -> Int
forall a. Enum a => a -> Int
fromEnum) PadMode
mode
    Ptr Query -> CUInt -> IO ()
gst_query_add_scheduling_mode Ptr Query
query' CUInt
mode'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QueryAddSchedulingModeMethodInfo
instance (signature ~ (Gst.Enums.PadMode -> m ()), MonadIO m) => O.MethodInfo QueryAddSchedulingModeMethodInfo Query signature where
    overloadedMethod = queryAddSchedulingMode

#endif

-- method Query::find_allocation_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "api"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the metadata API" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index" , 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_query_find_allocation_meta" gst_query_find_allocation_meta :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CGType ->                               -- api : TBasicType TGType
    Ptr Word32 ->                           -- index : TBasicType TUInt
    IO CInt

-- | Check if /@query@/ has metadata /@api@/ set. When this function returns 'P.True',
-- /@index@/ will contain the index where the requested API and the parameters
-- can be found.
queryFindAllocationMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> GType
    -- ^ /@api@/: the metadata API
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' when /@api@/ is in the list of metadata.
queryFindAllocationMeta :: Query -> GType -> m (Bool, Word32)
queryFindAllocationMeta Query
query GType
api = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let api' :: CGType
api' = GType -> CGType
gtypeToCGType GType
api
    Ptr Word32
index <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Query -> CGType -> Ptr Word32 -> IO CInt
gst_query_find_allocation_meta Ptr Query
query' CGType
api' Ptr Word32
index
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
index' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
index
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
index
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
index')

#if defined(ENABLE_OVERLOADING)
data QueryFindAllocationMetaMethodInfo
instance (signature ~ (GType -> m ((Bool, Word32))), MonadIO m) => O.MethodInfo QueryFindAllocationMetaMethodInfo Query signature where
    overloadedMethod = queryFindAllocationMeta

#endif

-- method Query::get_n_allocation_metas
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , 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_query_get_n_allocation_metas" gst_query_get_n_allocation_metas :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO Word32

-- | Retrieve the number of values currently stored in the
-- meta API array of the query\'s structure.
queryGetNAllocationMetas ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> m Word32
    -- ^ __Returns:__ the metadata API array size as a @/guint/@.
queryGetNAllocationMetas :: Query -> m Word32
queryGetNAllocationMetas Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Word32
result <- Ptr Query -> IO Word32
gst_query_get_n_allocation_metas Ptr Query
query'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data QueryGetNAllocationMetasMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo QueryGetNAllocationMetasMethodInfo Query signature where
    overloadedMethod = queryGetNAllocationMetas

#endif

-- method Query::get_n_allocation_params
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , 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_query_get_n_allocation_params" gst_query_get_n_allocation_params :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO Word32

-- | Retrieve the number of values currently stored in the
-- allocator params array of the query\'s structure.
-- 
-- If no memory allocator is specified, the downstream element can handle
-- the default memory allocator. The first memory allocator in the query
-- should be generic and allow mapping to system memory, all following
-- allocators should be ordered by preference with the preferred one first.
queryGetNAllocationParams ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> m Word32
    -- ^ __Returns:__ the allocator array size as a @/guint/@.
queryGetNAllocationParams :: Query -> m Word32
queryGetNAllocationParams Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Word32
result <- Ptr Query -> IO Word32
gst_query_get_n_allocation_params Ptr Query
query'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data QueryGetNAllocationParamsMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo QueryGetNAllocationParamsMethodInfo Query signature where
    overloadedMethod = queryGetNAllocationParams

#endif

-- method Query::get_n_allocation_pools
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , 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_query_get_n_allocation_pools" gst_query_get_n_allocation_pools :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO Word32

-- | Retrieve the number of values currently stored in the
-- pool array of the query\'s structure.
queryGetNAllocationPools ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> m Word32
    -- ^ __Returns:__ the pool array size as a @/guint/@.
queryGetNAllocationPools :: Query -> m Word32
queryGetNAllocationPools Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Word32
result <- Ptr Query -> IO Word32
gst_query_get_n_allocation_pools Ptr Query
query'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data QueryGetNAllocationPoolsMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo QueryGetNAllocationPoolsMethodInfo Query signature where
    overloadedMethod = queryGetNAllocationPools

#endif

-- method Query::get_n_buffering_ranges
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_BUFFERING type query #GstQuery"
--                 , 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_query_get_n_buffering_ranges" gst_query_get_n_buffering_ranges :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO Word32

-- | Retrieve the number of values currently stored in the
-- buffered-ranges array of the query\'s structure.
queryGetNBufferingRanges ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_BUFFERING type query t'GI.Gst.Structs.Query.Query'
    -> m Word32
    -- ^ __Returns:__ the range array size as a @/guint/@.
queryGetNBufferingRanges :: Query -> m Word32
queryGetNBufferingRanges Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Word32
result <- Ptr Query -> IO Word32
gst_query_get_n_buffering_ranges Ptr Query
query'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data QueryGetNBufferingRangesMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo QueryGetNBufferingRangesMethodInfo Query signature where
    overloadedMethod = queryGetNBufferingRanges

#endif

-- method Query::get_n_scheduling_modes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_SCHEDULING type query #GstQuery"
--                 , 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_query_get_n_scheduling_modes" gst_query_get_n_scheduling_modes :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO Word32

-- | Retrieve the number of values currently stored in the
-- scheduling mode array of the query\'s structure.
queryGetNSchedulingModes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_SCHEDULING type query t'GI.Gst.Structs.Query.Query'
    -> m Word32
    -- ^ __Returns:__ the scheduling mode array size as a @/guint/@.
queryGetNSchedulingModes :: Query -> m Word32
queryGetNSchedulingModes Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Word32
result <- Ptr Query -> IO Word32
gst_query_get_n_scheduling_modes Ptr Query
query'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data QueryGetNSchedulingModesMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo QueryGetNSchedulingModesMethodInfo Query signature where
    overloadedMethod = queryGetNSchedulingModes

#endif

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

foreign import ccall "gst_query_get_structure" gst_query_get_structure :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO (Ptr Gst.Structure.Structure)

-- | Get the structure of a query.
queryGetStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m (Maybe Gst.Structure.Structure)
    -- ^ __Returns:__ the t'GI.Gst.Structs.Structure.Structure' of the query. The
    --     structure is still owned by the query and will therefore be freed when the
    --     query is unreffed.
queryGetStructure :: Query -> m (Maybe Structure)
queryGetStructure Query
query = IO (Maybe Structure) -> m (Maybe Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Structure
result <- Ptr Query -> IO (Ptr Structure)
gst_query_get_structure Ptr Query
query'
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result'
        Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

#if defined(ENABLE_OVERLOADING)
data QueryGetStructureMethodInfo
instance (signature ~ (m (Maybe Gst.Structure.Structure)), MonadIO m) => O.MethodInfo QueryGetStructureMethodInfo Query signature where
    overloadedMethod = queryGetStructure

#endif

-- method Query::has_scheduling_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_SCHEDULING type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the scheduling mode"
--                 , 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_query_has_scheduling_mode" gst_query_has_scheduling_mode :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "PadMode"})
    IO CInt

-- | Check if /@query@/ has scheduling mode set.
-- 
-- > When checking if upstream supports pull mode, it is usually not
-- > enough to just check for GST_PAD_MODE_PULL with this function, you
-- > also want to check whether the scheduling flags returned by
-- > 'GI.Gst.Structs.Query.queryParseScheduling' have the seeking flag set (meaning
-- > random access is supported, not only sequential pulls).
queryHasSchedulingMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_SCHEDULING type query t'GI.Gst.Structs.Query.Query'
    -> Gst.Enums.PadMode
    -- ^ /@mode@/: the scheduling mode
    -> m Bool
    -- ^ __Returns:__ 'P.True' when /@mode@/ is in the list of scheduling modes.
queryHasSchedulingMode :: Query -> PadMode -> m Bool
queryHasSchedulingMode Query
query PadMode
mode = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PadMode -> Int) -> PadMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PadMode -> Int
forall a. Enum a => a -> Int
fromEnum) PadMode
mode
    CInt
result <- Ptr Query -> CUInt -> IO CInt
gst_query_has_scheduling_mode Ptr Query
query' CUInt
mode'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data QueryHasSchedulingModeMethodInfo
instance (signature ~ (Gst.Enums.PadMode -> m Bool), MonadIO m) => O.MethodInfo QueryHasSchedulingModeMethodInfo Query signature where
    overloadedMethod = queryHasSchedulingMode

#endif

-- method Query::has_scheduling_mode_with_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_SCHEDULING type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the scheduling mode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SchedulingFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstSchedulingFlags"
--                 , 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_query_has_scheduling_mode_with_flags" gst_query_has_scheduling_mode_with_flags :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "PadMode"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "SchedulingFlags"})
    IO CInt

-- | Check if /@query@/ has scheduling mode set and /@flags@/ is set in
-- query scheduling flags.
queryHasSchedulingModeWithFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_SCHEDULING type query t'GI.Gst.Structs.Query.Query'
    -> Gst.Enums.PadMode
    -- ^ /@mode@/: the scheduling mode
    -> [Gst.Flags.SchedulingFlags]
    -- ^ /@flags@/: t'GI.Gst.Flags.SchedulingFlags'
    -> m Bool
    -- ^ __Returns:__ 'P.True' when /@mode@/ is in the list of scheduling modes
    --    and /@flags@/ are compatible with query flags.
queryHasSchedulingModeWithFlags :: Query -> PadMode -> [SchedulingFlags] -> m Bool
queryHasSchedulingModeWithFlags Query
query PadMode
mode [SchedulingFlags]
flags = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PadMode -> Int) -> PadMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PadMode -> Int
forall a. Enum a => a -> Int
fromEnum) PadMode
mode
    let flags' :: CUInt
flags' = [SchedulingFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SchedulingFlags]
flags
    CInt
result <- Ptr Query -> CUInt -> CUInt -> IO CInt
gst_query_has_scheduling_mode_with_flags Ptr Query
query' CUInt
mode' CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data QueryHasSchedulingModeWithFlagsMethodInfo
instance (signature ~ (Gst.Enums.PadMode -> [Gst.Flags.SchedulingFlags] -> m Bool), MonadIO m) => O.MethodInfo QueryHasSchedulingModeWithFlagsMethodInfo Query signature where
    overloadedMethod = queryHasSchedulingModeWithFlags

#endif

-- method Query::parse_accept_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The query to parse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to the caps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_accept_caps" gst_query_parse_accept_caps :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr (Ptr Gst.Caps.Caps) ->              -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Get the caps from /@query@/. The caps remains valid as long as /@query@/ remains
-- valid.
queryParseAcceptCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: The query to parse
    -> m (Gst.Caps.Caps)
queryParseAcceptCaps :: Query -> m Caps
queryParseAcceptCaps Query
query = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr (Ptr Caps)
caps <- IO (Ptr (Ptr Caps))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Caps.Caps))
    Ptr Query -> Ptr (Ptr Caps) -> IO ()
gst_query_parse_accept_caps Ptr Query
query' Ptr (Ptr Caps)
caps
    Ptr Caps
caps' <- Ptr (Ptr Caps) -> IO (Ptr Caps)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Caps)
caps
    Caps
caps'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
caps'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr (Ptr Caps) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Caps)
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
caps''

#if defined(ENABLE_OVERLOADING)
data QueryParseAcceptCapsMethodInfo
instance (signature ~ (m (Gst.Caps.Caps)), MonadIO m) => O.MethodInfo QueryParseAcceptCapsMethodInfo Query signature where
    overloadedMethod = queryParseAcceptCaps

#endif

-- method Query::parse_accept_caps_result
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ACCEPT_CAPS type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_accept_caps_result" gst_query_parse_accept_caps_result :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CInt ->                             -- result : TBasicType TBoolean
    IO ()

-- | Parse the result from /@query@/ and store in /@result@/.
queryParseAcceptCapsResult ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ACCEPT_CAPS type query t'GI.Gst.Structs.Query.Query'
    -> m (Bool)
queryParseAcceptCapsResult :: Query -> m Bool
queryParseAcceptCapsResult Query
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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CInt
result_ <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Query -> Ptr CInt -> IO ()
gst_query_parse_accept_caps_result Ptr Query
query' Ptr CInt
result_
    CInt
result_' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
result_
    let result_'' :: Bool
result_'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result_'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
result_
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result_''

#if defined(ENABLE_OVERLOADING)
data QueryParseAcceptCapsResultMethodInfo
instance (signature ~ (m (Bool)), MonadIO m) => O.MethodInfo QueryParseAcceptCapsResultMethodInfo Query signature where
    overloadedMethod = queryParseAcceptCapsResult

#endif

-- method Query::parse_allocation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "need_pool"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether a #GstBufferPool is needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_allocation" gst_query_parse_allocation :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr (Ptr Gst.Caps.Caps) ->              -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr CInt ->                             -- need_pool : TBasicType TBoolean
    IO ()

-- | Parse an allocation query, writing the requested caps in /@caps@/ and
-- whether a pool is needed in /@needPool@/, if the respective parameters
-- are non-'P.Nothing'.
-- 
-- Pool details can be retrieved using 'GI.Gst.Structs.Query.queryGetNAllocationPools' and
-- 'GI.Gst.Structs.Query.queryParseNthAllocationPool'.
queryParseAllocation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m ((Gst.Caps.Caps, Bool))
queryParseAllocation :: Query -> m (Caps, Bool)
queryParseAllocation Query
query = IO (Caps, Bool) -> m (Caps, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Caps, Bool) -> m (Caps, Bool))
-> IO (Caps, Bool) -> m (Caps, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr (Ptr Caps)
caps <- IO (Ptr (Ptr Caps))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Caps.Caps))
    Ptr CInt
needPool <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Query -> Ptr (Ptr Caps) -> Ptr CInt -> IO ()
gst_query_parse_allocation Ptr Query
query' Ptr (Ptr Caps)
caps Ptr CInt
needPool
    Ptr Caps
caps' <- Ptr (Ptr Caps) -> IO (Ptr Caps)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Caps)
caps
    Caps
caps'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
caps'
    CInt
needPool' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
needPool
    let needPool'' :: Bool
needPool'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
needPool'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr (Ptr Caps) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Caps)
caps
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
needPool
    (Caps, Bool) -> IO (Caps, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Caps
caps'', Bool
needPool'')

#if defined(ENABLE_OVERLOADING)
data QueryParseAllocationMethodInfo
instance (signature ~ (m ((Gst.Caps.Caps, Bool))), MonadIO m) => O.MethodInfo QueryParseAllocationMethodInfo Query signature where
    overloadedMethod = queryParseAllocation

#endif

-- method Query::parse_bitrate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_BITRATE type #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nominal_bitrate"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The resulting bitrate in bits per second"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_bitrate" gst_query_parse_bitrate :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr Word32 ->                           -- nominal_bitrate : TBasicType TUInt
    IO ()

-- | Get the results of a bitrate query. See also 'GI.Gst.Structs.Query.querySetBitrate'.
-- 
-- /Since: 1.16/
queryParseBitrate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_BITRATE type t'GI.Gst.Structs.Query.Query'
    -> m (Word32)
queryParseBitrate :: Query -> m Word32
queryParseBitrate Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Word32
nominalBitrate <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Query -> Ptr Word32 -> IO ()
gst_query_parse_bitrate Ptr Query
query' Ptr Word32
nominalBitrate
    Word32
nominalBitrate' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nominalBitrate
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nominalBitrate
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
nominalBitrate'

#if defined(ENABLE_OVERLOADING)
data QueryParseBitrateMethodInfo
instance (signature ~ (m (Word32)), MonadIO m) => O.MethodInfo QueryParseBitrateMethodInfo Query signature where
    overloadedMethod = queryParseBitrate

#endif

-- method Query::parse_buffering_percent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_BUFFERING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "busy"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if buffering is busy, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "percent"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a buffering percent, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_buffering_percent" gst_query_parse_buffering_percent :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CInt ->                             -- busy : TBasicType TBoolean
    Ptr Int32 ->                            -- percent : TBasicType TInt
    IO ()

-- | Get the percentage of buffered data. This is a value between 0 and 100.
-- The /@busy@/ indicator is 'P.True' when the buffering is in progress.
queryParseBufferingPercent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_BUFFERING.
    -> m ((Bool, Int32))
queryParseBufferingPercent :: Query -> m (Bool, Int32)
queryParseBufferingPercent Query
query = IO (Bool, Int32) -> m (Bool, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32) -> m (Bool, Int32))
-> IO (Bool, Int32) -> m (Bool, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CInt
busy <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Int32
percent <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Query -> Ptr CInt -> Ptr Int32 -> IO ()
gst_query_parse_buffering_percent Ptr Query
query' Ptr CInt
busy Ptr Int32
percent
    CInt
busy' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
busy
    let busy'' :: Bool
busy'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
busy'
    Int32
percent' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
percent
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
busy
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
percent
    (Bool, Int32) -> IO (Bool, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
busy'', Int32
percent')

#if defined(ENABLE_OVERLOADING)
data QueryParseBufferingPercentMethodInfo
instance (signature ~ (m ((Bool, Int32))), MonadIO m) => O.MethodInfo QueryParseBufferingPercentMethodInfo Query signature where
    overloadedMethod = queryParseBufferingPercent

#endif

-- method Query::parse_buffering_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_BUFFERING type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the format to set for the @segment_start\n    and @segment_end values, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start to set, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stop to set, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "estimated_total"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "estimated total amount of download\n    time remaining in milliseconds, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_buffering_range" gst_query_parse_buffering_range :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- start : TBasicType TInt64
    Ptr Int64 ->                            -- stop : TBasicType TInt64
    Ptr Int64 ->                            -- estimated_total : TBasicType TInt64
    IO ()

-- | Parse an available query, writing the format into /@format@/, and
-- other results into the passed parameters, if the respective parameters
-- are non-'P.Nothing'
queryParseBufferingRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_BUFFERING type query t'GI.Gst.Structs.Query.Query'
    -> m ((Gst.Enums.Format, Int64, Int64, Int64))
queryParseBufferingRange :: Query -> m (Format, Int64, Int64, Int64)
queryParseBufferingRange Query
query = IO (Format, Int64, Int64, Int64) -> m (Format, Int64, Int64, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Int64, Int64, Int64)
 -> m (Format, Int64, Int64, Int64))
-> IO (Format, Int64, Int64, Int64)
-> m (Format, Int64, Int64, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
start <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Int64
stop <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Int64
estimatedTotal <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Query
-> Ptr CUInt -> Ptr Int64 -> Ptr Int64 -> Ptr Int64 -> IO ()
gst_query_parse_buffering_range Ptr Query
query' Ptr CUInt
format Ptr Int64
start Ptr Int64
stop Ptr Int64
estimatedTotal
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    Int64
start' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
start
    Int64
stop' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
stop
    Int64
estimatedTotal' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
estimatedTotal
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
start
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
stop
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
estimatedTotal
    (Format, Int64, Int64, Int64) -> IO (Format, Int64, Int64, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Int64
start', Int64
stop', Int64
estimatedTotal')

#if defined(ENABLE_OVERLOADING)
data QueryParseBufferingRangeMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Int64, Int64, Int64))), MonadIO m) => O.MethodInfo QueryParseBufferingRangeMethodInfo Query signature where
    overloadedMethod = queryParseBufferingRange

#endif

-- method Query::parse_buffering_stats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_BUFFERING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferingMode" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a buffering mode, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "avg_in"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the average input rate, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "avg_out"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the average output rat, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "buffering_left"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "amount of buffering time left in\n    milliseconds, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_buffering_stats" gst_query_parse_buffering_stats :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CUInt ->                            -- mode : TInterface (Name {namespace = "Gst", name = "BufferingMode"})
    Ptr Int32 ->                            -- avg_in : TBasicType TInt
    Ptr Int32 ->                            -- avg_out : TBasicType TInt
    Ptr Int64 ->                            -- buffering_left : TBasicType TInt64
    IO ()

-- | Extracts the buffering stats values from /@query@/.
queryParseBufferingStats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_BUFFERING.
    -> m ((Gst.Enums.BufferingMode, Int32, Int32, Int64))
queryParseBufferingStats :: Query -> m (BufferingMode, Int32, Int32, Int64)
queryParseBufferingStats Query
query = IO (BufferingMode, Int32, Int32, Int64)
-> m (BufferingMode, Int32, Int32, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (BufferingMode, Int32, Int32, Int64)
 -> m (BufferingMode, Int32, Int32, Int64))
-> IO (BufferingMode, Int32, Int32, Int64)
-> m (BufferingMode, Int32, Int32, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
mode <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int32
avgIn <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
avgOut <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int64
bufferingLeft <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Query
-> Ptr CUInt -> Ptr Int32 -> Ptr Int32 -> Ptr Int64 -> IO ()
gst_query_parse_buffering_stats Ptr Query
query' Ptr CUInt
mode Ptr Int32
avgIn Ptr Int32
avgOut Ptr Int64
bufferingLeft
    CUInt
mode' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
mode
    let mode'' :: BufferingMode
mode'' = (Int -> BufferingMode
forall a. Enum a => Int -> a
toEnum (Int -> BufferingMode) -> (CUInt -> Int) -> CUInt -> BufferingMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
mode'
    Int32
avgIn' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
avgIn
    Int32
avgOut' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
avgOut
    Int64
bufferingLeft' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
bufferingLeft
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
mode
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
avgIn
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
avgOut
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
bufferingLeft
    (BufferingMode, Int32, Int32, Int64)
-> IO (BufferingMode, Int32, Int32, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferingMode
mode'', Int32
avgIn', Int32
avgOut', Int64
bufferingLeft')

#if defined(ENABLE_OVERLOADING)
data QueryParseBufferingStatsMethodInfo
instance (signature ~ (m ((Gst.Enums.BufferingMode, Int32, Int32, Int64))), MonadIO m) => O.MethodInfo QueryParseBufferingStatsMethodInfo Query signature where
    overloadedMethod = queryParseBufferingStats

#endif

-- method Query::parse_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The query to parse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to the caps filter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_caps" gst_query_parse_caps :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr (Ptr Gst.Caps.Caps) ->              -- filter : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Get the filter from the caps /@query@/. The caps remains valid as long as
-- /@query@/ remains valid.
queryParseCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: The query to parse
    -> m (Gst.Caps.Caps)
queryParseCaps :: Query -> m Caps
queryParseCaps Query
query = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr (Ptr Caps)
filter <- IO (Ptr (Ptr Caps))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Caps.Caps))
    Ptr Query -> Ptr (Ptr Caps) -> IO ()
gst_query_parse_caps Ptr Query
query' Ptr (Ptr Caps)
filter
    Ptr Caps
filter' <- Ptr (Ptr Caps) -> IO (Ptr Caps)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Caps)
filter
    Caps
filter'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
filter'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr (Ptr Caps) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Caps)
filter
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
filter''

#if defined(ENABLE_OVERLOADING)
data QueryParseCapsMethodInfo
instance (signature ~ (m (Gst.Caps.Caps)), MonadIO m) => O.MethodInfo QueryParseCapsMethodInfo Query signature where
    overloadedMethod = queryParseCaps

#endif

-- method Query::parse_caps_result
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The query to parse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to the caps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_caps_result" gst_query_parse_caps_result :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr (Ptr Gst.Caps.Caps) ->              -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Get the caps result from /@query@/. The caps remains valid as long as
-- /@query@/ remains valid.
queryParseCapsResult ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: The query to parse
    -> m (Gst.Caps.Caps)
queryParseCapsResult :: Query -> m Caps
queryParseCapsResult Query
query = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr (Ptr Caps)
caps <- IO (Ptr (Ptr Caps))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Caps.Caps))
    Ptr Query -> Ptr (Ptr Caps) -> IO ()
gst_query_parse_caps_result Ptr Query
query' Ptr (Ptr Caps)
caps
    Ptr Caps
caps' <- Ptr (Ptr Caps) -> IO (Ptr Caps)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Caps)
caps
    Caps
caps'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
caps'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr (Ptr Caps) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Caps)
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
caps''

#if defined(ENABLE_OVERLOADING)
data QueryParseCapsResultMethodInfo
instance (signature ~ (m (Gst.Caps.Caps)), MonadIO m) => O.MethodInfo QueryParseCapsResultMethodInfo Query signature where
    overloadedMethod = queryParseCapsResult

#endif

-- method Query::parse_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The query to parse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to store the #GstContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_context" gst_query_parse_context :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr (Ptr Gst.Context.Context) ->        -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO ()

-- | Get the context from the context /@query@/. The context remains valid as long as
-- /@query@/ remains valid.
-- 
-- /Since: 1.2/
queryParseContext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: The query to parse
    -> m (Gst.Context.Context)
queryParseContext :: Query -> m Context
queryParseContext Query
query = IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr (Ptr Context)
context <- IO (Ptr (Ptr Context))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Context.Context))
    Ptr Query -> Ptr (Ptr Context) -> IO ()
gst_query_parse_context Ptr Query
query' Ptr (Ptr Context)
context
    Ptr Context
context' <- Ptr (Ptr Context) -> IO (Ptr Context)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Context)
context
    Context
context'' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Context -> Context
Gst.Context.Context) Ptr Context
context'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr (Ptr Context) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Context)
context
    Context -> IO Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
context''

#if defined(ENABLE_OVERLOADING)
data QueryParseContextMethodInfo
instance (signature ~ (m (Gst.Context.Context)), MonadIO m) => O.MethodInfo QueryParseContextMethodInfo Query signature where
    overloadedMethod = queryParseContext

#endif

-- method Query::parse_context_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_CONTEXT type query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the context type, or %NULL"
--                 , 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_query_parse_context_type" gst_query_parse_context_type :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CString ->                          -- context_type : TBasicType TUTF8
    IO CInt

-- | Parse a context type from an existing GST_QUERY_CONTEXT query.
-- 
-- /Since: 1.2/
queryParseContextType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_CONTEXT type query
    -> m ((Bool, T.Text))
    -- ^ __Returns:__ a t'P.Bool' indicating if the parsing succeeded.
queryParseContextType :: Query -> m (Bool, Text)
queryParseContextType Query
query = IO (Bool, Text) -> m (Bool, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text) -> m (Bool, Text))
-> IO (Bool, Text) -> m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CString
contextType <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr Query -> Ptr CString -> IO CInt
gst_query_parse_context_type Ptr Query
query' Ptr CString
contextType
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
contextType' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
contextType
    Text
contextType'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
contextType'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
contextType
    (Bool, Text) -> IO (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
contextType'')

#if defined(ENABLE_OVERLOADING)
data QueryParseContextTypeMethodInfo
instance (signature ~ (m ((Bool, T.Text))), MonadIO m) => O.MethodInfo QueryParseContextTypeMethodInfo Query signature where
    overloadedMethod = queryParseContextType

#endif

-- method Query::parse_convert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the storage for the #GstFormat of the\n    source value, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "src_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the storage for the source value, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "dest_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the storage for the #GstFormat of the\n    destination value, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "dest_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the storage for the destination value,\n    or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_convert" gst_query_parse_convert :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CUInt ->                            -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- src_value : TBasicType TInt64
    Ptr CUInt ->                            -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- dest_value : TBasicType TInt64
    IO ()

-- | Parse a convert query answer. Any of /@srcFormat@/, /@srcValue@/, /@destFormat@/,
-- and /@destValue@/ may be 'P.Nothing', in which case that value is omitted.
queryParseConvert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m ((Gst.Enums.Format, Int64, Gst.Enums.Format, Int64))
queryParseConvert :: Query -> m (Format, Int64, Format, Int64)
queryParseConvert Query
query = IO (Format, Int64, Format, Int64)
-> m (Format, Int64, Format, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Int64, Format, Int64)
 -> m (Format, Int64, Format, Int64))
-> IO (Format, Int64, Format, Int64)
-> m (Format, Int64, Format, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
srcFormat <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
srcValue <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr CUInt
destFormat <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
destValue <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Query
-> Ptr CUInt -> Ptr Int64 -> Ptr CUInt -> Ptr Int64 -> IO ()
gst_query_parse_convert Ptr Query
query' Ptr CUInt
srcFormat Ptr Int64
srcValue Ptr CUInt
destFormat Ptr Int64
destValue
    CUInt
srcFormat' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
srcFormat
    let srcFormat'' :: Format
srcFormat'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
srcFormat'
    Int64
srcValue' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
srcValue
    CUInt
destFormat' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
destFormat
    let destFormat'' :: Format
destFormat'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
destFormat'
    Int64
destValue' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
destValue
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
srcFormat
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
srcValue
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
destFormat
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
destValue
    (Format, Int64, Format, Int64) -> IO (Format, Int64, Format, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
srcFormat'', Int64
srcValue', Format
destFormat'', Int64
destValue')

#if defined(ENABLE_OVERLOADING)
data QueryParseConvertMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Int64, Gst.Enums.Format, Int64))), MonadIO m) => O.MethodInfo QueryParseConvertMethodInfo Query signature where
    overloadedMethod = queryParseConvert

#endif

-- method Query::parse_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the storage for the #GstFormat of the duration\n    value, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the storage for the total duration, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_duration" gst_query_parse_duration :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- duration : TBasicType TInt64
    IO ()

-- | Parse a duration query answer. Write the format of the duration into /@format@/,
-- and the value into /@duration@/, if the respective variables are non-'P.Nothing'.
queryParseDuration ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m ((Gst.Enums.Format, Int64))
queryParseDuration :: Query -> m (Format, Int64)
queryParseDuration Query
query = IO (Format, Int64) -> m (Format, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Int64) -> m (Format, Int64))
-> IO (Format, Int64) -> m (Format, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
duration <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Query -> Ptr CUInt -> Ptr Int64 -> IO ()
gst_query_parse_duration Ptr Query
query' Ptr CUInt
format Ptr Int64
duration
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    Int64
duration' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
duration
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
duration
    (Format, Int64) -> IO (Format, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Int64
duration')

#if defined(ENABLE_OVERLOADING)
data QueryParseDurationMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Int64))), MonadIO m) => O.MethodInfo QueryParseDurationMethodInfo Query signature where
    overloadedMethod = queryParseDuration

#endif

-- method Query::parse_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "live"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "storage for live or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "min_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the storage for the min latency or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "max_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the storage for the max latency or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_latency" gst_query_parse_latency :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CInt ->                             -- live : TBasicType TBoolean
    Ptr Word64 ->                           -- min_latency : TBasicType TUInt64
    Ptr Word64 ->                           -- max_latency : TBasicType TUInt64
    IO ()

-- | Parse a latency query answer.
queryParseLatency ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m ((Bool, Word64, Word64))
queryParseLatency :: Query -> m (Bool, CGType, CGType)
queryParseLatency Query
query = IO (Bool, CGType, CGType) -> m (Bool, CGType, CGType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, CGType, CGType) -> m (Bool, CGType, CGType))
-> IO (Bool, CGType, CGType) -> m (Bool, CGType, CGType)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CInt
live <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr CGType
minLatency <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CGType
maxLatency <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Query -> Ptr CInt -> Ptr CGType -> Ptr CGType -> IO ()
gst_query_parse_latency Ptr Query
query' Ptr CInt
live Ptr CGType
minLatency Ptr CGType
maxLatency
    CInt
live' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
live
    let live'' :: Bool
live'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
live'
    CGType
minLatency' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
minLatency
    CGType
maxLatency' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
maxLatency
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
live
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
minLatency
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
maxLatency
    (Bool, CGType, CGType) -> IO (Bool, CGType, CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
live'', CGType
minLatency', CGType
maxLatency')

#if defined(ENABLE_OVERLOADING)
data QueryParseLatencyMethodInfo
instance (signature ~ (m ((Bool, Word64, Word64))), MonadIO m) => O.MethodInfo QueryParseLatencyMethodInfo Query signature where
    overloadedMethod = queryParseLatency

#endif

-- method Query::parse_n_formats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_formats"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of formats in this query."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_n_formats" gst_query_parse_n_formats :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr Word32 ->                           -- n_formats : TBasicType TUInt
    IO ()

-- | Parse the number of formats in the formats /@query@/.
queryParseNFormats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m (Word32)
queryParseNFormats :: Query -> m Word32
queryParseNFormats Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Word32
nFormats <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Query -> Ptr Word32 -> IO ()
gst_query_parse_n_formats Ptr Query
query' Ptr Word32
nFormats
    Word32
nFormats' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nFormats
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nFormats
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
nFormats'

#if defined(ENABLE_OVERLOADING)
data QueryParseNFormatsMethodInfo
instance (signature ~ (m (Word32)), MonadIO m) => O.MethodInfo QueryParseNFormatsMethodInfo Query signature where
    overloadedMethod = queryParseNFormats

#endif

-- method Query::parse_nth_allocation_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position in the metadata API array to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "API specific parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_nth_allocation_meta" gst_query_parse_nth_allocation_meta :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr (Ptr Gst.Structure.Structure) ->    -- params : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CGType

-- | Parse an available query and get the metadata API
-- at /@index@/ of the metadata API array.
queryParseNthAllocationMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@index@/: position in the metadata API array to read
    -> m ((GType, Gst.Structure.Structure))
    -- ^ __Returns:__ a t'GType' of the metadata API at /@index@/.
queryParseNthAllocationMeta :: Query -> Word32 -> m (GType, Structure)
queryParseNthAllocationMeta Query
query Word32
index = IO (GType, Structure) -> m (GType, Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GType, Structure) -> m (GType, Structure))
-> IO (GType, Structure) -> m (GType, Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr (Ptr Structure)
params <- IO (Ptr (Ptr Structure))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Structure.Structure))
    CGType
result <- Ptr Query -> Word32 -> Ptr (Ptr Structure) -> IO CGType
gst_query_parse_nth_allocation_meta Ptr Query
query' Word32
index Ptr (Ptr Structure)
params
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    Ptr Structure
params' <- Ptr (Ptr Structure) -> IO (Ptr Structure)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Structure)
params
    Structure
params'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
params'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr (Ptr Structure) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Structure)
params
    (GType, Structure) -> IO (GType, Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return (GType
result', Structure
params'')

#if defined(ENABLE_OVERLOADING)
data QueryParseNthAllocationMetaMethodInfo
instance (signature ~ (Word32 -> m ((GType, Gst.Structure.Structure))), MonadIO m) => O.MethodInfo QueryParseNthAllocationMetaMethodInfo Query signature where
    overloadedMethod = queryParseNthAllocationMeta

#endif

-- method Query::parse_nth_allocation_param
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position in the allocator array to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Allocator" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "variable to hold the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "AllocationParams" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "parameters for the allocator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_nth_allocation_param" gst_query_parse_nth_allocation_param :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr (Ptr Gst.Allocator.Allocator) ->    -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

-- | Parse an available query and get the allocator and its params
-- at /@index@/ of the allocator array.
queryParseNthAllocationParam ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@index@/: position in the allocator array to read
    -> m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))
queryParseNthAllocationParam :: Query -> Word32 -> m (Allocator, AllocationParams)
queryParseNthAllocationParam Query
query Word32
index = IO (Allocator, AllocationParams) -> m (Allocator, AllocationParams)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Allocator, AllocationParams)
 -> m (Allocator, AllocationParams))
-> IO (Allocator, AllocationParams)
-> m (Allocator, AllocationParams)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr (Ptr Allocator)
allocator <- IO (Ptr (Ptr Allocator))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Allocator.Allocator))
    Ptr AllocationParams
params <- Int -> IO (Ptr AllocationParams)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
64 :: IO (Ptr Gst.AllocationParams.AllocationParams)
    Ptr Query
-> Word32 -> Ptr (Ptr Allocator) -> Ptr AllocationParams -> IO ()
gst_query_parse_nth_allocation_param Ptr Query
query' Word32
index Ptr (Ptr Allocator)
allocator Ptr AllocationParams
params
    Ptr Allocator
allocator' <- Ptr (Ptr Allocator) -> IO (Ptr Allocator)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Allocator)
allocator
    Allocator
allocator'' <- ((ManagedPtr Allocator -> Allocator)
-> Ptr Allocator -> IO Allocator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Allocator -> Allocator
Gst.Allocator.Allocator) Ptr Allocator
allocator'
    AllocationParams
params' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
Gst.AllocationParams.AllocationParams) Ptr AllocationParams
params
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr (Ptr Allocator) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Allocator)
allocator
    (Allocator, AllocationParams) -> IO (Allocator, AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Allocator
allocator'', AllocationParams
params')

#if defined(ENABLE_OVERLOADING)
data QueryParseNthAllocationParamMethodInfo
instance (signature ~ (Word32 -> m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))), MonadIO m) => O.MethodInfo QueryParseNthAllocationParamMethodInfo Query signature where
    overloadedMethod = queryParseNthAllocationParam

#endif

-- method Query::parse_nth_allocation_pool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_ALLOCATION."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index to parse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "min_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the min buffers" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "max_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the max buffers" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_nth_allocation_pool" gst_query_parse_nth_allocation_pool :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr (Ptr Gst.BufferPool.BufferPool) ->  -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    Ptr Word32 ->                           -- size : TBasicType TUInt
    Ptr Word32 ->                           -- min_buffers : TBasicType TUInt
    Ptr Word32 ->                           -- max_buffers : TBasicType TUInt
    IO ()

-- | Get the pool parameters in /@query@/.
-- 
-- Unref /@pool@/ with 'GI.Gst.Objects.Object.objectUnref' when it\'s not needed any more.
queryParseNthAllocationPool ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_ALLOCATION.
    -> Word32
    -- ^ /@index@/: index to parse
    -> m ((Gst.BufferPool.BufferPool, Word32, Word32, Word32))
queryParseNthAllocationPool :: Query -> Word32 -> m (BufferPool, Word32, Word32, Word32)
queryParseNthAllocationPool Query
query Word32
index = IO (BufferPool, Word32, Word32, Word32)
-> m (BufferPool, Word32, Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (BufferPool, Word32, Word32, Word32)
 -> m (BufferPool, Word32, Word32, Word32))
-> IO (BufferPool, Word32, Word32, Word32)
-> m (BufferPool, Word32, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr (Ptr BufferPool)
pool <- IO (Ptr (Ptr BufferPool))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.BufferPool.BufferPool))
    Ptr Word32
size <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
minBuffers <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
maxBuffers <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Query
-> Word32
-> Ptr (Ptr BufferPool)
-> Ptr Word32
-> Ptr Word32
-> Ptr Word32
-> IO ()
gst_query_parse_nth_allocation_pool Ptr Query
query' Word32
index Ptr (Ptr BufferPool)
pool Ptr Word32
size Ptr Word32
minBuffers Ptr Word32
maxBuffers
    Ptr BufferPool
pool' <- Ptr (Ptr BufferPool) -> IO (Ptr BufferPool)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BufferPool)
pool
    BufferPool
pool'' <- ((ManagedPtr BufferPool -> BufferPool)
-> Ptr BufferPool -> IO BufferPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BufferPool -> BufferPool
Gst.BufferPool.BufferPool) Ptr BufferPool
pool'
    Word32
size' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
size
    Word32
minBuffers' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
minBuffers
    Word32
maxBuffers' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
maxBuffers
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr (Ptr BufferPool) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr BufferPool)
pool
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
size
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
minBuffers
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
maxBuffers
    (BufferPool, Word32, Word32, Word32)
-> IO (BufferPool, Word32, Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferPool
pool'', Word32
size', Word32
minBuffers', Word32
maxBuffers')

#if defined(ENABLE_OVERLOADING)
data QueryParseNthAllocationPoolMethodInfo
instance (signature ~ (Word32 -> m ((Gst.BufferPool.BufferPool, Word32, Word32, Word32))), MonadIO m) => O.MethodInfo QueryParseNthAllocationPoolMethodInfo Query signature where
    overloadedMethod = queryParseNthAllocationPool

#endif

-- method Query::parse_nth_buffering_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_BUFFERING type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position in the buffered-ranges array to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start position to set, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stop position to set, or %NULL"
--                 , 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_query_parse_nth_buffering_range" gst_query_parse_nth_buffering_range :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Int64 ->                            -- start : TBasicType TInt64
    Ptr Int64 ->                            -- stop : TBasicType TInt64
    IO CInt

-- | Parse an available query and get the start and stop values stored
-- at the /@index@/ of the buffered ranges array.
queryParseNthBufferingRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_BUFFERING type query t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@index@/: position in the buffered-ranges array to read
    -> m ((Bool, Int64, Int64))
    -- ^ __Returns:__ a t'P.Bool' indicating if the parsing succeeded.
queryParseNthBufferingRange :: Query -> Word32 -> m (Bool, Int64, Int64)
queryParseNthBufferingRange Query
query Word32
index = IO (Bool, Int64, Int64) -> m (Bool, Int64, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64, Int64) -> m (Bool, Int64, Int64))
-> IO (Bool, Int64, Int64) -> m (Bool, Int64, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Int64
start <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Int64
stop <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Query -> Word32 -> Ptr Int64 -> Ptr Int64 -> IO CInt
gst_query_parse_nth_buffering_range Ptr Query
query' Word32
index Ptr Int64
start Ptr Int64
stop
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
start' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
start
    Int64
stop' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
stop
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
start
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
stop
    (Bool, Int64, Int64) -> IO (Bool, Int64, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
start', Int64
stop')

#if defined(ENABLE_OVERLOADING)
data QueryParseNthBufferingRangeMethodInfo
instance (signature ~ (Word32 -> m ((Bool, Int64, Int64))), MonadIO m) => O.MethodInfo QueryParseNthBufferingRangeMethodInfo Query signature where
    overloadedMethod = queryParseNthBufferingRange

#endif

-- method Query::parse_nth_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nth"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the nth format to retrieve."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to store the nth format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_nth_format" gst_query_parse_nth_format :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- nth : TBasicType TUInt
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO ()

-- | Parse the format query and retrieve the /@nth@/ format from it into
-- /@format@/. If the list contains less elements than /@nth@/, /@format@/ will be
-- set to GST_FORMAT_UNDEFINED.
queryParseNthFormat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@nth@/: the nth format to retrieve.
    -> m (Gst.Enums.Format)
queryParseNthFormat :: Query -> Word32 -> m Format
queryParseNthFormat Query
query Word32
nth = IO Format -> m Format
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Format -> m Format) -> IO Format -> m Format
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Query -> Word32 -> Ptr CUInt -> IO ()
gst_query_parse_nth_format Ptr Query
query' Word32
nth Ptr CUInt
format
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Format -> IO Format
forall (m :: * -> *) a. Monad m => a -> m a
return Format
format''

#if defined(ENABLE_OVERLOADING)
data QueryParseNthFormatMethodInfo
instance (signature ~ (Word32 -> m (Gst.Enums.Format)), MonadIO m) => O.MethodInfo QueryParseNthFormatMethodInfo Query signature where
    overloadedMethod = queryParseNthFormat

#endif

-- method Query::parse_nth_scheduling_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_SCHEDULING type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "position in the scheduling modes array to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "PadMode" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_nth_scheduling_mode" gst_query_parse_nth_scheduling_mode :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    IO CUInt

-- | Parse an available query and get the scheduling mode
-- at /@index@/ of the scheduling modes array.
queryParseNthSchedulingMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_SCHEDULING type query t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@index@/: position in the scheduling modes array to read
    -> m Gst.Enums.PadMode
    -- ^ __Returns:__ a t'GI.Gst.Enums.PadMode' of the scheduling mode at /@index@/.
queryParseNthSchedulingMode :: Query -> Word32 -> m PadMode
queryParseNthSchedulingMode Query
query Word32
index = IO PadMode -> m PadMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PadMode -> m PadMode) -> IO PadMode -> m PadMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CUInt
result <- Ptr Query -> Word32 -> IO CUInt
gst_query_parse_nth_scheduling_mode Ptr Query
query' Word32
index
    let result' :: PadMode
result' = (Int -> PadMode
forall a. Enum a => Int -> a
toEnum (Int -> PadMode) -> (CUInt -> Int) -> CUInt -> PadMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    PadMode -> IO PadMode
forall (m :: * -> *) a. Monad m => a -> m a
return PadMode
result'

#if defined(ENABLE_OVERLOADING)
data QueryParseNthSchedulingModeMethodInfo
instance (signature ~ (Word32 -> m Gst.Enums.PadMode), MonadIO m) => O.MethodInfo QueryParseNthSchedulingModeMethodInfo Query signature where
    overloadedMethod = queryParseNthSchedulingMode

#endif

-- method Query::parse_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the storage for the #GstFormat of the\n    position values (may be %NULL)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cur"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the storage for the current position (may be %NULL)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_position" gst_query_parse_position :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- cur : TBasicType TInt64
    IO ()

-- | Parse a position query, writing the format into /@format@/, and the position
-- into /@cur@/, if the respective parameters are non-'P.Nothing'.
queryParsePosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m ((Gst.Enums.Format, Int64))
queryParsePosition :: Query -> m (Format, Int64)
queryParsePosition Query
query = IO (Format, Int64) -> m (Format, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Int64) -> m (Format, Int64))
-> IO (Format, Int64) -> m (Format, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
cur <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Query -> Ptr CUInt -> Ptr Int64 -> IO ()
gst_query_parse_position Ptr Query
query' Ptr CUInt
format Ptr Int64
cur
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    Int64
cur' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
cur
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
cur
    (Format, Int64) -> IO (Format, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Int64
cur')

#if defined(ENABLE_OVERLOADING)
data QueryParsePositionMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Int64))), MonadIO m) => O.MethodInfo QueryParsePositionMethodInfo Query signature where
    overloadedMethod = queryParsePosition

#endif

-- method Query::parse_scheduling
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_SCHEDULING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SchedulingFlags" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstSchedulingFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "minsize"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the suggested minimum size of pull requests"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "maxsize"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the suggested maximum size of pull requests:"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "align"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the suggested alignment of pull requests"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_scheduling" gst_query_parse_scheduling :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CUInt ->                            -- flags : TInterface (Name {namespace = "Gst", name = "SchedulingFlags"})
    Ptr Int32 ->                            -- minsize : TBasicType TInt
    Ptr Int32 ->                            -- maxsize : TBasicType TInt
    Ptr Int32 ->                            -- align : TBasicType TInt
    IO ()

-- | Set the scheduling properties.
queryParseScheduling ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_SCHEDULING.
    -> m (([Gst.Flags.SchedulingFlags], Int32, Int32, Int32))
queryParseScheduling :: Query -> m ([SchedulingFlags], Int32, Int32, Int32)
queryParseScheduling Query
query = IO ([SchedulingFlags], Int32, Int32, Int32)
-> m ([SchedulingFlags], Int32, Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([SchedulingFlags], Int32, Int32, Int32)
 -> m ([SchedulingFlags], Int32, Int32, Int32))
-> IO ([SchedulingFlags], Int32, Int32, Int32)
-> m ([SchedulingFlags], Int32, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
flags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int32
minsize <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
maxsize <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
align <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Query
-> Ptr CUInt -> Ptr Int32 -> Ptr Int32 -> Ptr Int32 -> IO ()
gst_query_parse_scheduling Ptr Query
query' Ptr CUInt
flags Ptr Int32
minsize Ptr Int32
maxsize Ptr Int32
align
    CUInt
flags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
flags
    let flags'' :: [SchedulingFlags]
flags'' = CUInt -> [SchedulingFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags'
    Int32
minsize' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
minsize
    Int32
maxsize' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
maxsize
    Int32
align' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
align
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
flags
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
minsize
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
maxsize
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
align
    ([SchedulingFlags], Int32, Int32, Int32)
-> IO ([SchedulingFlags], Int32, Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return ([SchedulingFlags]
flags'', Int32
minsize', Int32
maxsize', Int32
align')

#if defined(ENABLE_OVERLOADING)
data QueryParseSchedulingMethodInfo
instance (signature ~ (m (([Gst.Flags.SchedulingFlags], Int32, Int32, Int32))), MonadIO m) => O.MethodInfo QueryParseSchedulingMethodInfo Query signature where
    overloadedMethod = queryParseScheduling

#endif

-- method Query::parse_seeking
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_SEEKING type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the format to set for the @segment_start\n    and @segment_end values, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "seekable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seekable flag to set, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "segment_start"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the segment_start to set, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "segment_end"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the segment_end to set, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_seeking" gst_query_parse_seeking :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr CInt ->                             -- seekable : TBasicType TBoolean
    Ptr Int64 ->                            -- segment_start : TBasicType TInt64
    Ptr Int64 ->                            -- segment_end : TBasicType TInt64
    IO ()

-- | Parse a seeking query, writing the format into /@format@/, and
-- other results into the passed parameters, if the respective parameters
-- are non-'P.Nothing'
queryParseSeeking ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_SEEKING type query t'GI.Gst.Structs.Query.Query'
    -> m ((Gst.Enums.Format, Bool, Int64, Int64))
queryParseSeeking :: Query -> m (Format, Bool, Int64, Int64)
queryParseSeeking Query
query = IO (Format, Bool, Int64, Int64) -> m (Format, Bool, Int64, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Bool, Int64, Int64) -> m (Format, Bool, Int64, Int64))
-> IO (Format, Bool, Int64, Int64)
-> m (Format, Bool, Int64, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CInt
seekable <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Int64
segmentStart <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Int64
segmentEnd <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Query
-> Ptr CUInt -> Ptr CInt -> Ptr Int64 -> Ptr Int64 -> IO ()
gst_query_parse_seeking Ptr Query
query' Ptr CUInt
format Ptr CInt
seekable Ptr Int64
segmentStart Ptr Int64
segmentEnd
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    CInt
seekable' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
seekable
    let seekable'' :: Bool
seekable'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
seekable'
    Int64
segmentStart' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
segmentStart
    Int64
segmentEnd' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
segmentEnd
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
seekable
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
segmentStart
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
segmentEnd
    (Format, Bool, Int64, Int64) -> IO (Format, Bool, Int64, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Bool
seekable'', Int64
segmentStart', Int64
segmentEnd')

#if defined(ENABLE_OVERLOADING)
data QueryParseSeekingMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Bool, Int64, Int64))), MonadIO m) => O.MethodInfo QueryParseSeekingMethodInfo Query signature where
    overloadedMethod = queryParseSeeking

#endif

-- method Query::parse_segment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the storage for the rate of the segment, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the storage for the #GstFormat of the values,\n    or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "start_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the storage for the start value, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "stop_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the storage for the stop value, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_segment" gst_query_parse_segment :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CDouble ->                          -- rate : TBasicType TDouble
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- start_value : TBasicType TInt64
    Ptr Int64 ->                            -- stop_value : TBasicType TInt64
    IO ()

-- | Parse a segment query answer. Any of /@rate@/, /@format@/, /@startValue@/, and
-- /@stopValue@/ may be 'P.Nothing', which will cause this value to be omitted.
-- 
-- See 'GI.Gst.Structs.Query.querySetSegment' for an explanation of the function arguments.
queryParseSegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m ((Double, Gst.Enums.Format, Int64, Int64))
queryParseSegment :: Query -> m (Double, Format, Int64, Int64)
queryParseSegment Query
query = IO (Double, Format, Int64, Int64)
-> m (Double, Format, Int64, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Format, Int64, Int64)
 -> m (Double, Format, Int64, Int64))
-> IO (Double, Format, Int64, Int64)
-> m (Double, Format, Int64, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CDouble
rate <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
startValue <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Int64
stopValue <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Query
-> Ptr CDouble -> Ptr CUInt -> Ptr Int64 -> Ptr Int64 -> IO ()
gst_query_parse_segment Ptr Query
query' Ptr CDouble
rate Ptr CUInt
format Ptr Int64
startValue Ptr Int64
stopValue
    CDouble
rate' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
rate
    let rate'' :: Double
rate'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
rate'
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    Int64
startValue' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
startValue
    Int64
stopValue' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
stopValue
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
rate
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
startValue
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
stopValue
    (Double, Format, Int64, Int64) -> IO (Double, Format, Int64, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
rate'', Format
format'', Int64
startValue', Int64
stopValue')

#if defined(ENABLE_OVERLOADING)
data QueryParseSegmentMethodInfo
instance (signature ~ (m ((Double, Gst.Enums.Format, Int64, Int64))), MonadIO m) => O.MethodInfo QueryParseSegmentMethodInfo Query signature where
    overloadedMethod = queryParseSegment

#endif

-- method Query::parse_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the storage for the current URI\n    (may be %NULL)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Parse an URI query, writing the URI into /@uri@/ as a newly
-- allocated string, if the respective parameters are non-'P.Nothing'.
-- Free the string with 'GI.GLib.Functions.free' after usage.
queryParseUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m (T.Text)
queryParseUri :: Query -> m Text
queryParseUri Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CString
uri <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Query -> Ptr CString -> IO ()
gst_query_parse_uri Ptr Query
query' Ptr CString
uri
    CString
uri' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
uri
    Text
uri'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
uri'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
uri''

#if defined(ENABLE_OVERLOADING)
data QueryParseUriMethodInfo
instance (signature ~ (m (T.Text)), MonadIO m) => O.MethodInfo QueryParseUriMethodInfo Query signature where
    overloadedMethod = queryParseUri

#endif

-- method Query::parse_uri_redirection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the storage for the redirect URI\n    (may be %NULL)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Parse an URI query, writing the URI into /@uri@/ as a newly
-- allocated string, if the respective parameters are non-'P.Nothing'.
-- Free the string with 'GI.GLib.Functions.free' after usage.
-- 
-- /Since: 1.2/
queryParseUriRedirection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m (T.Text)
queryParseUriRedirection :: Query -> m Text
queryParseUriRedirection Query
query = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CString
uri <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Query -> Ptr CString -> IO ()
gst_query_parse_uri_redirection Ptr Query
query' Ptr CString
uri
    CString
uri' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
uri
    Text
uri'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
uri'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
uri
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
uri''

#if defined(ENABLE_OVERLOADING)
data QueryParseUriRedirectionMethodInfo
instance (signature ~ (m (T.Text)), MonadIO m) => O.MethodInfo QueryParseUriRedirectionMethodInfo Query signature where
    overloadedMethod = queryParseUriRedirection

#endif

-- method Query::parse_uri_redirection_permanent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "permanent"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if the URI redirection is permanent\n    (may be %NULL)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_parse_uri_redirection_permanent" gst_query_parse_uri_redirection_permanent :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr CInt ->                             -- permanent : TBasicType TBoolean
    IO ()

-- | Parse an URI query, and set /@permanent@/ to 'P.True' if there is a redirection
-- and it should be considered permanent. If a redirection is permanent,
-- applications should update their internal storage of the URI, otherwise
-- they should make all future requests to the original URI.
-- 
-- /Since: 1.4/
queryParseUriRedirectionPermanent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m (Bool)
queryParseUriRedirectionPermanent :: Query -> m Bool
queryParseUriRedirectionPermanent Query
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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CInt
permanent <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Query -> Ptr CInt -> IO ()
gst_query_parse_uri_redirection_permanent Ptr Query
query' Ptr CInt
permanent
    CInt
permanent' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
permanent
    let permanent'' :: Bool
permanent'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
permanent'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
permanent
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
permanent''

#if defined(ENABLE_OVERLOADING)
data QueryParseUriRedirectionPermanentMethodInfo
instance (signature ~ (m (Bool)), MonadIO m) => O.MethodInfo QueryParseUriRedirectionPermanentMethodInfo Query signature where
    overloadedMethod = queryParseUriRedirectionPermanent

#endif

-- method Query::remove_nth_allocation_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position in the metadata API array to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_remove_nth_allocation_meta" gst_query_remove_nth_allocation_meta :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    IO ()

-- | Remove the metadata API at /@index@/ of the metadata API array.
queryRemoveNthAllocationMeta ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@index@/: position in the metadata API array to remove
    -> m ()
queryRemoveNthAllocationMeta :: Query -> Word32 -> m ()
queryRemoveNthAllocationMeta Query
query Word32
index = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Query -> Word32 -> IO ()
gst_query_remove_nth_allocation_meta Ptr Query
query' Word32
index
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QueryRemoveNthAllocationMetaMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo QueryRemoveNthAllocationMetaMethodInfo Query signature where
    overloadedMethod = queryRemoveNthAllocationMeta

#endif

-- method Query::remove_nth_allocation_param
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "position in the allocation param array to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_remove_nth_allocation_param" gst_query_remove_nth_allocation_param :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    IO ()

-- | Remove the allocation param at /@index@/ of the allocation param array.
-- 
-- /Since: 1.2/
queryRemoveNthAllocationParam ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@index@/: position in the allocation param array to remove
    -> m ()
queryRemoveNthAllocationParam :: Query -> Word32 -> m ()
queryRemoveNthAllocationParam Query
query Word32
index = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Query -> Word32 -> IO ()
gst_query_remove_nth_allocation_param Ptr Query
query' Word32
index
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QueryRemoveNthAllocationParamMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo QueryRemoveNthAllocationParamMethodInfo Query signature where
    overloadedMethod = queryRemoveNthAllocationParam

#endif

-- method Query::remove_nth_allocation_pool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "position in the allocation pool array to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_remove_nth_allocation_pool" gst_query_remove_nth_allocation_pool :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    IO ()

-- | Remove the allocation pool at /@index@/ of the allocation pool array.
-- 
-- /Since: 1.2/
queryRemoveNthAllocationPool ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@index@/: position in the allocation pool array to remove
    -> m ()
queryRemoveNthAllocationPool :: Query -> Word32 -> m ()
queryRemoveNthAllocationPool Query
query Word32
index = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Query -> Word32 -> IO ()
gst_query_remove_nth_allocation_pool Ptr Query
query' Word32
index
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QueryRemoveNthAllocationPoolMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo QueryRemoveNthAllocationPoolMethodInfo Query signature where
    overloadedMethod = queryRemoveNthAllocationPool

#endif

-- method Query::set_accept_caps_result
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ACCEPT_CAPS type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_accept_caps_result" gst_query_set_accept_caps_result :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CInt ->                                 -- result : TBasicType TBoolean
    IO ()

-- | Set /@result@/ as the result for the /@query@/.
querySetAcceptCapsResult ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ACCEPT_CAPS type query t'GI.Gst.Structs.Query.Query'
    -> Bool
    -- ^ /@result@/: the result to set
    -> m ()
querySetAcceptCapsResult :: Query -> Bool -> m ()
querySetAcceptCapsResult Query
query Bool
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let result_' :: CInt
result_' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result_
    Ptr Query -> CInt -> IO ()
gst_query_set_accept_caps_result Ptr Query
query' CInt
result_'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetAcceptCapsResultMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo QuerySetAcceptCapsResultMethodInfo Query signature where
    overloadedMethod = querySetAcceptCapsResult

#endif

-- method Query::set_bitrate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_BITRATE type #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nominal_bitrate"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the nominal bitrate in bits per second"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_bitrate" gst_query_set_bitrate :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- nominal_bitrate : TBasicType TUInt
    IO ()

-- | Set the results of a bitrate query.  The nominal bitrate is the average
-- bitrate expected over the length of the stream as advertised in file
-- headers (or similar).
-- 
-- /Since: 1.16/
querySetBitrate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a GST_QUERY_BITRATE type t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@nominalBitrate@/: the nominal bitrate in bits per second
    -> m ()
querySetBitrate :: Query -> Word32 -> m ()
querySetBitrate Query
query Word32
nominalBitrate = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Query -> Word32 -> IO ()
gst_query_set_bitrate Ptr Query
query' Word32
nominalBitrate
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetBitrateMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo QuerySetBitrateMethodInfo Query signature where
    overloadedMethod = querySetBitrate

#endif

-- method Query::set_buffering_percent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_BUFFERING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "busy"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if buffering is busy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "percent"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a buffering percent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_buffering_percent" gst_query_set_buffering_percent :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CInt ->                                 -- busy : TBasicType TBoolean
    Int32 ->                                -- percent : TBasicType TInt
    IO ()

-- | Set the percentage of buffered data. This is a value between 0 and 100.
-- The /@busy@/ indicator is 'P.True' when the buffering is in progress.
querySetBufferingPercent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_BUFFERING.
    -> Bool
    -- ^ /@busy@/: if buffering is busy
    -> Int32
    -- ^ /@percent@/: a buffering percent
    -> m ()
querySetBufferingPercent :: Query -> Bool -> Int32 -> m ()
querySetBufferingPercent Query
query Bool
busy Int32
percent = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let busy' :: CInt
busy' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
busy
    Ptr Query -> CInt -> Int32 -> IO ()
gst_query_set_buffering_percent Ptr Query
query' CInt
busy' Int32
percent
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetBufferingPercentMethodInfo
instance (signature ~ (Bool -> Int32 -> m ()), MonadIO m) => O.MethodInfo QuerySetBufferingPercentMethodInfo Query signature where
    overloadedMethod = querySetBufferingPercent

#endif

-- method Query::set_buffering_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the format to set for the @start and @stop values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stop to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "estimated_total"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "estimated total amount of download time remaining in\n    milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_buffering_range" gst_query_set_buffering_range :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- start : TBasicType TInt64
    Int64 ->                                -- stop : TBasicType TInt64
    Int64 ->                                -- estimated_total : TBasicType TInt64
    IO ()

-- | Set the available query result fields in /@query@/.
querySetBufferingRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Gst.Enums.Format
    -- ^ /@format@/: the format to set for the /@start@/ and /@stop@/ values
    -> Int64
    -- ^ /@start@/: the start to set
    -> Int64
    -- ^ /@stop@/: the stop to set
    -> Int64
    -- ^ /@estimatedTotal@/: estimated total amount of download time remaining in
    --     milliseconds
    -> m ()
querySetBufferingRange :: Query -> Format -> Int64 -> Int64 -> Int64 -> m ()
querySetBufferingRange Query
query Format
format Int64
start Int64
stop Int64
estimatedTotal = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query -> CUInt -> Int64 -> Int64 -> Int64 -> IO ()
gst_query_set_buffering_range Ptr Query
query' CUInt
format' Int64
start Int64
stop Int64
estimatedTotal
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetBufferingRangeMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Int64 -> Int64 -> m ()), MonadIO m) => O.MethodInfo QuerySetBufferingRangeMethodInfo Query signature where
    overloadedMethod = querySetBufferingRange

#endif

-- method Query::set_buffering_stats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_BUFFERING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferingMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a buffering mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "avg_in"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the average input rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "avg_out"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the average output rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffering_left"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "amount of buffering time left in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_buffering_stats" gst_query_set_buffering_stats :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "BufferingMode"})
    Int32 ->                                -- avg_in : TBasicType TInt
    Int32 ->                                -- avg_out : TBasicType TInt
    Int64 ->                                -- buffering_left : TBasicType TInt64
    IO ()

-- | Configures the buffering stats values in /@query@/.
querySetBufferingStats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_BUFFERING.
    -> Gst.Enums.BufferingMode
    -- ^ /@mode@/: a buffering mode
    -> Int32
    -- ^ /@avgIn@/: the average input rate
    -> Int32
    -- ^ /@avgOut@/: the average output rate
    -> Int64
    -- ^ /@bufferingLeft@/: amount of buffering time left in milliseconds
    -> m ()
querySetBufferingStats :: Query -> BufferingMode -> Int32 -> Int32 -> Int64 -> m ()
querySetBufferingStats Query
query BufferingMode
mode Int32
avgIn Int32
avgOut Int64
bufferingLeft = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BufferingMode -> Int) -> BufferingMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferingMode -> Int
forall a. Enum a => a -> Int
fromEnum) BufferingMode
mode
    Ptr Query -> CUInt -> Int32 -> Int32 -> Int64 -> IO ()
gst_query_set_buffering_stats Ptr Query
query' CUInt
mode' Int32
avgIn Int32
avgOut Int64
bufferingLeft
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetBufferingStatsMethodInfo
instance (signature ~ (Gst.Enums.BufferingMode -> Int32 -> Int32 -> Int64 -> m ()), MonadIO m) => O.MethodInfo QuerySetBufferingStatsMethodInfo Query signature where
    overloadedMethod = querySetBufferingStats

#endif

-- method Query::set_caps_result
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The query to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to the caps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_caps_result" gst_query_set_caps_result :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Set the /@caps@/ result in /@query@/.
querySetCapsResult ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: The query to use
    -> Gst.Caps.Caps
    -- ^ /@caps@/: A pointer to the caps
    -> m ()
querySetCapsResult :: Query -> Caps -> m ()
querySetCapsResult Query
query Caps
caps = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Query -> Ptr Caps -> IO ()
gst_query_set_caps_result Ptr Query
query' Ptr Caps
caps'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetCapsResultMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m ()), MonadIO m) => O.MethodInfo QuerySetCapsResultMethodInfo Query signature where
    overloadedMethod = querySetCapsResult

#endif

-- method Query::set_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery with query type GST_QUERY_CONTEXT"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested #GstContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_context" gst_query_set_context :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr Gst.Context.Context ->              -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO ()

-- | Answer a context query by setting the requested context.
-- 
-- /Since: 1.2/
querySetContext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query' with query type GST_QUERY_CONTEXT
    -> Gst.Context.Context
    -- ^ /@context@/: the requested t'GI.Gst.Structs.Context.Context'
    -> m ()
querySetContext :: Query -> Context -> m ()
querySetContext Query
query Context
context = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Context
context' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
context
    Ptr Query -> Ptr Context -> IO ()
gst_query_set_context Ptr Query
query' Ptr Context
context'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetContextMethodInfo
instance (signature ~ (Gst.Context.Context -> m ()), MonadIO m) => O.MethodInfo QuerySetContextMethodInfo Query signature where
    overloadedMethod = querySetContext

#endif

-- method Query::set_convert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source #GstFormat"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the destination #GstFormat"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the destination value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_convert" gst_query_set_convert :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- src_value : TBasicType TInt64
    CUInt ->                                -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- dest_value : TBasicType TInt64
    IO ()

-- | Answer a convert query by setting the requested values.
querySetConvert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Gst.Enums.Format
    -- ^ /@srcFormat@/: the source t'GI.Gst.Enums.Format'
    -> Int64
    -- ^ /@srcValue@/: the source value
    -> Gst.Enums.Format
    -- ^ /@destFormat@/: the destination t'GI.Gst.Enums.Format'
    -> Int64
    -- ^ /@destValue@/: the destination value
    -> m ()
querySetConvert :: Query -> Format -> Int64 -> Format -> Int64 -> m ()
querySetConvert Query
query Format
srcFormat Int64
srcValue Format
destFormat Int64
destValue = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let srcFormat' :: CUInt
srcFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
srcFormat
    let destFormat' :: CUInt
destFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
destFormat
    Ptr Query -> CUInt -> Int64 -> CUInt -> Int64 -> IO ()
gst_query_set_convert Ptr Query
query' CUInt
srcFormat' Int64
srcValue CUInt
destFormat' Int64
destValue
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetConvertMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Gst.Enums.Format -> Int64 -> m ()), MonadIO m) => O.MethodInfo QuerySetConvertMethodInfo Query signature where
    overloadedMethod = querySetConvert

#endif

-- method Query::set_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat for the duration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the duration of the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_duration" gst_query_set_duration :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- duration : TBasicType TInt64
    IO ()

-- | Answer a duration query by setting the requested value in the given format.
querySetDuration ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' for the duration
    -> Int64
    -- ^ /@duration@/: the duration of the stream
    -> m ()
querySetDuration :: Query -> Format -> Int64 -> m ()
querySetDuration Query
query Format
format Int64
duration = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query -> CUInt -> Int64 -> IO ()
gst_query_set_duration Ptr Query
query' CUInt
format' Int64
duration
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetDurationMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> m ()), MonadIO m) => O.MethodInfo QuerySetDurationMethodInfo Query signature where
    overloadedMethod = querySetDuration

#endif

-- method Query::set_formatsv
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_formats"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of formats to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "formats"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "Gst" , name = "Format" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an array containing @n_formats\n    @GstFormat values."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_formats"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of formats to set."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_formatsv" gst_query_set_formatsv :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Int32 ->                                -- n_formats : TBasicType TInt
    Ptr CUInt ->                            -- formats : TCArray False (-1) 1 (TInterface (Name {namespace = "Gst", name = "Format"}))
    IO ()

-- | Set the formats query result fields in /@query@/. The number of formats passed
-- in the /@formats@/ array must be equal to /@nFormats@/.
querySetFormatsv ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> [Gst.Enums.Format]
    -- ^ /@formats@/: an array containing /@nFormats@/
    --     /@gstFormat@/ values.
    -> m ()
querySetFormatsv :: Query -> [Format] -> m ()
querySetFormatsv Query
query [Format]
formats = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nFormats :: Int32
nFormats = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Format] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Format]
formats
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let formats' :: [CUInt]
formats' = (Format -> CUInt) -> [Format] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) [Format]
formats
    Ptr CUInt
formats'' <- [CUInt] -> IO (Ptr CUInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CUInt]
formats'
    Ptr Query -> Int32 -> Ptr CUInt -> IO ()
gst_query_set_formatsv Ptr Query
query' Int32
nFormats Ptr CUInt
formats''
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
formats''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetFormatsvMethodInfo
instance (signature ~ ([Gst.Enums.Format] -> m ()), MonadIO m) => O.MethodInfo QuerySetFormatsvMethodInfo Query signature where
    overloadedMethod = querySetFormatsv

#endif

-- method Query::set_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "live"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if there is a live element upstream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minimal latency of the upstream elements"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the maximal latency of the upstream elements"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_latency" gst_query_set_latency :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CInt ->                                 -- live : TBasicType TBoolean
    Word64 ->                               -- min_latency : TBasicType TUInt64
    Word64 ->                               -- max_latency : TBasicType TUInt64
    IO ()

-- | Answer a latency query by setting the requested values in the given format.
querySetLatency ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Bool
    -- ^ /@live@/: if there is a live element upstream
    -> Word64
    -- ^ /@minLatency@/: the minimal latency of the upstream elements
    -> Word64
    -- ^ /@maxLatency@/: the maximal latency of the upstream elements
    -> m ()
querySetLatency :: Query -> Bool -> CGType -> CGType -> m ()
querySetLatency Query
query Bool
live CGType
minLatency CGType
maxLatency = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let live' :: CInt
live' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
live
    Ptr Query -> CInt -> CGType -> CGType -> IO ()
gst_query_set_latency Ptr Query
query' CInt
live' CGType
minLatency CGType
maxLatency
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetLatencyMethodInfo
instance (signature ~ (Bool -> Word64 -> Word64 -> m ()), MonadIO m) => O.MethodInfo QuerySetLatencyMethodInfo Query signature where
    overloadedMethod = querySetLatency

#endif

-- method Query::set_nth_allocation_param
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_QUERY_ALLOCATION type query #GstQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position in the allocator array to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Allocator" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new allocator to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "AllocationParams" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "parameters for the allocator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_nth_allocation_param" gst_query_set_nth_allocation_param :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Gst.Allocator.Allocator ->          -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

-- | Parse an available query and get the allocator and its params
-- at /@index@/ of the allocator array.
querySetNthAllocationParam ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Allocator.IsAllocator a) =>
    Query
    -- ^ /@query@/: a GST_QUERY_ALLOCATION type query t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@index@/: position in the allocator array to set
    -> Maybe (a)
    -- ^ /@allocator@/: new allocator to set
    -> Maybe (Gst.AllocationParams.AllocationParams)
    -- ^ /@params@/: parameters for the allocator
    -> m ()
querySetNthAllocationParam :: Query -> Word32 -> Maybe a -> Maybe AllocationParams -> m ()
querySetNthAllocationParam Query
query Word32
index Maybe a
allocator Maybe AllocationParams
params = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Allocator
maybeAllocator <- case Maybe a
allocator of
        Maybe a
Nothing -> Ptr Allocator -> IO (Ptr Allocator)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Allocator
forall a. Ptr a
nullPtr
        Just a
jAllocator -> do
            Ptr Allocator
jAllocator' <- a -> IO (Ptr Allocator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAllocator
            Ptr Allocator -> IO (Ptr Allocator)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Allocator
jAllocator'
    Ptr AllocationParams
maybeParams <- case Maybe AllocationParams
params of
        Maybe AllocationParams
Nothing -> Ptr AllocationParams -> IO (Ptr AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AllocationParams
forall a. Ptr a
nullPtr
        Just AllocationParams
jParams -> do
            Ptr AllocationParams
jParams' <- AllocationParams -> IO (Ptr AllocationParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AllocationParams
jParams
            Ptr AllocationParams -> IO (Ptr AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AllocationParams
jParams'
    Ptr Query
-> Word32 -> Ptr Allocator -> Ptr AllocationParams -> IO ()
gst_query_set_nth_allocation_param Ptr Query
query' Word32
index Ptr Allocator
maybeAllocator Ptr AllocationParams
maybeParams
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
allocator a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe AllocationParams -> (AllocationParams -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe AllocationParams
params AllocationParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetNthAllocationParamMethodInfo
instance (signature ~ (Word32 -> Maybe (a) -> Maybe (Gst.AllocationParams.AllocationParams) -> m ()), MonadIO m, Gst.Allocator.IsAllocator a) => O.MethodInfo QuerySetNthAllocationParamMethodInfo Query signature where
    overloadedMethod = querySetNthAllocationParam

#endif

-- method Query::set_nth_allocation_pool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_ALLOCATION."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index to modify" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the min buffers" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the max buffers" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_nth_allocation_pool" gst_query_set_nth_allocation_pool :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Gst.BufferPool.BufferPool ->        -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    Word32 ->                               -- size : TBasicType TUInt
    Word32 ->                               -- min_buffers : TBasicType TUInt
    Word32 ->                               -- max_buffers : TBasicType TUInt
    IO ()

-- | Set the pool parameters in /@query@/.
querySetNthAllocationPool ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.BufferPool.IsBufferPool a) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_ALLOCATION.
    -> Word32
    -- ^ /@index@/: index to modify
    -> Maybe (a)
    -- ^ /@pool@/: the t'GI.Gst.Objects.BufferPool.BufferPool'
    -> Word32
    -- ^ /@size@/: the buffer size
    -> Word32
    -- ^ /@minBuffers@/: the min buffers
    -> Word32
    -- ^ /@maxBuffers@/: the max buffers
    -> m ()
querySetNthAllocationPool :: Query -> Word32 -> Maybe a -> Word32 -> Word32 -> Word32 -> m ()
querySetNthAllocationPool Query
query Word32
index Maybe a
pool Word32
size Word32
minBuffers Word32
maxBuffers = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr BufferPool
maybePool <- case Maybe a
pool of
        Maybe a
Nothing -> Ptr BufferPool -> IO (Ptr BufferPool)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr BufferPool
forall a. Ptr a
nullPtr
        Just a
jPool -> do
            Ptr BufferPool
jPool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jPool
            Ptr BufferPool -> IO (Ptr BufferPool)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr BufferPool
jPool'
    Ptr Query
-> Word32 -> Ptr BufferPool -> Word32 -> Word32 -> Word32 -> IO ()
gst_query_set_nth_allocation_pool Ptr Query
query' Word32
index Ptr BufferPool
maybePool Word32
size Word32
minBuffers Word32
maxBuffers
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
pool a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetNthAllocationPoolMethodInfo
instance (signature ~ (Word32 -> Maybe (a) -> Word32 -> Word32 -> Word32 -> m ()), MonadIO m, Gst.BufferPool.IsBufferPool a) => O.MethodInfo QuerySetNthAllocationPoolMethodInfo Query signature where
    overloadedMethod = querySetNthAllocationPool

#endif

-- method Query::set_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstQuery with query type GST_QUERY_POSITION"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested #GstFormat"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cur"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_position" gst_query_set_position :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- cur : TBasicType TInt64
    IO ()

-- | Answer a position query by setting the requested value in the given format.
querySetPosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query' with query type GST_QUERY_POSITION
    -> Gst.Enums.Format
    -- ^ /@format@/: the requested t'GI.Gst.Enums.Format'
    -> Int64
    -- ^ /@cur@/: the position to set
    -> m ()
querySetPosition :: Query -> Format -> Int64 -> m ()
querySetPosition Query
query Format
format Int64
cur = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query -> CUInt -> Int64 -> IO ()
gst_query_set_position Ptr Query
query' CUInt
format' Int64
cur
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetPositionMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> m ()), MonadIO m) => O.MethodInfo QuerySetPositionMethodInfo Query signature where
    overloadedMethod = querySetPosition

#endif

-- method Query::set_scheduling
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstQuery of type GST_QUERY_SCHEDULING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SchedulingFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstSchedulingFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minsize"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the suggested minimum size of pull requests"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "maxsize"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the suggested maximum size of pull requests"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "align"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the suggested alignment of pull requests"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_scheduling" gst_query_set_scheduling :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "SchedulingFlags"})
    Int32 ->                                -- minsize : TBasicType TInt
    Int32 ->                                -- maxsize : TBasicType TInt
    Int32 ->                                -- align : TBasicType TInt
    IO ()

-- | Set the scheduling properties.
querySetScheduling ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: A valid t'GI.Gst.Structs.Query.Query' of type GST_QUERY_SCHEDULING.
    -> [Gst.Flags.SchedulingFlags]
    -- ^ /@flags@/: t'GI.Gst.Flags.SchedulingFlags'
    -> Int32
    -- ^ /@minsize@/: the suggested minimum size of pull requests
    -> Int32
    -- ^ /@maxsize@/: the suggested maximum size of pull requests
    -> Int32
    -- ^ /@align@/: the suggested alignment of pull requests
    -> m ()
querySetScheduling :: Query -> [SchedulingFlags] -> Int32 -> Int32 -> Int32 -> m ()
querySetScheduling Query
query [SchedulingFlags]
flags Int32
minsize Int32
maxsize Int32
align = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let flags' :: CUInt
flags' = [SchedulingFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SchedulingFlags]
flags
    Ptr Query -> CUInt -> Int32 -> Int32 -> Int32 -> IO ()
gst_query_set_scheduling Ptr Query
query' CUInt
flags' Int32
minsize Int32
maxsize Int32
align
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetSchedulingMethodInfo
instance (signature ~ ([Gst.Flags.SchedulingFlags] -> Int32 -> Int32 -> Int32 -> m ()), MonadIO m) => O.MethodInfo QuerySetSchedulingMethodInfo Query signature where
    overloadedMethod = querySetScheduling

#endif

-- method Query::set_seeking
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the format to set for the @segment_start and @segment_end values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "seekable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seekable flag to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "segment_start"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the segment_start to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "segment_end"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the segment_end to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_seeking" gst_query_set_seeking :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    CInt ->                                 -- seekable : TBasicType TBoolean
    Int64 ->                                -- segment_start : TBasicType TInt64
    Int64 ->                                -- segment_end : TBasicType TInt64
    IO ()

-- | Set the seeking query result fields in /@query@/.
querySetSeeking ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Gst.Enums.Format
    -- ^ /@format@/: the format to set for the /@segmentStart@/ and /@segmentEnd@/ values
    -> Bool
    -- ^ /@seekable@/: the seekable flag to set
    -> Int64
    -- ^ /@segmentStart@/: the segment_start to set
    -> Int64
    -- ^ /@segmentEnd@/: the segment_end to set
    -> m ()
querySetSeeking :: Query -> Format -> Bool -> Int64 -> Int64 -> m ()
querySetSeeking Query
query Format
format Bool
seekable Int64
segmentStart Int64
segmentEnd = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    let seekable' :: CInt
seekable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
seekable
    Ptr Query -> CUInt -> CInt -> Int64 -> Int64 -> IO ()
gst_query_set_seeking Ptr Query
query' CUInt
format' CInt
seekable' Int64
segmentStart Int64
segmentEnd
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetSeekingMethodInfo
instance (signature ~ (Gst.Enums.Format -> Bool -> Int64 -> Int64 -> m ()), MonadIO m) => O.MethodInfo QuerySetSeekingMethodInfo Query signature where
    overloadedMethod = querySetSeeking

#endif

-- method Query::set_segment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rate of the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GstFormat of the segment values (@start_value and @stop_value)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stop value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_segment" gst_query_set_segment :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CDouble ->                              -- rate : TBasicType TDouble
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- start_value : TBasicType TInt64
    Int64 ->                                -- stop_value : TBasicType TInt64
    IO ()

-- | Answer a segment query by setting the requested values. The normal
-- playback segment of a pipeline is 0 to duration at the default rate of
-- 1.0. If a seek was performed on the pipeline to play a different
-- segment, this query will return the range specified in the last seek.
-- 
-- /@startValue@/ and /@stopValue@/ will respectively contain the configured
-- playback range start and stop values expressed in /@format@/.
-- The values are always between 0 and the duration of the media and
-- /@startValue@/ \<= /@stopValue@/. /@rate@/ will contain the playback rate. For
-- negative rates, playback will actually happen from /@stopValue@/ to
-- /@startValue@/.
querySetSegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Double
    -- ^ /@rate@/: the rate of the segment
    -> Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' of the segment values (/@startValue@/ and /@stopValue@/)
    -> Int64
    -- ^ /@startValue@/: the start value
    -> Int64
    -- ^ /@stopValue@/: the stop value
    -> m ()
querySetSegment :: Query -> Double -> Format -> Int64 -> Int64 -> m ()
querySetSegment Query
query Double
rate Format
format Int64
startValue Int64
stopValue = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let rate' :: CDouble
rate' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rate
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Query -> CDouble -> CUInt -> Int64 -> Int64 -> IO ()
gst_query_set_segment Ptr Query
query' CDouble
rate' CUInt
format' Int64
startValue Int64
stopValue
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetSegmentMethodInfo
instance (signature ~ (Double -> Gst.Enums.Format -> Int64 -> Int64 -> m ()), MonadIO m) => O.MethodInfo QuerySetSegmentMethodInfo Query signature where
    overloadedMethod = querySetSegment

#endif

-- method Query::set_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery with query type GST_QUERY_URI"
--                 , 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 to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Answer a URI query by setting the requested URI.
querySetUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query' with query type GST_QUERY_URI
    -> T.Text
    -- ^ /@uri@/: the URI to set
    -> m ()
querySetUri :: Query -> Text -> m ()
querySetUri Query
query Text
uri = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr Query -> CString -> IO ()
gst_query_set_uri Ptr Query
query' CString
uri'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetUriMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo QuerySetUriMethodInfo Query signature where
    overloadedMethod = querySetUri

#endif

-- method Query::set_uri_redirection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery with query type GST_QUERY_URI"
--                 , 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 to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Answer a URI query by setting the requested URI redirection.
-- 
-- /Since: 1.2/
querySetUriRedirection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query' with query type GST_QUERY_URI
    -> T.Text
    -- ^ /@uri@/: the URI to set
    -> m ()
querySetUriRedirection :: Query -> Text -> m ()
querySetUriRedirection Query
query Text
uri = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr Query -> CString -> IO ()
gst_query_set_uri_redirection Ptr Query
query' CString
uri'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetUriRedirectionMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo QuerySetUriRedirectionMethodInfo Query signature where
    overloadedMethod = querySetUriRedirection

#endif

-- method Query::set_uri_redirection_permanent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery with query type %GST_QUERY_URI"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "permanent"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the redirect is permanent or not"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_query_set_uri_redirection_permanent" gst_query_set_uri_redirection_permanent :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CInt ->                                 -- permanent : TBasicType TBoolean
    IO ()

-- | Answer a URI query by setting the requested URI redirection
-- to permanent or not.
-- 
-- /Since: 1.4/
querySetUriRedirectionPermanent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query' with query type 'GI.Gst.Enums.QueryTypeUri'
    -> Bool
    -- ^ /@permanent@/: whether the redirect is permanent or not
    -> m ()
querySetUriRedirectionPermanent :: Query -> Bool -> m ()
querySetUriRedirectionPermanent Query
query Bool
permanent = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let permanent' :: CInt
permanent' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
permanent
    Ptr Query -> CInt -> IO ()
gst_query_set_uri_redirection_permanent Ptr Query
query' CInt
permanent'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data QuerySetUriRedirectionPermanentMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo QuerySetUriRedirectionPermanentMethodInfo Query signature where
    overloadedMethod = querySetUriRedirectionPermanent

#endif

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

foreign import ccall "gst_query_writable_structure" gst_query_writable_structure :: 
    Ptr Query ->                            -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO (Ptr Gst.Structure.Structure)

-- | Get the structure of a query. This method should be called with a writable
-- /@query@/ so that the returned structure is guaranteed to be writable.
queryWritableStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m Gst.Structure.Structure
    -- ^ __Returns:__ the t'GI.Gst.Structs.Structure.Structure' of the query. The structure is
    --     still owned by the query and will therefore be freed when the query
    --     is unreffed.
queryWritableStructure :: Query -> m Structure
queryWritableStructure Query
query = IO Structure -> m Structure
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Structure
result <- Ptr Query -> IO (Ptr Structure)
gst_query_writable_structure Ptr Query
query'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"queryWritableStructure" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data QueryWritableStructureMethodInfo
instance (signature ~ (m Gst.Structure.Structure), MonadIO m) => O.MethodInfo QueryWritableStructureMethodInfo Query signature where
    overloadedMethod = queryWritableStructure

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveQueryMethod (t :: Symbol) (o :: *) :: * where
    ResolveQueryMethod "addAllocationMeta" o = QueryAddAllocationMetaMethodInfo
    ResolveQueryMethod "addAllocationParam" o = QueryAddAllocationParamMethodInfo
    ResolveQueryMethod "addAllocationPool" o = QueryAddAllocationPoolMethodInfo
    ResolveQueryMethod "addBufferingRange" o = QueryAddBufferingRangeMethodInfo
    ResolveQueryMethod "addSchedulingMode" o = QueryAddSchedulingModeMethodInfo
    ResolveQueryMethod "findAllocationMeta" o = QueryFindAllocationMetaMethodInfo
    ResolveQueryMethod "hasSchedulingMode" o = QueryHasSchedulingModeMethodInfo
    ResolveQueryMethod "hasSchedulingModeWithFlags" o = QueryHasSchedulingModeWithFlagsMethodInfo
    ResolveQueryMethod "parseAcceptCaps" o = QueryParseAcceptCapsMethodInfo
    ResolveQueryMethod "parseAcceptCapsResult" o = QueryParseAcceptCapsResultMethodInfo
    ResolveQueryMethod "parseAllocation" o = QueryParseAllocationMethodInfo
    ResolveQueryMethod "parseBitrate" o = QueryParseBitrateMethodInfo
    ResolveQueryMethod "parseBufferingPercent" o = QueryParseBufferingPercentMethodInfo
    ResolveQueryMethod "parseBufferingRange" o = QueryParseBufferingRangeMethodInfo
    ResolveQueryMethod "parseBufferingStats" o = QueryParseBufferingStatsMethodInfo
    ResolveQueryMethod "parseCaps" o = QueryParseCapsMethodInfo
    ResolveQueryMethod "parseCapsResult" o = QueryParseCapsResultMethodInfo
    ResolveQueryMethod "parseContext" o = QueryParseContextMethodInfo
    ResolveQueryMethod "parseContextType" o = QueryParseContextTypeMethodInfo
    ResolveQueryMethod "parseConvert" o = QueryParseConvertMethodInfo
    ResolveQueryMethod "parseDuration" o = QueryParseDurationMethodInfo
    ResolveQueryMethod "parseLatency" o = QueryParseLatencyMethodInfo
    ResolveQueryMethod "parseNFormats" o = QueryParseNFormatsMethodInfo
    ResolveQueryMethod "parseNthAllocationMeta" o = QueryParseNthAllocationMetaMethodInfo
    ResolveQueryMethod "parseNthAllocationParam" o = QueryParseNthAllocationParamMethodInfo
    ResolveQueryMethod "parseNthAllocationPool" o = QueryParseNthAllocationPoolMethodInfo
    ResolveQueryMethod "parseNthBufferingRange" o = QueryParseNthBufferingRangeMethodInfo
    ResolveQueryMethod "parseNthFormat" o = QueryParseNthFormatMethodInfo
    ResolveQueryMethod "parseNthSchedulingMode" o = QueryParseNthSchedulingModeMethodInfo
    ResolveQueryMethod "parsePosition" o = QueryParsePositionMethodInfo
    ResolveQueryMethod "parseScheduling" o = QueryParseSchedulingMethodInfo
    ResolveQueryMethod "parseSeeking" o = QueryParseSeekingMethodInfo
    ResolveQueryMethod "parseSegment" o = QueryParseSegmentMethodInfo
    ResolveQueryMethod "parseUri" o = QueryParseUriMethodInfo
    ResolveQueryMethod "parseUriRedirection" o = QueryParseUriRedirectionMethodInfo
    ResolveQueryMethod "parseUriRedirectionPermanent" o = QueryParseUriRedirectionPermanentMethodInfo
    ResolveQueryMethod "removeNthAllocationMeta" o = QueryRemoveNthAllocationMetaMethodInfo
    ResolveQueryMethod "removeNthAllocationParam" o = QueryRemoveNthAllocationParamMethodInfo
    ResolveQueryMethod "removeNthAllocationPool" o = QueryRemoveNthAllocationPoolMethodInfo
    ResolveQueryMethod "writableStructure" o = QueryWritableStructureMethodInfo
    ResolveQueryMethod "getNAllocationMetas" o = QueryGetNAllocationMetasMethodInfo
    ResolveQueryMethod "getNAllocationParams" o = QueryGetNAllocationParamsMethodInfo
    ResolveQueryMethod "getNAllocationPools" o = QueryGetNAllocationPoolsMethodInfo
    ResolveQueryMethod "getNBufferingRanges" o = QueryGetNBufferingRangesMethodInfo
    ResolveQueryMethod "getNSchedulingModes" o = QueryGetNSchedulingModesMethodInfo
    ResolveQueryMethod "getStructure" o = QueryGetStructureMethodInfo
    ResolveQueryMethod "setAcceptCapsResult" o = QuerySetAcceptCapsResultMethodInfo
    ResolveQueryMethod "setBitrate" o = QuerySetBitrateMethodInfo
    ResolveQueryMethod "setBufferingPercent" o = QuerySetBufferingPercentMethodInfo
    ResolveQueryMethod "setBufferingRange" o = QuerySetBufferingRangeMethodInfo
    ResolveQueryMethod "setBufferingStats" o = QuerySetBufferingStatsMethodInfo
    ResolveQueryMethod "setCapsResult" o = QuerySetCapsResultMethodInfo
    ResolveQueryMethod "setContext" o = QuerySetContextMethodInfo
    ResolveQueryMethod "setConvert" o = QuerySetConvertMethodInfo
    ResolveQueryMethod "setDuration" o = QuerySetDurationMethodInfo
    ResolveQueryMethod "setFormatsv" o = QuerySetFormatsvMethodInfo
    ResolveQueryMethod "setLatency" o = QuerySetLatencyMethodInfo
    ResolveQueryMethod "setNthAllocationParam" o = QuerySetNthAllocationParamMethodInfo
    ResolveQueryMethod "setNthAllocationPool" o = QuerySetNthAllocationPoolMethodInfo
    ResolveQueryMethod "setPosition" o = QuerySetPositionMethodInfo
    ResolveQueryMethod "setScheduling" o = QuerySetSchedulingMethodInfo
    ResolveQueryMethod "setSeeking" o = QuerySetSeekingMethodInfo
    ResolveQueryMethod "setSegment" o = QuerySetSegmentMethodInfo
    ResolveQueryMethod "setUri" o = QuerySetUriMethodInfo
    ResolveQueryMethod "setUriRedirection" o = QuerySetUriRedirectionMethodInfo
    ResolveQueryMethod "setUriRedirectionPermanent" o = QuerySetUriRedirectionPermanentMethodInfo
    ResolveQueryMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveQueryMethod t Query, O.MethodInfo info Query p) => OL.IsLabel t (Query -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif