{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GSourceFuncs@ struct contains a table of
-- functions used to handle event sources in a generic manner.
-- 
-- For idle sources, the prepare and check functions always return 'P.True'
-- to indicate that the source is always ready to be processed. The prepare
-- function also returns a timeout value of 0 to ensure that the @/poll()/@ call
-- doesn\'t block (since that would be time wasted which could have been spent
-- running the idle function).
-- 
-- For timeout sources, the prepare and check functions both return 'P.True'
-- if the timeout interval has expired. The prepare function also returns
-- a timeout value to ensure that the @/poll()/@ call doesn\'t block too long
-- and miss the next timeout.
-- 
-- For file descriptor sources, the prepare function typically returns 'P.False',
-- since it must wait until @/poll()/@ has been called before it knows whether
-- any events need to be processed. It sets the returned timeout to -1 to
-- indicate that it doesn\'t mind how long the @/poll()/@ call blocks. In the
-- check function, it tests the results of the @/poll()/@ call to see if the
-- required condition has been met, and returns 'P.True' if so.

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

module GI.GLib.Structs.SourceFuncs
    (

-- * Exported types
    SourceFuncs(..)                         ,
    newZeroSourceFuncs                      ,
    noSourceFuncs                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSourceFuncsMethod                ,
#endif




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

    clearSourceFuncsCheck                   ,
    getSourceFuncsCheck                     ,
    setSourceFuncsCheck                     ,
#if defined(ENABLE_OVERLOADING)
    sourceFuncs_check                       ,
#endif


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

    clearSourceFuncsFinalize                ,
    getSourceFuncsFinalize                  ,
    setSourceFuncsFinalize                  ,
#if defined(ENABLE_OVERLOADING)
    sourceFuncs_finalize                    ,
#endif


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

    clearSourceFuncsPrepare                 ,
    getSourceFuncsPrepare                   ,
    setSourceFuncsPrepare                   ,
#if defined(ENABLE_OVERLOADING)
    sourceFuncs_prepare                     ,
#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.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 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 GI.GLib.Callbacks as GLib.Callbacks

-- | Memory-managed wrapper type.
newtype SourceFuncs = SourceFuncs (ManagedPtr SourceFuncs)
    deriving (Eq)
instance WrappedPtr SourceFuncs where
    wrappedPtrCalloc = callocBytes 24
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 24 >=> wrapPtr SourceFuncs)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `SourceFuncs` struct initialized to zero.
newZeroSourceFuncs :: MonadIO m => m SourceFuncs
newZeroSourceFuncs = liftIO $ wrappedPtrCalloc >>= wrapPtr SourceFuncs

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


-- | A convenience alias for `Nothing` :: `Maybe` `SourceFuncs`.
noSourceFuncs :: Maybe SourceFuncs
noSourceFuncs = Nothing

-- | Get the value of the “@prepare@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sourceFuncs #prepare
-- @
getSourceFuncsPrepare :: MonadIO m => SourceFuncs -> m (Maybe GLib.Callbacks.SourceFuncsPrepareFieldCallback)
getSourceFuncsPrepare s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (FunPtr GLib.Callbacks.C_SourceFuncsPrepareFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_SourceFuncsPrepareFieldCallback val'
        return val''
    return result

-- | Set the value of the “@prepare@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sourceFuncs [ #prepare 'Data.GI.Base.Attributes.:=' value ]
-- @
setSourceFuncsPrepare :: MonadIO m => SourceFuncs -> FunPtr GLib.Callbacks.C_SourceFuncsPrepareFieldCallback -> m ()
setSourceFuncsPrepare s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: FunPtr GLib.Callbacks.C_SourceFuncsPrepareFieldCallback)

-- | Set the value of the “@prepare@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #prepare
-- @
clearSourceFuncsPrepare :: MonadIO m => SourceFuncs -> m ()
clearSourceFuncsPrepare s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_SourceFuncsPrepareFieldCallback)

#if defined(ENABLE_OVERLOADING)
data SourceFuncsPrepareFieldInfo
instance AttrInfo SourceFuncsPrepareFieldInfo where
    type AttrBaseTypeConstraint SourceFuncsPrepareFieldInfo = (~) SourceFuncs
    type AttrAllowedOps SourceFuncsPrepareFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SourceFuncsPrepareFieldInfo = (~) (FunPtr GLib.Callbacks.C_SourceFuncsPrepareFieldCallback)
    type AttrTransferTypeConstraint SourceFuncsPrepareFieldInfo = (~)GLib.Callbacks.SourceFuncsPrepareFieldCallback
    type AttrTransferType SourceFuncsPrepareFieldInfo = (FunPtr GLib.Callbacks.C_SourceFuncsPrepareFieldCallback)
    type AttrGetType SourceFuncsPrepareFieldInfo = Maybe GLib.Callbacks.SourceFuncsPrepareFieldCallback
    type AttrLabel SourceFuncsPrepareFieldInfo = "prepare"
    type AttrOrigin SourceFuncsPrepareFieldInfo = SourceFuncs
    attrGet = getSourceFuncsPrepare
    attrSet = setSourceFuncsPrepare
    attrConstruct = undefined
    attrClear = clearSourceFuncsPrepare
    attrTransfer _ v = do
        GLib.Callbacks.mk_SourceFuncsPrepareFieldCallback (GLib.Callbacks.wrap_SourceFuncsPrepareFieldCallback Nothing v)

sourceFuncs_prepare :: AttrLabelProxy "prepare"
sourceFuncs_prepare = AttrLabelProxy

#endif


