{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This interface is implemented by elements that provide a stream volume. Examples for
-- such elements are @/volume/@ and @/playbin/@.
-- 
-- Applications can use this interface to get or set the current stream volume. For this
-- the \"volume\" t'GI.GObject.Objects.Object.Object' property can be used or the helper functions 'GI.GstAudio.Interfaces.StreamVolume.streamVolumeSetVolume'
-- and 'GI.GstAudio.Interfaces.StreamVolume.streamVolumeGetVolume'. This volume is always a linear factor, i.e. 0.0 is muted
-- 1.0 is 100%. For showing the volume in a GUI it might make sense to convert it to
-- a different format by using 'GI.GstAudio.Functions.streamVolumeConvertVolume'. Volume sliders should usually
-- use a cubic volume.
-- 
-- Separate from the volume the stream can also be muted by the \"mute\" t'GI.GObject.Objects.Object.Object' property or
-- 'GI.GstAudio.Interfaces.StreamVolume.streamVolumeSetMute' and 'GI.GstAudio.Interfaces.StreamVolume.streamVolumeGetMute'.
-- 
-- Elements that provide some kind of stream volume should implement the \"volume\" and
-- \"mute\" t'GI.GObject.Objects.Object.Object' properties and handle setting and getting of them properly.
-- The volume property is defined to be a linear volume factor.

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

module GI.GstAudio.Interfaces.StreamVolume
    ( 

-- * Exported types
    StreamVolume(..)                        ,
    IsStreamVolume                          ,
    toStreamVolume                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getMute]("GI.GstAudio.Interfaces.StreamVolume#g:method:getMute"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getVolume]("GI.GstAudio.Interfaces.StreamVolume#g:method:getVolume").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setMute]("GI.GstAudio.Interfaces.StreamVolume#g:method:setMute"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setVolume]("GI.GstAudio.Interfaces.StreamVolume#g:method:setVolume").

#if defined(ENABLE_OVERLOADING)
    ResolveStreamVolumeMethod               ,
#endif

-- ** convertVolume #method:convertVolume#

    streamVolumeConvertVolume               ,


-- ** getMute #method:getMute#

#if defined(ENABLE_OVERLOADING)
    StreamVolumeGetMuteMethodInfo           ,
#endif
    streamVolumeGetMute                     ,


-- ** getVolume #method:getVolume#

#if defined(ENABLE_OVERLOADING)
    StreamVolumeGetVolumeMethodInfo         ,
#endif
    streamVolumeGetVolume                   ,


-- ** setMute #method:setMute#

#if defined(ENABLE_OVERLOADING)
    StreamVolumeSetMuteMethodInfo           ,
#endif
    streamVolumeSetMute                     ,


-- ** setVolume #method:setVolume#

#if defined(ENABLE_OVERLOADING)
    StreamVolumeSetVolumeMethodInfo         ,
#endif
    streamVolumeSetVolume                   ,




 -- * Properties


-- ** mute #attr:mute#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    StreamVolumeMutePropertyInfo            ,
#endif
    constructStreamVolumeMute               ,
    getStreamVolumeMute                     ,
    setStreamVolumeMute                     ,
#if defined(ENABLE_OVERLOADING)
    streamVolumeMute                        ,
#endif


-- ** volume #attr:volume#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    StreamVolumeVolumePropertyInfo          ,
#endif
    constructStreamVolumeVolume             ,
    getStreamVolumeVolume                   ,
    setStreamVolumeVolume                   ,
#if defined(ENABLE_OVERLOADING)
    streamVolumeVolume                      ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
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.Coerce as Coerce
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 qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.GstAudio.Enums as GstAudio.Enums

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

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

foreign import ccall "gst_stream_volume_get_type"
    c_gst_stream_volume_get_type :: IO B.Types.GType

instance B.Types.TypedObject StreamVolume where
    glibType :: IO GType
glibType = IO GType
c_gst_stream_volume_get_type

instance B.Types.GObject StreamVolume

-- | Type class for types which can be safely cast to `StreamVolume`, for instance with `toStreamVolume`.
class (SP.GObject o, O.IsDescendantOf StreamVolume o) => IsStreamVolume o
instance (SP.GObject o, O.IsDescendantOf StreamVolume o) => IsStreamVolume o

instance O.HasParentTypes StreamVolume
type instance O.ParentTypes StreamVolume = '[GObject.Object.Object]

