content: {-# LANGUAGE DataKinds  #-}
  {-# LANGUAGE ScopedTypeVariables  #-}
  {-# LANGUAGE GADTs      #-}
  {-# LANGUAGE LambdaCase #-}
  
  -- | Internal helpers for applying attributes and signal handlers to GTK+
  -- widgets.
  module GI.Gtk.Declarative.Attributes.Internal
    ( addSignalHandler
    )
  where
  
  import           Control.Monad                  ( (>=>) )
  import           Control.Monad.IO.Class         ( MonadIO )
  import qualified GI.GObject                    as GI
  import qualified GI.Gtk                        as Gtk
  
  import           GI.Gtk.Declarative.Attributes
  import           GI.Gtk.Declarative.Attributes.Internal.Conversions
  import           GI.Gtk.Declarative.EventSource
  
  addSignalHandler
    :: (Gtk.IsWidget widget, MonadIO m)
    => (event -> IO ())
    -> widget
    -> Attribute widget event
    -> m Subscription
  addSignalHandler onEvent widget' = listenToSignal >=> \case
    Just eh -> setupCancellation eh
    Nothing -> pure mempty
   where
    listenToSignal = \case
      OnSignalPure signal handler ->
        Just <$> Gtk.on widget' signal (toGtkCallback handler widget' onEvent)
      OnSignalImpure signal handler ->
        Just <$> Gtk.on widget' signal (toGtkCallback handler widget' onEvent)
      _ -> pure Nothing
    setupCancellation handlerId = do
      w <- Gtk.toWidget widget'
      pure (fromCancellation (GI.signalHandlerDisconnect w handlerId))
  