-- | Get the value of the “@check@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sourceFuncs #check
-- @
getSourceFuncsCheck :: MonadIO m => SourceFuncs -> m (Maybe GLib.Callbacks.SourceFuncsCheckFieldCallback)
getSourceFuncsCheck s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 4) :: IO (FunPtr GLib.Callbacks.C_SourceFuncsCheckFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_SourceFuncsCheckFieldCallback val'
        return val''
    return result

-- | Set the value of the “@check@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sourceFuncs [ #check 'Data.GI.Base.Attributes.:=' value ]
-- @
setSourceFuncsCheck :: MonadIO m => SourceFuncs -> FunPtr GLib.Callbacks.C_SourceFuncsCheckFieldCallback -> m ()
setSourceFuncsCheck s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 4) (val :: FunPtr GLib.Callbacks.C_SourceFuncsCheckFieldCallback)

-- | Set the value of the “@check@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #check
-- @
clearSourceFuncsCheck :: MonadIO m => SourceFuncs -> m ()
clearSourceFuncsCheck s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 4) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_SourceFuncsCheckFieldCallback)

#if defined(ENABLE_OVERLOADING)
data SourceFuncsCheckFieldInfo
instance AttrInfo SourceFuncsCheckFieldInfo where
    type AttrBaseTypeConstraint SourceFuncsCheckFieldInfo = (~) SourceFuncs
    type AttrAllowedOps SourceFuncsCheckFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SourceFuncsCheckFieldInfo = (~) (FunPtr GLib.Callbacks.C_SourceFuncsCheckFieldCallback)
    type AttrTransferTypeConstraint SourceFuncsCheckFieldInfo = (~)GLib.Callbacks.SourceFuncsCheckFieldCallback
    type AttrTransferType SourceFuncsCheckFieldInfo = (FunPtr GLib.Callbacks.C_SourceFuncsCheckFieldCallback)
    type AttrGetType SourceFuncsCheckFieldInfo = Maybe GLib.Callbacks.SourceFuncsCheckFieldCallback
    type AttrLabel SourceFuncsCheckFieldInfo = "check"
    type AttrOrigin SourceFuncsCheckFieldInfo = SourceFuncs
    attrGet = getSourceFuncsCheck
    attrSet = setSourceFuncsCheck
    attrConstruct = undefined
    attrClear = clearSourceFuncsCheck
    attrTransfer _ v = do
        GLib.Callbacks.mk_SourceFuncsCheckFieldCallback (GLib.Callbacks.wrap_SourceFuncsCheckFieldCallback Nothing v)

sourceFuncs_check :: AttrLabelProxy "check"
sourceFuncs_check = AttrLabelProxy

#endif


-- | Get the value of the “@finalize@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sourceFuncs #finalize
-- @
getSourceFuncsFinalize :: MonadIO m => SourceFuncs -> m (Maybe GLib.Callbacks.SourceFuncsFinalizeFieldCallback)
getSourceFuncsFinalize s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 12) :: IO (FunPtr GLib.Callbacks.C_SourceFuncsFinalizeFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_SourceFuncsFinalizeFieldCallback val'
        return val''
    return result

-- | Set the value of the “@finalize@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' sourceFuncs [ #finalize 'Data.GI.Base.Attributes.:=' value ]
-- @
setSourceFuncsFinalize :: MonadIO m => SourceFuncs -> FunPtr GLib.Callbacks.C_SourceFuncsFinalizeFieldCallback -> m ()
setSourceFuncsFinalize s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 12) (val :: FunPtr GLib.Callbacks.C_SourceFuncsFinalizeFieldCallback)

-- | Set the value of the “@finalize@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #finalize
-- @
clearSourceFuncsFinalize :: MonadIO m => SourceFuncs -> m ()
clearSourceFuncsFinalize s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 12) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_SourceFuncsFinalizeFieldCallback)

#if defined(ENABLE_OVERLOADING)
data SourceFuncsFinalizeFieldInfo
instance AttrInfo SourceFuncsFinalizeFieldInfo where
    type AttrBaseTypeConstraint SourceFuncsFinalizeFieldInfo = (~) SourceFuncs
    type AttrAllowedOps SourceFuncsFinalizeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SourceFuncsFinalizeFieldInfo = (~) (FunPtr GLib.Callbacks.C_SourceFuncsFinalizeFieldCallback)
    type AttrTransferTypeConstraint SourceFuncsFinalizeFieldInfo = (~)GLib.Callbacks.SourceFuncsFinalizeFieldCallback
    type AttrTransferType SourceFuncsFinalizeFieldInfo = (FunPtr GLib.Callbacks.C_SourceFuncsFinalizeFieldCallback)
    type AttrGetType SourceFuncsFinalizeFieldInfo = Maybe GLib.Callbacks.SourceFuncsFinalizeFieldCallback
    type AttrLabel SourceFuncsFinalizeFieldInfo = "finalize"
    type AttrOrigin SourceFuncsFinalizeFieldInfo = SourceFuncs
    attrGet = getSourceFuncsFinalize
    attrSet = setSourceFuncsFinalize
    attrConstruct = undefined
    attrClear = clearSourceFuncsFinalize
    attrTransfer _ v = do
        GLib.Callbacks.mk_SourceFuncsFinalizeFieldCallback (GLib.Callbacks.wrap_SourceFuncsFinalizeFieldCallback Nothing v)

sourceFuncs_finalize :: AttrLabelProxy "finalize"
sourceFuncs_finalize = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SourceFuncs
type instance O.AttributeList SourceFuncs = SourceFuncsAttributeList
type SourceFuncsAttributeList = ('[ '("prepare", SourceFuncsPrepareFieldInfo), '("check", SourceFuncsCheckFieldInfo), '("finalize", SourceFuncsFinalizeFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSourceFuncsMethod (t :: Symbol) (o :: *) :: * where
    ResolveSourceFuncsMethod l o = O.MethodResolutionFailed l o

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

#endif