{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)
-}

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

module GI.Dbusmenu.Callbacks
    (

 -- * Signals
-- ** ClientTypeHandler #signal:ClientTypeHandler#

    C_ClientTypeHandler                     ,
    ClientTypeHandler                       ,
    ClientTypeHandler_WithClosures          ,
    drop_closures_ClientTypeHandler         ,
    dynamic_ClientTypeHandler               ,
    genClosure_ClientTypeHandler            ,
    mk_ClientTypeHandler                    ,
    noClientTypeHandler                     ,
    noClientTypeHandler_WithClosures        ,
    wrap_ClientTypeHandler                  ,


-- ** MenuitemAboutToShowCb #signal:MenuitemAboutToShowCb#

    C_MenuitemAboutToShowCb                 ,
    MenuitemAboutToShowCb                   ,
    MenuitemAboutToShowCb_WithClosures      ,
    drop_closures_MenuitemAboutToShowCb     ,
    dynamic_MenuitemAboutToShowCb           ,
    genClosure_MenuitemAboutToShowCb        ,
    mk_MenuitemAboutToShowCb                ,
    noMenuitemAboutToShowCb                 ,
    noMenuitemAboutToShowCb_WithClosures    ,
    wrap_MenuitemAboutToShowCb              ,


-- ** MenuitemBuildvariantSlotT #signal:MenuitemBuildvariantSlotT#

    C_MenuitemBuildvariantSlotT             ,
    MenuitemBuildvariantSlotT               ,
    dynamic_MenuitemBuildvariantSlotT       ,
    genClosure_MenuitemBuildvariantSlotT    ,
    mk_MenuitemBuildvariantSlotT            ,
    noMenuitemBuildvariantSlotT             ,
    wrap_MenuitemBuildvariantSlotT          ,




    ) 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.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.Dbusmenu.Objects.Client as Dbusmenu.Client
