{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE RankNTypes #-}
module Data.GI.Base.Signals
( on
, after
, SignalProxy(..)
, SignalConnectMode(..)
, connectSignalFunPtr
, disconnectSignalHandler
, SignalHandlerId
, SignalInfo(..)
, GObjectNotifySignalInfo
, SignalCodeGenError
, resolveSignal
, connectGObjectNotify
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Proxy (Proxy(..))
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Foreign
import Foreign.C
#if !MIN_VERSION_base(4,13,0)
import Foreign.Ptr (nullPtr)
#endif
import GHC.TypeLits
import Data.Kind (Type)
import qualified Data.Text as T
import Data.Text (Text)
import Data.GI.Base.Attributes (AttrLabelProxy(..), AttrInfo(AttrLabel),
AttrGetType, attrGet,
AttrBaseTypeConstraint)
import Data.GI.Base.BasicConversions (withTextCString)
import Data.GI.Base.BasicTypes
import Data.GI.Base.GParamSpec (newGParamSpecFromPtr)
import Data.GI.Base.ManagedPtr (withManagedPtr, withTransient)
import Data.GI.Base.Overloading (ResolveSignal, ResolveAttribute,
ResolvedSymbolInfo)
import GHC.OverloadedLabels (IsLabel(..))
type SignalHandlerId = CULong
data SignalProxy (object :: Type) (info :: Type) where
SignalProxy :: SignalProxy o info
(:::) :: forall o info. SignalProxy o info -> Text -> SignalProxy o info
PropertyNotify :: (info ~ ResolveAttribute propName o,
AttrInfo info,
pl ~ AttrLabel info, KnownSymbol pl) =>
AttrLabelProxy propName ->
SignalProxy o GObjectNotifySignalInfo
PropertySet :: (info ~ ResolveAttribute propName o,
AttrInfo info,
AttrBaseTypeConstraint info o,
b ~ AttrGetType info,
pl ~ AttrLabel info, KnownSymbol pl) =>
AttrLabelProxy propName ->
SignalProxy o (GObjectPropertySetSignalInfo b)
instance (info ~ ResolveSignal slot object) =>
IsLabel slot (SignalProxy object info) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: SignalProxy object info
fromLabel = SignalProxy object info
forall o info. SignalProxy o info
SignalProxy
#else
fromLabel _ = SignalProxy
#endif
class SignalInfo (info :: Type) where
type HaskellCallbackType info :: Type
connectSignal :: GObject o =>
o ->
(o -> HaskellCallbackType info) ->
SignalConnectMode ->
Maybe Text ->
IO SignalHandlerId
dbgSignalInfo :: Maybe ResolvedSymbolInfo
dbgSignalInfo = Maybe ResolvedSymbolInfo
forall a. Maybe a
Nothing
data SignalConnectMode = SignalConnectBefore
| SignalConnectAfter
on :: forall object info m.
(GObject object, MonadIO m, SignalInfo info) =>
object -> SignalProxy object info
-> ((?self :: object) => HaskellCallbackType info)
-> m SignalHandlerId
on :: forall object info (m :: * -> *).
(GObject object, MonadIO m, SignalInfo info) =>
object
-> SignalProxy object info
-> ((?self::object) => HaskellCallbackType info)
-> m SignalHandlerId
on object
o p :: SignalProxy object info
p@(PropertySet (AttrLabelProxy propName
_ :: AttrLabelProxy propName)) (?self::object) => HaskellCallbackType info
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: Ptr object -> Ptr GParamSpec -> Ptr () -> IO ()
wrapped = Proxy propName
-> Proxy object
-> ((?self::object) => AttrGetType info -> IO ())
-> Ptr object
-> Ptr GParamSpec
-> Ptr ()
-> IO ()
forall info (prop :: Symbol) obj.
(info ~ ResolveAttribute prop obj, AttrBaseTypeConstraint info obj,
AttrInfo info, GObject obj) =>
Proxy prop
-> Proxy obj
-> ((?self::obj) => AttrGetType info -> IO ())
-> Ptr obj
-> Ptr GParamSpec
-> Ptr ()
-> IO ()
wrapPropertySet (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @propName) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @object) HaskellCallbackType info
(?self::object) => HaskellCallbackType info
(?self::object) => AttrGetType info -> IO ()
AttrGetType info -> IO ()
cb
FunPtr (Ptr object -> Ptr GParamSpec -> Ptr () -> IO ())
cb' <- (Ptr object -> Ptr GParamSpec -> Ptr () -> IO ())
-> IO (FunPtr (Ptr object -> Ptr GParamSpec -> Ptr () -> IO ()))
forall o.
GObjectNotifyCallbackC o -> IO (FunPtr (GObjectNotifyCallbackC o))
mkGObjectNotifyCallback Ptr object -> Ptr GParamSpec -> Ptr () -> IO ()
wrapped
object
-> Text
-> FunPtr (Ptr object -> Ptr GParamSpec -> Ptr () -> IO ())
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr object
o Text
"notify" FunPtr (Ptr object -> Ptr GParamSpec -> Ptr () -> IO ())
cb' SignalConnectMode
SignalConnectBefore (SignalProxy object info -> Maybe Text
forall object info. SignalProxy object info -> Maybe Text
proxyDetail SignalProxy object info
p)
on object
o SignalProxy object info
p (?self::object) => HaskellCallbackType info
c =
IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ forall info o.
(SignalInfo info, GObject o) =>
o
-> (o -> HaskellCallbackType info)
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignal @info object
o object -> HaskellCallbackType info
w SignalConnectMode
SignalConnectBefore (SignalProxy object info -> Maybe Text
forall object info. SignalProxy object info -> Maybe Text
proxyDetail SignalProxy object info
p)
where w :: object -> HaskellCallbackType info
w :: object -> HaskellCallbackType info
w object
parent = let ?self = object
?self::object
parent in HaskellCallbackType info
(?self::object) => HaskellCallbackType info
c
wrapPropertySet :: forall info prop obj.
(info ~ ResolveAttribute prop obj,
AttrBaseTypeConstraint info obj,
AttrInfo info,
GObject obj) =>
Proxy (prop :: Symbol) -> Proxy obj ->
((?self :: obj) => AttrGetType info -> IO ()) ->
Ptr obj -> Ptr GParamSpec -> Ptr () -> IO ()
wrapPropertySet :: forall info (prop :: Symbol) obj.
(info ~ ResolveAttribute prop obj, AttrBaseTypeConstraint info obj,
AttrInfo info, GObject obj) =>
Proxy prop
-> Proxy obj
-> ((?self::obj) => AttrGetType info -> IO ())
-> Ptr obj
-> Ptr GParamSpec
-> Ptr ()
-> IO ()
wrapPropertySet Proxy prop
_ Proxy obj
_ (?self::obj) => AttrGetType info -> IO ()
cb Ptr obj
objPtr Ptr GParamSpec
_pspec Ptr ()
_data =
Ptr obj -> (obj -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
withTransient Ptr obj
objPtr ((obj -> IO ()) -> IO ()) -> (obj -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \obj
self -> do
AttrGetType info
val <- forall info o.
(AttrInfo info, AttrBaseTypeConstraint info o) =>
o -> IO (AttrGetType info)
attrGet @(ResolveAttribute prop obj) obj
self
let ?self = obj
?self::obj
self in (?self::obj) => AttrGetType info -> IO ()
AttrGetType info -> IO ()
cb AttrGetType info
val
after :: forall object info m.
(GObject object, MonadIO m, SignalInfo info) =>
object -> SignalProxy object info
-> ((?self :: object) => HaskellCallbackType info)
-> m SignalHandlerId
after :: forall object info (m :: * -> *).
(GObject object, MonadIO m, SignalInfo info) =>
object
-> SignalProxy object info
-> ((?self::object) => HaskellCallbackType info)
-> m SignalHandlerId
after object
o SignalProxy object info
p (?self::object) => HaskellCallbackType info
c =
IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ forall info o.
(SignalInfo info, GObject o) =>
o
-> (o -> HaskellCallbackType info)
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignal @info object
o object -> HaskellCallbackType info
w SignalConnectMode
SignalConnectAfter (SignalProxy object info -> Maybe Text
forall object info. SignalProxy object info -> Maybe Text
proxyDetail SignalProxy object info
p)
where w :: object -> HaskellCallbackType info
w :: object -> HaskellCallbackType info
w object
parent = let ?self = object
?self::object
parent in HaskellCallbackType info
(?self::object) => HaskellCallbackType info
c
proxyDetail :: forall object info. SignalProxy object info -> Maybe Text
proxyDetail :: forall object info. SignalProxy object info -> Maybe Text
proxyDetail SignalProxy object info
p = case SignalProxy object info
p of
SignalProxy object info
SignalProxy -> Maybe Text
forall a. Maybe a
Nothing
(SignalProxy object info
_ ::: Text
detail) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
detail
PropertyNotify (AttrLabelProxy propName
AttrLabelProxy :: AttrLabelProxy propName) ->
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Proxy pl -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(AttrLabel (ResolveAttribute propName object)))
PropertySet (AttrLabelProxy propName
AttrLabelProxy :: AttrLabelProxy propName) ->
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Proxy pl -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(AttrLabel (ResolveAttribute propName object)))
foreign import ccall g_signal_connect_data ::
Ptr a ->
CString ->
FunPtr b ->
Ptr () ->
FunPtr c ->
CUInt ->
IO SignalHandlerId
foreign import ccall "& haskell_gi_release_signal_closure"
ptr_to_release_closure :: FunPtr (Ptr () -> Ptr () -> IO ())
connectSignalFunPtr :: GObject o =>
o -> Text -> FunPtr a -> SignalConnectMode ->
Maybe Text -> IO SignalHandlerId
connectSignalFunPtr :: forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr o
object Text
signal FunPtr a
fn SignalConnectMode
mode Maybe Text
maybeDetail = do
let flags :: CUInt
flags = case SignalConnectMode
mode of
SignalConnectMode
SignalConnectAfter -> CUInt
1
SignalConnectMode
SignalConnectBefore -> CUInt
0
signalSpec :: Text
signalSpec = case Maybe Text
maybeDetail of
Maybe Text
Nothing -> Text
signal
Just Text
detail -> Text
signal Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
Text -> (CString -> IO SignalHandlerId) -> IO SignalHandlerId
forall a. Text -> (CString -> IO a) -> IO a
withTextCString Text
signalSpec ((CString -> IO SignalHandlerId) -> IO SignalHandlerId)
-> (CString -> IO SignalHandlerId) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ \CString
csignal ->
o -> (Ptr o -> IO SignalHandlerId) -> IO SignalHandlerId
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr o
object ((Ptr o -> IO SignalHandlerId) -> IO SignalHandlerId)
-> (Ptr o -> IO SignalHandlerId) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ \Ptr o
objPtr ->
Ptr o
-> CString
-> FunPtr a
-> Ptr ()
-> FunPtr (Ptr () -> Ptr () -> IO ())
-> CUInt
-> IO SignalHandlerId
forall a b c.
Ptr a
-> CString
-> FunPtr b
-> Ptr ()
-> FunPtr c
-> CUInt
-> IO SignalHandlerId
g_signal_connect_data Ptr o
objPtr CString
csignal FunPtr a
fn Ptr ()
forall a. Ptr a
nullPtr FunPtr (Ptr () -> Ptr () -> IO ())
ptr_to_release_closure CUInt
flags
foreign import ccall g_signal_handler_disconnect :: Ptr o -> SignalHandlerId -> IO ()
disconnectSignalHandler :: GObject o => o -> SignalHandlerId -> IO ()
disconnectSignalHandler :: forall o. GObject o => o -> SignalHandlerId -> IO ()
disconnectSignalHandler o
obj SignalHandlerId
handlerId =
o -> (Ptr o -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr o
obj ((Ptr o -> IO ()) -> IO ()) -> (Ptr o -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr o
objPtr ->
Ptr o -> SignalHandlerId -> IO ()
forall o. Ptr o -> SignalHandlerId -> IO ()
g_signal_handler_disconnect Ptr o
objPtr SignalHandlerId
handlerId
data GObjectNotifySignalInfo
instance SignalInfo GObjectNotifySignalInfo where
type HaskellCallbackType GObjectNotifySignalInfo = GObjectNotifyCallback
connectSignal :: forall o.
GObject o =>
o
-> (o -> HaskellCallbackType GObjectNotifySignalInfo)
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignal = o
-> (o -> HaskellCallbackType GObjectNotifySignalInfo)
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
o
-> (o -> GObjectNotifyCallback)
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o.
GObject o =>
o
-> (o -> GObjectNotifyCallback)
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectGObjectNotify
type GObjectNotifyCallback = GParamSpec -> IO ()
gobjectNotifyCallbackWrapper :: GObject o =>
(o -> GObjectNotifyCallback) -> GObjectNotifyCallbackC o
gobjectNotifyCallbackWrapper :: forall o.
GObject o =>
(o -> GObjectNotifyCallback) -> GObjectNotifyCallbackC o
gobjectNotifyCallbackWrapper o -> GObjectNotifyCallback
cb Ptr o
selfPtr Ptr GParamSpec
pspec Ptr ()
_ = do
GParamSpec
pspec' <- Ptr GParamSpec -> IO GParamSpec
newGParamSpecFromPtr Ptr GParamSpec
pspec
Ptr o -> (o -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
withTransient (Ptr o -> Ptr o
forall a b. Ptr a -> Ptr b
castPtr Ptr o
selfPtr) ((o -> IO ()) -> IO ()) -> (o -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \o
self -> o -> GObjectNotifyCallback
cb o
self GParamSpec
pspec'
type GObjectNotifyCallbackC o = Ptr o -> Ptr GParamSpec -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkGObjectNotifyCallback :: GObjectNotifyCallbackC o -> IO (FunPtr (GObjectNotifyCallbackC o))
connectGObjectNotify :: GObject o =>
o -> (o -> GObjectNotifyCallback) ->
SignalConnectMode ->
Maybe Text ->
IO SignalHandlerId
connectGObjectNotify :: forall o.
GObject o =>
o
-> (o -> GObjectNotifyCallback)
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectGObjectNotify o
obj o -> GObjectNotifyCallback
cb SignalConnectMode
mode Maybe Text
detail = do
FunPtr (GObjectNotifyCallbackC o)
cb' <- GObjectNotifyCallbackC o -> IO (FunPtr (GObjectNotifyCallbackC o))
forall o.
GObjectNotifyCallbackC o -> IO (FunPtr (GObjectNotifyCallbackC o))
mkGObjectNotifyCallback ((o -> GObjectNotifyCallback) -> GObjectNotifyCallbackC o
forall o.
GObject o =>
(o -> GObjectNotifyCallback) -> GObjectNotifyCallbackC o
gobjectNotifyCallbackWrapper o -> GObjectNotifyCallback
cb)
o
-> Text
-> FunPtr (GObjectNotifyCallbackC o)
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr o
obj Text
"notify" FunPtr (GObjectNotifyCallbackC o)
cb' SignalConnectMode
mode Maybe Text
detail
data GObjectPropertySetSignalInfo (b :: Type)
instance SignalInfo (GObjectPropertySetSignalInfo b) where
type HaskellCallbackType (GObjectPropertySetSignalInfo b) = b -> IO ()
connectSignal :: forall o.
GObject o =>
o
-> (o -> HaskellCallbackType (GObjectPropertySetSignalInfo b))
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignal = o
-> (o -> HaskellCallbackType (GObjectPropertySetSignalInfo b))
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
o
-> (o -> b -> IO ())
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall a. HasCallStack => a
undefined
type family SignalCodeGenError (signalName :: Symbol) :: Type where
SignalCodeGenError signalName = TypeError
('Text "The signal ‘"
':<>: 'Text signalName
':<>: 'Text "’ is not supported, because haskell-gi failed to generate appropriate bindings."
':$$: 'Text "Please file an issue at https://github.com/haskell-gi/haskell-gi/issues.")
resolveSignal :: forall object info. (GObject object, SignalInfo info) =>
object -> SignalProxy object info -> Maybe ResolvedSymbolInfo
resolveSignal :: forall object info.
(GObject object, SignalInfo info) =>
object -> SignalProxy object info -> Maybe ResolvedSymbolInfo
resolveSignal object
_o SignalProxy object info
_p = forall info. SignalInfo info => Maybe ResolvedSymbolInfo
dbgSignalInfo @info