-- | Cast to `StreamVolume`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toStreamVolume :: (MIO.MonadIO m, IsStreamVolume o) => o -> m StreamVolume
toStreamVolume :: forall (m :: * -> *) o.
(MonadIO m, IsStreamVolume o) =>
o -> m StreamVolume
toStreamVolume = IO StreamVolume -> m StreamVolume
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO StreamVolume -> m StreamVolume)
-> (o -> IO StreamVolume) -> o -> m StreamVolume
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr StreamVolume -> StreamVolume) -> o -> IO StreamVolume
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr StreamVolume -> StreamVolume
StreamVolume

-- | Convert 'StreamVolume' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe StreamVolume) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_stream_volume_get_type
    gvalueSet_ :: Ptr GValue -> Maybe StreamVolume -> IO ()
gvalueSet_ Ptr GValue
gv Maybe StreamVolume
P.Nothing = Ptr GValue -> Ptr StreamVolume -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr StreamVolume
forall a. Ptr a
FP.nullPtr :: FP.Ptr StreamVolume)
    gvalueSet_ Ptr GValue
gv (P.Just StreamVolume
obj) = StreamVolume -> (Ptr StreamVolume -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr StreamVolume
obj (Ptr GValue -> Ptr StreamVolume -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe StreamVolume)
gvalueGet_ Ptr GValue
gv = do
        Ptr StreamVolume
ptr <- Ptr GValue -> IO (Ptr StreamVolume)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr StreamVolume)
        if Ptr StreamVolume
ptr Ptr StreamVolume -> Ptr StreamVolume -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr StreamVolume
forall a. Ptr a
FP.nullPtr
        then StreamVolume -> Maybe StreamVolume
forall a. a -> Maybe a
P.Just (StreamVolume -> Maybe StreamVolume)
-> IO StreamVolume -> IO (Maybe StreamVolume)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr StreamVolume -> StreamVolume)
-> Ptr StreamVolume -> IO StreamVolume
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr StreamVolume -> StreamVolume
StreamVolume Ptr StreamVolume
ptr
        else Maybe StreamVolume -> IO (Maybe StreamVolume)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StreamVolume
forall a. Maybe a
P.Nothing
        
    

-- VVV Prop "mute"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@mute@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' streamVolume #mute
-- @
getStreamVolumeMute :: (MonadIO m, IsStreamVolume o) => o -> m Bool
getStreamVolumeMute :: forall (m :: * -> *) o.
(MonadIO m, IsStreamVolume o) =>
o -> m Bool
getStreamVolumeMute o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"mute"

-- | Set the value of the “@mute@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' streamVolume [ #mute 'Data.GI.Base.Attributes.:=' value ]
-- @
setStreamVolumeMute :: (MonadIO m, IsStreamVolume o) => o -> Bool -> m ()
setStreamVolumeMute :: forall (m :: * -> *) o.
(MonadIO m, IsStreamVolume o) =>
o -> Bool -> m ()
setStreamVolumeMute o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"mute" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@mute@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStreamVolumeMute :: (IsStreamVolume o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructStreamVolumeMute :: forall o (m :: * -> *).
(IsStreamVolume o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructStreamVolumeMute Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"mute" Bool
val

#if defined(ENABLE_OVERLOADING)
data StreamVolumeMutePropertyInfo
instance AttrInfo StreamVolumeMutePropertyInfo where
    type AttrAllowedOps StreamVolumeMutePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StreamVolumeMutePropertyInfo = IsStreamVolume
    type AttrSetTypeConstraint StreamVolumeMutePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StreamVolumeMutePropertyInfo = (~) Bool
    type AttrTransferType StreamVolumeMutePropertyInfo = Bool
    type AttrGetType StreamVolumeMutePropertyInfo = Bool
    type AttrLabel StreamVolumeMutePropertyInfo = "mute"
    type AttrOrigin StreamVolumeMutePropertyInfo = StreamVolume
    attrGet = getStreamVolumeMute
    attrSet = setStreamVolumeMute
    attrTransfer _ v = do
        return v
    attrConstruct = constructStreamVolumeMute
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Interfaces.StreamVolume.mute"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Interfaces-StreamVolume.html#g:attr:mute"
        })
#endif

-- VVV Prop "volume"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@volume@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' streamVolume #volume
-- @
getStreamVolumeVolume :: (MonadIO m, IsStreamVolume o) => o -> m Double
getStreamVolumeVolume :: forall (m :: * -> *) o.
(MonadIO m, IsStreamVolume o) =>
o -> m Double
getStreamVolumeVolume o
obj = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"volume"