import {-# SOURCE #-} qualified GI.Dbusmenu.Objects.Menuitem as Dbusmenu.Menuitem

-- callback MenuitemBuildvariantSlotT
--          -> Callable {returnType = Just TVariant, returnMayBeNull = False, returnTransfer = TransferEverything, returnDocumentation = Documentation {rawDocText = Just "A variant representing this item and its children", sinceVersion = Nothing}, args = [Arg {argCName = "mi", argType = TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Menu item that should be built from", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "properties", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "A list of properties that should be the only ones in the resulting variant structure", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "This is the function that is called to represent this menu item\nas a variant.  Should call its own children.", sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_MenuitemBuildvariantSlotT =
    Ptr Dbusmenu.Menuitem.Menuitem ->
    CString ->
    IO (Ptr GVariant)

-- Args : [Arg {argCName = "mi", argType = TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Menu item that should be built from", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "properties", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "A list of properties that should be the only ones in the resulting variant structure", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_MenuitemBuildvariantSlotT :: FunPtr C_MenuitemBuildvariantSlotT -> C_MenuitemBuildvariantSlotT

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_MenuitemBuildvariantSlotT ::
    (B.CallStack.HasCallStack, MonadIO m, Dbusmenu.Menuitem.IsMenuitem a) =>
    FunPtr C_MenuitemBuildvariantSlotT
    -> a
    {- ^ /@mi@/: Menu item that should be built from -}
    -> Maybe (T.Text)
    {- ^ /@properties@/: A list of properties that should be the only ones in the resulting variant structure -}
    -> m GVariant
    {- ^ __Returns:__ A variant representing this item and its children -}
dynamic_MenuitemBuildvariantSlotT __funPtr mi properties = liftIO $ do
    mi' <- unsafeManagedPtrCastPtr mi
    maybeProperties <- case properties of
        Nothing -> return nullPtr
        Just jProperties -> do
            jProperties' <- textToCString jProperties
            return jProperties'
    result <- (__dynamic_C_MenuitemBuildvariantSlotT __funPtr) mi' maybeProperties
    checkUnexpectedReturnNULL "menuitemBuildvariantSlotT" result
    result' <- B.GVariant.wrapGVariantPtr result
    touchManagedPtr mi
    freeMem maybeProperties
    return result'

-- | Generate a function pointer callable from C code, from a `C_MenuitemBuildvariantSlotT`.
foreign import ccall "wrapper"
    mk_MenuitemBuildvariantSlotT :: C_MenuitemBuildvariantSlotT -> IO (FunPtr C_MenuitemBuildvariantSlotT)

{- |
This is the function that is called to represent this menu item
as a variant.  Should call its own children.
-}
type MenuitemBuildvariantSlotT =
    Dbusmenu.Menuitem.Menuitem
    {- ^ /@mi@/: Menu item that should be built from -}
    -> Maybe T.Text
    {- ^ /@properties@/: A list of properties that should be the only ones in the resulting variant structure -}
    -> IO GVariant
    {- ^ __Returns:__ A variant representing this item and its children -}

-- | A convenience synonym for @`Nothing` :: `Maybe` `MenuitemBuildvariantSlotT`@.
noMenuitemBuildvariantSlotT :: Maybe MenuitemBuildvariantSlotT
noMenuitemBuildvariantSlotT = Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_MenuitemBuildvariantSlotT :: MonadIO m => MenuitemBuildvariantSlotT -> m (GClosure C_MenuitemBuildvariantSlotT)
genClosure_MenuitemBuildvariantSlotT cb = liftIO $ do
    let cb' = wrap_MenuitemBuildvariantSlotT Nothing cb
    mk_MenuitemBuildvariantSlotT cb' >>= B.GClosure.newGClosure


-- | Wrap a `MenuitemBuildvariantSlotT` into a `C_MenuitemBuildvariantSlotT`.
wrap_MenuitemBuildvariantSlotT ::
    Maybe (Ptr (FunPtr C_MenuitemBuildvariantSlotT)) ->
    MenuitemBuildvariantSlotT ->
    C_MenuitemBuildvariantSlotT
wrap_MenuitemBuildvariantSlotT funptrptr _cb mi properties = do
    mi' <- (newObject Dbusmenu.Menuitem.Menuitem) mi
    maybeProperties <-
        if properties == nullPtr
        then return Nothing
        else do
            properties' <- cstringToText properties
            return $ Just properties'
    result <- _cb  mi' maybeProperties
    maybeReleaseFunPtr funptrptr
    result' <- B.GVariant.disownGVariant result
    return result'


-- callback MenuitemAboutToShowCb
--          -> Callable {returnType = Nothing, returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "mi", argType = TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Menu item that should be shown", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "user_data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "Extra user data sent with the function", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "Callback prototype for a callback that is called when the\nmenu should be shown.", sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_MenuitemAboutToShowCb =
    Ptr Dbusmenu.Menuitem.Menuitem ->
    Ptr () ->
    IO ()

-- Args : [Arg {argCName = "mi", argType = TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Menu item that should be shown", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "user_data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "Extra user data sent with the function", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_MenuitemAboutToShowCb :: FunPtr C_MenuitemAboutToShowCb -> C_MenuitemAboutToShowCb

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_MenuitemAboutToShowCb ::
    (B.CallStack.HasCallStack, MonadIO m, Dbusmenu.Menuitem.IsMenuitem a) =>
    FunPtr C_MenuitemAboutToShowCb
    -> a
    {- ^ /@mi@/: Menu item that should be shown -}
    -> Ptr ()
    {- ^ /@userData@/: Extra user data sent with the function -}
    -> m ()
dynamic_MenuitemAboutToShowCb __funPtr mi userData = liftIO $ do
    mi' <- unsafeManagedPtrCastPtr mi
    (__dynamic_C_MenuitemAboutToShowCb __funPtr) mi' userData
    touchManagedPtr mi
    return ()

-- | Generate a function pointer callable from C code, from a `C_MenuitemAboutToShowCb`.
foreign import ccall "wrapper"
    mk_MenuitemAboutToShowCb :: C_MenuitemAboutToShowCb -> IO (FunPtr C_MenuitemAboutToShowCb)

{- |
Callback prototype for a callback that is called when the
menu should be shown.
-}
type MenuitemAboutToShowCb =
    Dbusmenu.Menuitem.Menuitem
    {- ^ /@mi@/: Menu item that should be shown -}
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `MenuitemAboutToShowCb`@.
noMenuitemAboutToShowCb :: Maybe MenuitemAboutToShowCb
noMenuitemAboutToShowCb = Nothing

{- |
Callback prototype for a callback that is called when the
menu should be shown.
-}
type MenuitemAboutToShowCb_WithClosures =
    Dbusmenu.Menuitem.Menuitem
    {- ^ /@mi@/: Menu item that should be shown -}
    -> Ptr ()
    {- ^ /@userData@/: Extra user data sent with the function -}
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `MenuitemAboutToShowCb_WithClosures`@.
noMenuitemAboutToShowCb_WithClosures :: Maybe MenuitemAboutToShowCb_WithClosures
noMenuitemAboutToShowCb_WithClosures = Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_MenuitemAboutToShowCb :: MenuitemAboutToShowCb -> MenuitemAboutToShowCb_WithClosures
drop_closures_MenuitemAboutToShowCb _f mi _ = _f mi

-- | Wrap the callback into a `GClosure`.
genClosure_MenuitemAboutToShowCb :: MonadIO m => MenuitemAboutToShowCb -> m (GClosure C_MenuitemAboutToShowCb)
genClosure_MenuitemAboutToShowCb cb = liftIO $ do
    let cb' = drop_closures_MenuitemAboutToShowCb cb
    let cb'' = wrap_MenuitemAboutToShowCb Nothing cb'
    mk_MenuitemAboutToShowCb cb'' >>= B.GClosure.newGClosure


-- | Wrap a `MenuitemAboutToShowCb` into a `C_MenuitemAboutToShowCb`.
wrap_MenuitemAboutToShowCb ::
    Maybe (Ptr (FunPtr C_MenuitemAboutToShowCb)) ->
    MenuitemAboutToShowCb_WithClosures ->
    C_MenuitemAboutToShowCb
wrap_MenuitemAboutToShowCb funptrptr _cb mi userData = do
    mi' <- (newObject Dbusmenu.Menuitem.Menuitem) mi
    _cb  mi' userData
    maybeReleaseFunPtr funptrptr


-- callback ClientTypeHandler
--          -> Callable {returnType = Just (TBasicType TBoolean), returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "newitem", argType = TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #DbusmenuMenuitem that was created", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "parent", argType = TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The parent of @newitem or #NULL if none", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "client", argType = TInterface (Name {namespace = "Dbusmenu", name = "Client"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to the #DbusmenuClient", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "user_data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "The data you gave us", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "The type handler is called when a dbusmenu item is created\n\twith a matching type as setup in #dbusmenu_client_add_type_handler\n\n\tReturn value: #TRUE if the type has been handled.  #FALSE if this\n\t\tfunction was somehow unable to handle it.", sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_ClientTypeHandler =
    Ptr Dbusmenu.Menuitem.Menuitem ->
    Ptr Dbusmenu.Menuitem.Menuitem ->
    Ptr Dbusmenu.Client.Client ->
    Ptr () ->
    IO CInt

-- Args : [Arg {argCName = "newitem", argType = TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #DbusmenuMenuitem that was created", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "parent", argType = TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The parent of @newitem or #NULL if none", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "client", argType = TInterface (Name {namespace = "Dbusmenu", name = "Client"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to the #DbusmenuClient", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "user_data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "The data you gave us", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ClientTypeHandler :: FunPtr C_ClientTypeHandler -> C_ClientTypeHandler

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ClientTypeHandler ::
    (B.CallStack.HasCallStack, MonadIO m, Dbusmenu.Menuitem.IsMenuitem a, Dbusmenu.Menuitem.IsMenuitem b, Dbusmenu.Client.IsClient c) =>
    FunPtr C_ClientTypeHandler
    -> a
    {- ^ /@newitem@/: The 'GI.Dbusmenu.Objects.Menuitem.Menuitem' that was created -}
    -> b
    {- ^ /@parent@/: The parent of /@newitem@/ or @/NULL/@ if none -}
    -> c
    {- ^ /@client@/: A pointer to the 'GI.Dbusmenu.Objects.Client.Client' -}
    -> Ptr ()
    {- ^ /@userData@/: The data you gave us -}
    -> m Bool
dynamic_ClientTypeHandler __funPtr newitem parent client userData = liftIO $ do
    newitem' <- unsafeManagedPtrCastPtr newitem
    parent' <- unsafeManagedPtrCastPtr parent
    client' <- unsafeManagedPtrCastPtr client
    result <- (__dynamic_C_ClientTypeHandler __funPtr) newitem' parent' client' userData
    let result' = (/= 0) result
    touchManagedPtr newitem
    touchManagedPtr parent
    touchManagedPtr client
    return result'

-- | Generate a function pointer callable from C code, from a `C_ClientTypeHandler`.
foreign import ccall "wrapper"
    mk_ClientTypeHandler :: C_ClientTypeHandler -> IO (FunPtr C_ClientTypeHandler)

{- |
The type handler is called when a dbusmenu item is created
	with a matching type as setup in @/dbusmenu_client_add_type_handler/@

	Return value: @/TRUE/@ if the type has been handled.  @/FALSE/@ if this
		function was somehow unable to handle it.
-}
type ClientTypeHandler =
    Dbusmenu.Menuitem.Menuitem
    {- ^ /@newitem@/: The 'GI.Dbusmenu.Objects.Menuitem.Menuitem' that was created -}
    -> Dbusmenu.Menuitem.Menuitem
    {- ^ /@parent@/: The parent of /@newitem@/ or @/NULL/@ if none -}
    -> Dbusmenu.Client.Client
    {- ^ /@client@/: A pointer to the 'GI.Dbusmenu.Objects.Client.Client' -}
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClientTypeHandler`@.
noClientTypeHandler :: Maybe ClientTypeHandler
noClientTypeHandler = Nothing

{- |
The type handler is called when a dbusmenu item is created
	with a matching type as setup in @/dbusmenu_client_add_type_handler/@

	Return value: @/TRUE/@ if the type has been handled.  @/FALSE/@ if this
		function was somehow unable to handle it.
-}
type ClientTypeHandler_WithClosures =
    Dbusmenu.Menuitem.Menuitem
    {- ^ /@newitem@/: The 'GI.Dbusmenu.Objects.Menuitem.Menuitem' that was created -}
    -> Dbusmenu.Menuitem.Menuitem
    {- ^ /@parent@/: The parent of /@newitem@/ or @/NULL/@ if none -}
    -> Dbusmenu.Client.Client
    {- ^ /@client@/: A pointer to the 'GI.Dbusmenu.Objects.Client.Client' -}
    -> Ptr ()
    {- ^ /@userData@/: The data you gave us -}
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClientTypeHandler_WithClosures`@.
noClientTypeHandler_WithClosures :: Maybe ClientTypeHandler_WithClosures
noClientTypeHandler_WithClosures = Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ClientTypeHandler :: ClientTypeHandler -> ClientTypeHandler_WithClosures
drop_closures_ClientTypeHandler _f newitem parent client _ = _f newitem parent client

-- | Wrap the callback into a `GClosure`.
genClosure_ClientTypeHandler :: MonadIO m => ClientTypeHandler -> m (GClosure C_ClientTypeHandler)
genClosure_ClientTypeHandler cb = liftIO $ do
    let cb' = drop_closures_ClientTypeHandler cb
    let cb'' = wrap_ClientTypeHandler Nothing cb'
    mk_ClientTypeHandler cb'' >>= B.GClosure.newGClosure


-- | Wrap a `ClientTypeHandler` into a `C_ClientTypeHandler`.
wrap_ClientTypeHandler ::
    Maybe (Ptr (FunPtr C_ClientTypeHandler)) ->
    ClientTypeHandler_WithClosures ->
    C_ClientTypeHandler
wrap_ClientTypeHandler funptrptr _cb newitem parent client userData = do
    newitem' <- (newObject Dbusmenu.Menuitem.Menuitem) newitem
    parent' <- (newObject Dbusmenu.Menuitem.Menuitem) parent
    client' <- (newObject Dbusmenu.Client.Client) client
    result <- _cb  newitem' parent' client' userData
    maybeReleaseFunPtr funptrptr
    let result' = (fromIntegral . fromEnum) result
    return result'