reflex-gi-gtk-0.1.0.0: src/Reflex/GI/Gtk/Input.hs
-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.
{-# LANGUAGE ConstraintKinds, GADTs, FlexibleContexts #-}
module Reflex.GI.Gtk.Input
( MonadGtkSource
-- * Obtaining input from GI signals
-- ** as 'Event's
, eventOnSignal
, eventAfterSignal
, eventOnSignal0
, eventAfterSignal0
, eventOnSignal1
, eventAfterSignal1
, eventOnSignal0R
, eventAfterSignal0R
, eventOnSignal1R
, eventAfterSignal1R
-- ** as 'Behavior's
, behaviorOnSignal
, behaviorAfterSignal
, behaviorOnSignal1
, behaviorAfterSignal1
, behaviorOnSignal1R
, behaviorAfterSignal1R
-- ** as 'Dynamic's
, dynamicOnSignal
, dynamicAfterSignal
, dynamicOnSignal1
, dynamicAfterSignal1
, dynamicOnSignal1R
, dynamicAfterSignal1R
-- * Obtaining input from GI attributes
, eventOnAttribute
, eventAfterAttribute
, behaviorOnAttribute
, behaviorAfterAttribute
, dynamicOnAttribute
, dynamicAfterAttribute
) where
import Data.GI.Base (GObject)
import Data.GI.Base.Attributes ( AttrGetC
, AttrLabel
, AttrLabelProxy
, get
)
import Data.GI.Base.Signals ( HaskellCallbackType
, SignalHandlerId
, SignalInfo
, SignalProxy(PropertyNotify)
, after
, disconnectSignalHandler
, on
)
import GHC.TypeLits (KnownSymbol)
import Reflex ( Behavior
, Dynamic
, Event
, MonadHold
, TriggerEvent
, hold
, holdDyn
, newEventWithLazyTriggerWithOnComplete
)
import Reflex.GI.Gtk.Run.Class ( MonadRunGtk
, askMakeSynchronousFire
, askRunGtk
, askRunGtk_
, runGtk
)
type MonadGtkSource t m = ( MonadRunGtk m
, TriggerEvent t m
)
eventFromSignalWith :: ( MonadGtkSource t m
, GObject object
, SignalInfo info
)
=> ( object -> SignalProxy object info ->
HaskellCallbackType info -> IO SignalHandlerId
)
-> object
-> SignalProxy object info
-> ((a -> IO ()) -> HaskellCallbackType info)
-> m (Event t a)
eventFromSignalWith register object signal f = do
runGtk' <- askRunGtk
runGtk_' <- askRunGtk_
makeSynchronousFire <- askMakeSynchronousFire
newEventWithLazyTriggerWithOnComplete $ \fire ->
runGtk_' . disconnectSignalHandler object
<$> runGtk' ( object `register` signal $
f $ \x -> makeSynchronousFire fire x
)
eventOnSignal, eventAfterSignal :: ( MonadGtkSource t m
, GObject object
, SignalInfo info
)
=> object
-> SignalProxy object info
-> ((a -> IO ()) -> HaskellCallbackType info)
-> m (Event t a)
eventOnSignal = eventFromSignalWith on
eventAfterSignal = eventFromSignalWith after
eventOnSignal0, eventAfterSignal0 :: ( MonadGtkSource t m
, HaskellCallbackType info ~ IO ()
, GObject object
, SignalInfo info
)
=> object
-> SignalProxy object info
-> m (Event t ())
eventOnSignal0 obj signal = eventOnSignal obj signal ($ ())
eventAfterSignal0 obj signal = eventAfterSignal obj signal ($ ())
eventOnSignal1, eventAfterSignal1 :: ( MonadGtkSource t m
, HaskellCallbackType info ~ (a -> IO ())
, GObject object
, SignalInfo info
)
=> object
-> SignalProxy object info
-> m (Event t a)
eventOnSignal1 obj signal = eventOnSignal obj signal id
eventAfterSignal1 obj signal = eventAfterSignal obj signal id
eventOnSignal0R, eventAfterSignal0R :: ( MonadGtkSource t m
, HaskellCallbackType info ~ IO b
, GObject object
, SignalInfo info
)
=> object
-> SignalProxy object info
-> b
-> m (Event t ())
eventOnSignal0R obj signal x = eventOnSignal obj signal $ \fire -> x <$ fire ()
eventAfterSignal0R obj signal x = eventAfterSignal obj signal $ \fire -> x <$ fire ()
eventOnSignal1R, eventAfterSignal1R :: ( MonadGtkSource t m
, HaskellCallbackType info ~ (a -> IO b)
, GObject object
, SignalInfo info
)
=> object
-> SignalProxy object info
-> b
-> m (Event t a)
eventOnSignal1R obj signal r = eventOnSignal obj signal $ \fire v -> r <$ fire v
eventAfterSignal1R obj signal r = eventAfterSignal obj signal $ \fire v -> r <$ fire v
behaviorOnSignal, behaviorAfterSignal :: ( MonadGtkSource t m
, MonadHold t m
, GObject object
, SignalInfo info
)
=> a
-> object
-> SignalProxy object info
-> ((a -> IO ()) -> HaskellCallbackType info)
-> m (Behavior t a)
behaviorOnSignal initial object signal f =
eventOnSignal object signal f >>= hold initial
behaviorAfterSignal initial object signal f =
eventAfterSignal object signal f >>= hold initial
behaviorOnSignal1, behaviorAfterSignal1 :: ( MonadGtkSource t m
, MonadHold t m
, HaskellCallbackType info ~ (a -> IO ())
, GObject object
, SignalInfo info
)
=> a
-> object
-> SignalProxy object info
-> m (Behavior t a)
behaviorOnSignal1 initial object signal =
eventOnSignal1 object signal >>= hold initial
behaviorAfterSignal1 initial object signal =
eventAfterSignal1 object signal >>= hold initial
behaviorOnSignal1R, behaviorAfterSignal1R :: ( MonadGtkSource t m
, MonadHold t m
, HaskellCallbackType info ~ (a -> IO b)
, GObject object
, SignalInfo info
)
=> a
-> object
-> SignalProxy object info
-> b
-> m (Behavior t a)
behaviorOnSignal1R initial object signal result =
eventOnSignal1R object signal result >>= hold initial
behaviorAfterSignal1R initial object signal result =
eventAfterSignal1R object signal result >>= hold initial
dynamicOnSignal, dynamicAfterSignal :: ( MonadGtkSource t m
, MonadHold t m
, GObject object
, SignalInfo info
)
=> a
-> object
-> SignalProxy object info
-> ((a -> IO ()) -> HaskellCallbackType info)
-> m (Dynamic t a)
dynamicOnSignal initial object signal f =
eventOnSignal object signal f >>= holdDyn initial
dynamicAfterSignal initial object signal f =
eventAfterSignal object signal f >>= holdDyn initial
dynamicOnSignal1, dynamicAfterSignal1 :: ( MonadGtkSource t m
, MonadHold t m
, HaskellCallbackType info ~ (a -> IO ())
, GObject object
, SignalInfo info
)
=> a
-> object
-> SignalProxy object info
-> m (Dynamic t a)
dynamicOnSignal1 initial object signal =
eventOnSignal1 object signal >>= holdDyn initial
dynamicAfterSignal1 initial object signal =
eventAfterSignal1 object signal >>= holdDyn initial
dynamicOnSignal1R, dynamicAfterSignal1R :: ( MonadGtkSource t m
, MonadHold t m
, HaskellCallbackType info ~ (a -> IO b)
, GObject object
, SignalInfo info
)
=> a
-> object
-> SignalProxy object info
-> b
-> m (Dynamic t a)
dynamicOnSignal1R initial object signal result =
eventOnSignal1R object signal result >>= holdDyn initial
dynamicAfterSignal1R initial object signal result =
eventAfterSignal1R object signal result >>= holdDyn initial
eventOnAttribute, eventAfterAttribute :: ( MonadGtkSource t m
, AttrGetC info object attr value
, GObject object
, KnownSymbol (AttrLabel info)
)
=> object
-> AttrLabelProxy attr
-> m (Event t value)
eventOnAttribute object attr =
eventOnSignal object (PropertyNotify attr) $ \fire _ ->
get object attr >>= fire
eventAfterAttribute object attr =
eventAfterSignal object (PropertyNotify attr) $ \fire _ ->
get object attr >>= fire
behaviorOnAttribute, behaviorAfterAttribute :: ( MonadGtkSource t m
, MonadHold t m
, AttrGetC info object attr value
, GObject object
, KnownSymbol (AttrLabel info)
)
=> object
-> AttrLabelProxy attr
-> m (Behavior t value)
behaviorOnAttribute object attr = do
initial <- runGtk $ get object attr
eventOnAttribute object attr >>= hold initial
behaviorAfterAttribute object attr = do
initial <- runGtk $ get object attr
eventAfterAttribute object attr >>= hold initial
dynamicOnAttribute, dynamicAfterAttribute :: ( MonadGtkSource t m
, MonadHold t m
, AttrGetC info object attr value
, GObject object
, KnownSymbol (AttrLabel info)
)
=> object
-> AttrLabelProxy attr
-> m (Dynamic t value)
dynamicOnAttribute object attr = do
initial <- runGtk $ get object attr
eventOnAttribute object attr >>= holdDyn initial
dynamicAfterAttribute object attr = do
initial <- runGtk $ get object attr
eventAfterAttribute object attr >>= holdDyn initial