-- | Set the value of the “@volume@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' streamVolume [ #volume 'Data.GI.Base.Attributes.:=' value ]
-- @
setStreamVolumeVolume :: (MonadIO m, IsStreamVolume o) => o -> Double -> m ()
setStreamVolumeVolume :: forall (m :: * -> *) o.
(MonadIO m, IsStreamVolume o) =>
o -> Double -> m ()
setStreamVolumeVolume o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"volume" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@volume@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStreamVolumeVolume :: (IsStreamVolume o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructStreamVolumeVolume :: forall o (m :: * -> *).
(IsStreamVolume o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructStreamVolumeVolume Double
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"volume" Double
val

#if defined(ENABLE_OVERLOADING)
data StreamVolumeVolumePropertyInfo
instance AttrInfo StreamVolumeVolumePropertyInfo where
    type AttrAllowedOps StreamVolumeVolumePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StreamVolumeVolumePropertyInfo = IsStreamVolume
    type AttrSetTypeConstraint StreamVolumeVolumePropertyInfo = (~) Double
    type AttrTransferTypeConstraint StreamVolumeVolumePropertyInfo = (~) Double
    type AttrTransferType StreamVolumeVolumePropertyInfo = Double
    type AttrGetType StreamVolumeVolumePropertyInfo = Double
    type AttrLabel StreamVolumeVolumePropertyInfo = "volume"
    type AttrOrigin StreamVolumeVolumePropertyInfo = StreamVolume
    attrGet = getStreamVolumeVolume
    attrSet = setStreamVolumeVolume
    attrTransfer _ v = do
        return v
    attrConstruct = constructStreamVolumeVolume
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Interfaces.StreamVolume.volume"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Interfaces-StreamVolume.html#g:attr:volume"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList StreamVolume
type instance O.AttributeList StreamVolume = StreamVolumeAttributeList
type StreamVolumeAttributeList = ('[ '("mute", StreamVolumeMutePropertyInfo), '("volume", StreamVolumeVolumePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
streamVolumeMute :: AttrLabelProxy "mute"
streamVolumeMute = AttrLabelProxy

streamVolumeVolume :: AttrLabelProxy "volume"
streamVolumeVolume = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveStreamVolumeMethod (t :: Symbol) (o :: *) :: * where
    ResolveStreamVolumeMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveStreamVolumeMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveStreamVolumeMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveStreamVolumeMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveStreamVolumeMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveStreamVolumeMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveStreamVolumeMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveStreamVolumeMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveStreamVolumeMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveStreamVolumeMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveStreamVolumeMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveStreamVolumeMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveStreamVolumeMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveStreamVolumeMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveStreamVolumeMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveStreamVolumeMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveStreamVolumeMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveStreamVolumeMethod "getMute" o = StreamVolumeGetMuteMethodInfo
    ResolveStreamVolumeMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveStreamVolumeMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveStreamVolumeMethod "getVolume" o = StreamVolumeGetVolumeMethodInfo
    ResolveStreamVolumeMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveStreamVolumeMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveStreamVolumeMethod "setMute" o = StreamVolumeSetMuteMethodInfo
    ResolveStreamVolumeMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveStreamVolumeMethod "setVolume" o = StreamVolumeSetVolumeMethodInfo
    ResolveStreamVolumeMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveStreamVolumeMethod t StreamVolume, O.OverloadedMethod info StreamVolume p, R.HasField t StreamVolume p) => R.HasField t StreamVolume p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveStreamVolumeMethod t StreamVolume, O.OverloadedMethodInfo info StreamVolume) => OL.IsLabel t (O.MethodProxy info StreamVolume) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- method StreamVolume::get_mute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "StreamVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstStreamVolume that should be used"
--                 , 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_stream_volume_get_mute" gst_stream_volume_get_mute :: 
    Ptr StreamVolume ->                     -- volume : TInterface (Name {namespace = "GstAudio", name = "StreamVolume"})
    IO CInt

-- | /No description available in the introspection data./
streamVolumeGetMute ::
    (B.CallStack.HasCallStack, MonadIO m, IsStreamVolume a) =>
    a
    -- ^ /@volume@/: t'GI.GstAudio.Interfaces.StreamVolume.StreamVolume' that should be used
    -> m Bool
    -- ^ __Returns:__ Returns 'P.True' if the stream is muted
streamVolumeGetMute :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStreamVolume a) =>
a -> m Bool
streamVolumeGetMute a
volume = 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 StreamVolume
volume' <- a -> IO (Ptr StreamVolume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    CInt
result <- Ptr StreamVolume -> IO CInt
gst_stream_volume_get_mute Ptr StreamVolume
volume'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StreamVolumeGetMuteMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStreamVolume a) => O.OverloadedMethod StreamVolumeGetMuteMethodInfo a signature where
    overloadedMethod = streamVolumeGetMute

