{-# LINE 1 "Data/GI/Base/Signals.hsc" #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.GI.Base.Signals
( on
, after
, SignalProxy(..)
, SignalConnectMode(..)
, connectSignalFunPtr
, SignalHandlerId
, SignalInfo(..)
, GObjectNotifySignalInfo
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Proxy (Proxy(..))
import Foreign
import Foreign.C
import GHC.TypeLits
import Data.GI.Base.Attributes (AttrLabelProxy, AttrInfo(AttrLabel))
import Data.GI.Base.BasicTypes
import Data.GI.Base.GParamSpec (newGParamSpecFromPtr)
import Data.GI.Base.ManagedPtr (withManagedPtr)
import Data.GI.Base.Overloading (ResolveSignal,
IsLabelProxy(..), ResolveAttribute)
import Data.GI.Base.Utils (safeFreeFunPtrPtr)
{-# LINE 42 "Data/GI/Base/Signals.hsc" #-}
import GHC.OverloadedLabels (IsLabel(..))
{-# LINE 46 "Data/GI/Base/Signals.hsc" #-}
type SignalHandlerId = CULong
class NoConstraint a
instance NoConstraint a
data SignalProxy (object :: *) (info :: *) where
SignalProxy :: SignalProxy o info
PropertyNotify :: (info ~ ResolveAttribute propName o,
AttrInfo info,
pl ~ AttrLabel info) =>
AttrLabelProxy propName ->
SignalProxy o (GObjectNotifySignalInfo pl)
instance
{-# LINE 69 "Data/GI/Base/Signals.hsc" #-}
info ~ ResolveSignal slot object
{-# LINE 71 "Data/GI/Base/Signals.hsc" #-}
=> IsLabelProxy slot (SignalProxy object info) where
fromLabelProxy _ = SignalProxy
{-# LINE 75 "Data/GI/Base/Signals.hsc" #-}
instance info ~ ResolveSignal slot object =>
IsLabel slot (SignalProxy object info) where
fromLabel = SignalProxy
{-# LINE 83 "Data/GI/Base/Signals.hsc" #-}
class SignalInfo (info :: *) where
type HaskellCallbackType info
connectSignal :: GObject o =>
SignalProxy o info ->
o ->
HaskellCallbackType info ->
SignalConnectMode ->
IO SignalHandlerId
data SignalConnectMode = SignalConnectBefore
| SignalConnectAfter
on :: forall object info m.
(GObject object, MonadIO m, SignalInfo info) =>
object -> SignalProxy object info
-> HaskellCallbackType info -> m SignalHandlerId
on o p c = liftIO $ connectSignal p o c SignalConnectBefore
after :: forall object info m.
(GObject object, MonadIO m, SignalInfo info) =>
object -> SignalProxy object info
-> HaskellCallbackType info -> m SignalHandlerId
after o p c = liftIO $ connectSignal p o c SignalConnectAfter
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
data GObjectNotifySignalInfo (propName :: Symbol)
instance KnownSymbol propName =>
SignalInfo (GObjectNotifySignalInfo propName) where
type HaskellCallbackType (GObjectNotifySignalInfo propName) = GObjectNotifyCallback
connectSignal = connectGObjectNotify (symbolVal (Proxy :: Proxy propName))
type GObjectNotifyCallback = GParamSpec -> IO ()
gobjectNotifyCallbackWrapper ::
GObjectNotifyCallback -> Ptr () -> Ptr GParamSpec -> Ptr () -> IO ()
gobjectNotifyCallbackWrapper _cb _ pspec _ = do
pspec' <- newGParamSpecFromPtr pspec
_cb pspec'
type GObjectNotifyCallbackC = Ptr () -> Ptr GParamSpec -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkGObjectNotifyCallback :: GObjectNotifyCallbackC -> IO (FunPtr GObjectNotifyCallbackC)
connectGObjectNotify :: forall o i. GObject o =>
String ->
SignalProxy o (i :: *) ->
o -> GObjectNotifyCallback ->
SignalConnectMode -> IO SignalHandlerId
connectGObjectNotify propName _ obj cb mode = do
cb' <- mkGObjectNotifyCallback (gobjectNotifyCallbackWrapper cb)
let signalName = "notify::" ++ propName
connectSignalFunPtr obj signalName cb' mode