module Data.GI.Base.Signals
( SignalConnectMode(..),
connectSignalFunPtr,
on,
after,
SignalHandlerId,
SignalInfo(..)
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Foreign
import Foreign.C
import GHC.Exts (Constraint)
import GHC.TypeLits
import Data.GI.Base.BasicTypes
import Data.GI.Base.ManagedPtr (withManagedPtr)
import Data.GI.Base.Overloading (HasSignal, ResolveSignal)
import Data.GI.Base.Utils (safeFreeFunPtrPtr)
type SignalHandlerId = Word64
data SignalProxy (s :: *) (e :: Symbol) (c :: * -> Constraint) = SignalProxy
class SignalInfo (info :: *) where
type HaskellCallbackType info
connectSignal :: (KnownSymbol extra, GObject o, constraint o) =>
SignalProxy info extra constraint ->
o ->
HaskellCallbackType info ->
SignalConnectMode ->
IO SignalHandlerId
data SignalConnectMode = SignalConnectBefore
| SignalConnectAfter
on :: forall signal extra o info constraint proxy m.
(GObject o,
HasSignal signal o, info ~ ResolveSignal signal o, SignalInfo info,
KnownSymbol extra, constraint o, MonadIO m) =>
o -> proxy (signal :: Symbol) (extra :: Symbol) (constraint :: * -> Constraint)
-> HaskellCallbackType info -> m SignalHandlerId
on o p c = liftIO $ connectSignal (resolve p) o c SignalConnectBefore
where resolve :: proxy signal extra constraint ->
SignalProxy (ResolveSignal signal o) extra constraint
resolve _ = SignalProxy
after :: forall signal extra o info constraint proxy m.
(GObject o,
HasSignal signal o, info ~ ResolveSignal signal o, SignalInfo info,
KnownSymbol extra, constraint o, MonadIO m) =>
o -> proxy (signal :: Symbol) (extra :: Symbol) (constraint :: * -> Constraint)
-> HaskellCallbackType info -> m SignalHandlerId
after o p c = liftIO $ connectSignal (resolve p) o c SignalConnectAfter
where resolve :: proxy signal extra constraint ->
SignalProxy (ResolveSignal signal o) extra constraint
resolve _ = SignalProxy
foreign import ccall "g_signal_connect_data" g_signal_connect_data ::
Ptr a ->
CString ->
FunPtr b ->
Ptr () ->
FunPtr c ->
CUInt ->
IO SignalHandlerId
connectSignalFunPtr :: GObject o =>
o -> String -> FunPtr a -> SignalConnectMode -> IO SignalHandlerId
connectSignalFunPtr object signal fn mode = do
let flags = case mode of
SignalConnectAfter -> 1
SignalConnectBefore -> 0
withCString signal $ \csignal ->
withManagedPtr object $ \objPtr ->
g_signal_connect_data objPtr csignal fn (castFunPtrToPtr fn) safeFreeFunPtrPtr flags