instance O.OverloadedMethodInfo StreamVolumeGetMuteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Interfaces.StreamVolume.streamVolumeGetMute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Interfaces-StreamVolume.html#v:streamVolumeGetMute"
        })


#endif

-- method StreamVolume::get_volume
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "StreamVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstStreamVolume that should be used"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "StreamVolumeFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstStreamVolumeFormat which should be returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "gst_stream_volume_get_volume" gst_stream_volume_get_volume :: 
    Ptr StreamVolume ->                     -- volume : TInterface (Name {namespace = "GstAudio", name = "StreamVolume"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstAudio", name = "StreamVolumeFormat"})
    IO CDouble

-- | /No description available in the introspection data./
streamVolumeGetVolume ::
    (B.CallStack.HasCallStack, MonadIO m, IsStreamVolume a) =>
    a
    -- ^ /@volume@/: t'GI.GstAudio.Interfaces.StreamVolume.StreamVolume' that should be used
    -> GstAudio.Enums.StreamVolumeFormat
    -- ^ /@format@/: t'GI.GstAudio.Enums.StreamVolumeFormat' which should be returned
    -> m Double
    -- ^ __Returns:__ The current stream volume as linear factor
streamVolumeGetVolume :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStreamVolume a) =>
a -> StreamVolumeFormat -> m Double
streamVolumeGetVolume a
volume StreamVolumeFormat
format = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr StreamVolume
volume' <- a -> IO (Ptr StreamVolume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StreamVolumeFormat -> Int) -> StreamVolumeFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVolumeFormat -> Int
forall a. Enum a => a -> Int
fromEnum) StreamVolumeFormat
format
    CDouble
result <- Ptr StreamVolume -> CUInt -> IO CDouble
gst_stream_volume_get_volume Ptr StreamVolume
volume' CUInt
format'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data StreamVolumeGetVolumeMethodInfo
instance (signature ~ (GstAudio.Enums.StreamVolumeFormat -> m Double), MonadIO m, IsStreamVolume a) => O.OverloadedMethod StreamVolumeGetVolumeMethodInfo a signature where
    overloadedMethod = streamVolumeGetVolume

instance O.OverloadedMethodInfo StreamVolumeGetVolumeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Interfaces.StreamVolume.streamVolumeGetVolume",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Interfaces-StreamVolume.html#v:streamVolumeGetVolume"
        })


#endif

-- method StreamVolume::set_mute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "StreamVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstStreamVolume that should be used"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mute"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Mute state that should be 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_stream_volume_set_mute" gst_stream_volume_set_mute :: 
    Ptr StreamVolume ->                     -- volume : TInterface (Name {namespace = "GstAudio", name = "StreamVolume"})
    CInt ->                                 -- mute : TBasicType TBoolean
    IO ()

-- | /No description available in the introspection data./
streamVolumeSetMute ::
    (B.CallStack.HasCallStack, MonadIO m, IsStreamVolume a) =>
    a
    -- ^ /@volume@/: t'GI.GstAudio.Interfaces.StreamVolume.StreamVolume' that should be used
    -> Bool
    -- ^ /@mute@/: Mute state that should be set
    -> m ()
streamVolumeSetMute :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStreamVolume a) =>
a -> Bool -> m ()
streamVolumeSetMute a
volume Bool
mute = 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 StreamVolume
volume' <- a -> IO (Ptr StreamVolume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    let mute' :: CInt
mute' = (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
mute
    Ptr StreamVolume -> CInt -> IO ()
gst_stream_volume_set_mute Ptr StreamVolume
volume' CInt
mute'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StreamVolumeSetMuteMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsStreamVolume a) => O.OverloadedMethod StreamVolumeSetMuteMethodInfo a signature where
    overloadedMethod = streamVolumeSetMute

instance O.OverloadedMethodInfo StreamVolumeSetMuteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Interfaces.StreamVolume.streamVolumeSetMute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Interfaces-StreamVolume.html#v:streamVolumeSetMute"
        })


