-- 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