-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.Notify.Callbacks
    ( 

 -- * Signals
-- ** ActionCallback #signal:ActionCallback#

    ActionCallback                          ,
    ActionCallback_WithClosures             ,
    C_ActionCallback                        ,
    drop_closures_ActionCallback            ,
    dynamic_ActionCallback                  ,
    genClosure_ActionCallback               ,
    mk_ActionCallback                       ,
    noActionCallback                        ,
    noActionCallback_WithClosures           ,
    wrap_ActionCallback                     ,




    ) 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 {-# SOURCE #-} qualified GI.Notify.Objects.Notification as Notify.Notification

-- callback ActionCallback
--          -> Callable {returnType = Nothing, returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "notification", argType = TInterface (Name {namespace = "Notify", name = "Notification"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "action", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, 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 = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 2, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "An action callback function.", sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_ActionCallback =
    Ptr Notify.Notification.Notification ->
    CString ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ActionCallback :: FunPtr C_ActionCallback -> C_ActionCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ActionCallback ::
    (B.CallStack.HasCallStack, MonadIO m, Notify.Notification.IsNotification a) =>
    FunPtr C_ActionCallback
    -> a
    -> T.Text
    -> Ptr ()
    -> m ()
dynamic_ActionCallback :: FunPtr C_ActionCallback -> a -> Text -> Ptr () -> m ()
dynamic_ActionCallback __funPtr :: FunPtr C_ActionCallback
__funPtr notification :: a
notification action :: Text
action userData :: Ptr ()
userData = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
action' <- Text -> IO CString
textToCString Text
action
    (FunPtr C_ActionCallback -> C_ActionCallback
__dynamic_C_ActionCallback FunPtr C_ActionCallback
__funPtr) Ptr Notification
notification' CString
action' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
action'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | An action callback function.
type ActionCallback =
    Notify.Notification.Notification
    -> T.Text
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ActionCallback`@.
noActionCallback :: Maybe ActionCallback
noActionCallback :: Maybe ActionCallback
noActionCallback = Maybe ActionCallback
forall a. Maybe a
Nothing

-- | An action callback function.
type ActionCallback_WithClosures =
    Notify.Notification.Notification
    -> T.Text
    -> Ptr ()
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ActionCallback_WithClosures`@.
noActionCallback_WithClosures :: Maybe ActionCallback_WithClosures
noActionCallback_WithClosures :: Maybe ActionCallback_WithClosures
noActionCallback_WithClosures = Maybe ActionCallback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ActionCallback :: ActionCallback -> ActionCallback_WithClosures
drop_closures_ActionCallback :: ActionCallback -> ActionCallback_WithClosures
drop_closures_ActionCallback _f :: ActionCallback
_f notification :: Notification
notification action :: Text
action _ = ActionCallback
_f Notification
notification Text
action

-- | Wrap the callback into a `GClosure`.
genClosure_ActionCallback :: MonadIO m => ActionCallback -> m (GClosure C_ActionCallback)
genClosure_ActionCallback :: ActionCallback -> m (GClosure C_ActionCallback)
genClosure_ActionCallback cb :: ActionCallback
cb = IO (GClosure C_ActionCallback) -> m (GClosure C_ActionCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ActionCallback) -> m (GClosure C_ActionCallback))
-> IO (GClosure C_ActionCallback) -> m (GClosure C_ActionCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ActionCallback_WithClosures
cb' = ActionCallback -> ActionCallback_WithClosures
drop_closures_ActionCallback ActionCallback
cb
    let cb'' :: C_ActionCallback
cb'' = Maybe (Ptr (FunPtr C_ActionCallback))
-> ActionCallback_WithClosures -> C_ActionCallback
wrap_ActionCallback Maybe (Ptr (FunPtr C_ActionCallback))
forall a. Maybe a
Nothing ActionCallback_WithClosures
cb'
    C_ActionCallback -> IO (FunPtr C_ActionCallback)
mk_ActionCallback C_ActionCallback
cb'' IO (FunPtr C_ActionCallback)
-> (FunPtr C_ActionCallback -> IO (GClosure C_ActionCallback))
-> IO (GClosure C_ActionCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ActionCallback -> IO (GClosure C_ActionCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ActionCallback` into a `C_ActionCallback`.
wrap_ActionCallback ::
    Maybe (Ptr (FunPtr C_ActionCallback)) ->
    ActionCallback_WithClosures ->
    C_ActionCallback
wrap_ActionCallback :: Maybe (Ptr (FunPtr C_ActionCallback))
-> ActionCallback_WithClosures -> C_ActionCallback
wrap_ActionCallback funptrptr :: Maybe (Ptr (FunPtr C_ActionCallback))
funptrptr _cb :: ActionCallback_WithClosures
_cb notification :: Ptr Notification
notification action :: CString
action userData :: Ptr ()
userData = do
    Notification
notification' <- ((ManagedPtr Notification -> Notification)
-> Ptr Notification -> IO Notification
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Notification -> Notification
Notify.Notification.Notification) Ptr Notification
notification
    Text
action' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
action
    ActionCallback_WithClosures
_cb  Notification
notification' Text
action' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ActionCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ActionCallback))
funptrptr