#endif

-- method StreamVolume::set_volume
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "StreamVolume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstStreamVolume that should be used"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "StreamVolumeFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstStreamVolumeFormat of @val"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Linear volume factor that should be 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_stream_volume_set_volume" gst_stream_volume_set_volume :: 
    Ptr StreamVolume ->                     -- volume : TInterface (Name {namespace = "GstAudio", name = "StreamVolume"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstAudio", name = "StreamVolumeFormat"})
    CDouble ->                              -- val : TBasicType TDouble
    IO ()

-- | /No description available in the introspection data./
streamVolumeSetVolume ::
    (B.CallStack.HasCallStack, MonadIO m, IsStreamVolume a) =>
    a
    -- ^ /@volume@/: t'GI.GstAudio.Interfaces.StreamVolume.StreamVolume' that should be used
    -> GstAudio.Enums.StreamVolumeFormat
    -- ^ /@format@/: t'GI.GstAudio.Enums.StreamVolumeFormat' of /@val@/
    -> Double
    -- ^ /@val@/: Linear volume factor that should be set
    -> m ()
streamVolumeSetVolume :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStreamVolume a) =>
a -> StreamVolumeFormat -> Double -> m ()
streamVolumeSetVolume a
volume StreamVolumeFormat
format Double
val = 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 StreamVolume
volume' <- a -> IO (Ptr StreamVolume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StreamVolumeFormat -> Int) -> StreamVolumeFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVolumeFormat -> Int
forall a. Enum a => a -> Int
fromEnum) StreamVolumeFormat
format
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr StreamVolume -> CUInt -> CDouble -> IO ()
gst_stream_volume_set_volume Ptr StreamVolume
volume' CUInt
format' CDouble
val'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StreamVolumeSetVolumeMethodInfo
instance (signature ~ (GstAudio.Enums.StreamVolumeFormat -> Double -> m ()), MonadIO m, IsStreamVolume a) => O.OverloadedMethod StreamVolumeSetVolumeMethodInfo a signature where
    overloadedMethod = streamVolumeSetVolume

instance O.OverloadedMethodInfo StreamVolumeSetVolumeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Interfaces.StreamVolume.streamVolumeSetVolume",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Interfaces-StreamVolume.html#v:streamVolumeSetVolume"
        })


#endif

-- method StreamVolume::convert_volume
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "from"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "StreamVolumeFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstStreamVolumeFormat to convert from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "StreamVolumeFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstStreamVolumeFormat to convert to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Volume in @from format that should be converted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "gst_stream_volume_convert_volume" gst_stream_volume_convert_volume :: 
    CUInt ->                                -- from : TInterface (Name {namespace = "GstAudio", name = "StreamVolumeFormat"})
    CUInt ->                                -- to : TInterface (Name {namespace = "GstAudio", name = "StreamVolumeFormat"})
    CDouble ->                              -- val : TBasicType TDouble
    IO CDouble

-- | /No description available in the introspection data./
streamVolumeConvertVolume ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstAudio.Enums.StreamVolumeFormat
    -- ^ /@from@/: t'GI.GstAudio.Enums.StreamVolumeFormat' to convert from
    -> GstAudio.Enums.StreamVolumeFormat
    -- ^ /@to@/: t'GI.GstAudio.Enums.StreamVolumeFormat' to convert to
    -> Double
    -- ^ /@val@/: Volume in /@from@/ format that should be converted
    -> m Double
    -- ^ __Returns:__ the converted volume
streamVolumeConvertVolume :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StreamVolumeFormat -> StreamVolumeFormat -> Double -> m Double
streamVolumeConvertVolume StreamVolumeFormat
from StreamVolumeFormat
to Double
val = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    let from' :: CUInt
from' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StreamVolumeFormat -> Int) -> StreamVolumeFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVolumeFormat -> Int
forall a. Enum a => a -> Int
fromEnum) StreamVolumeFormat
from
    let to' :: CUInt
to' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StreamVolumeFormat -> Int) -> StreamVolumeFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVolumeFormat -> Int
forall a. Enum a => a -> Int
fromEnum) StreamVolumeFormat
to
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    CDouble
result <- CUInt -> CUInt -> CDouble -> IO CDouble
gst_stream_volume_convert_volume CUInt
from' CUInt
to' CDouble
val'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList StreamVolume = StreamVolumeSignalList
type StreamVolumeSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif