content: {-# LANGUAGE DataKinds             #-}
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE GADTs                 #-}
  {-# LANGUAGE LambdaCase            #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE RankNTypes            #-}
  {-# LANGUAGE ScopedTypeVariables   #-}
  {-# LANGUAGE TypeApplications      #-}
  {-# LANGUAGE TypeFamilies          #-}
  {-# LANGUAGE TypeOperators         #-}
  
  -- | A declarative representation of 'Gtk.Widget' in GTK without children.
  module GI.Gtk.Declarative.SingleWidget
    ( SingleWidget
    , widget
    )
  where
  
  import           Data.Typeable
  import           Data.Vector                    ( Vector )
  import qualified GI.Gtk                        as Gtk
  
  import           GI.Gtk.Declarative.Attributes
  import           GI.Gtk.Declarative.Attributes.Collected
  import           GI.Gtk.Declarative.Attributes.Internal
  import           GI.Gtk.Declarative.EventSource
  import           GI.Gtk.Declarative.Patch
  import           GI.Gtk.Declarative.State
  import           GI.Gtk.Declarative.Widget
  
  -- | Declarative version of a /leaf/ widget, i.e. a widget without any children.
  data SingleWidget widget event where
    SingleWidget
      ::(Typeable widget, Gtk.IsWidget widget, Functor (Attribute widget))
      => (Gtk.ManagedPtr widget -> widget)
      -> Vector (Attribute widget event)
      -> SingleWidget widget event
  
  instance Functor (SingleWidget widget) where
    fmap f (SingleWidget ctor attrs) = SingleWidget ctor (fmap f <$> attrs)
  
  instance Patchable (SingleWidget widget) where
    create = \case
      SingleWidget ctor attrs -> do
        let collected = collectAttributes attrs
        widget' <- Gtk.new ctor (constructProperties collected)
        Gtk.widgetShow widget'
        sc <- Gtk.widgetGetStyleContext widget'
        updateClasses sc mempty (collectedClasses collected)
        return
          (SomeState (StateTreeWidget (StateTreeNode widget' sc collected ())))
    patch (SomeState (st :: StateTree stateType w child event cs)) (SingleWidget (_ :: Gtk.ManagedPtr
        w1
      -> w1) _) (SingleWidget (ctor :: Gtk.ManagedPtr w2 -> w2) newAttributes)
      = case (st, eqT @w @w1, eqT @w1 @w2) of
        (StateTreeWidget top, Just Refl, Just Refl) ->
          let
            oldCollected      = stateTreeCollectedAttributes top
            newCollected      = collectAttributes newAttributes
            oldCollectedProps = collectedProperties oldCollected
            newCollectedProps = collectedProperties newCollected
          in
            if oldCollectedProps `canBeModifiedTo` newCollectedProps
              then Modify $ do
                let w = stateTreeWidget top
                updateProperties w oldCollectedProps newCollectedProps
                updateClasses (stateTreeStyleContext top)
                              (collectedClasses oldCollected)
                              (collectedClasses newCollected)
                let top' = top { stateTreeCollectedAttributes = newCollected }
                return
                  (SomeState
                    (StateTreeWidget top'
                      { stateTreeCollectedAttributes = newCollected
                      }
                    )
                  )
              else Replace (create (SingleWidget ctor newAttributes))
        _ -> Replace (create (SingleWidget ctor newAttributes))
  
  instance EventSource (SingleWidget widget) where
    subscribe (SingleWidget (_ :: Gtk.ManagedPtr w1 -> w1) props) (SomeState (st :: StateTree
        stateType
        w2
        child
        event
        cs)) cb
      = case (st, eqT @w1 @w2) of
        (StateTreeWidget top, Just Refl) ->
          foldMap (addSignalHandler cb (stateTreeWidget top)) props
        _ -> pure (fromCancellation (pure ()))
  
  -- instance (Typeable widget, Functor (SingleWidget widget))
  --   => FromWidget (SingleWidget widget) Widget where
  --   fromWidget = Widget
  
  -- | Construct a /leaf/ widget, i.e. one without any children.
  widget
    :: ( Typeable widget
       , Gtk.IsWidget widget
       , FromWidget (SingleWidget widget) target
       )
    => (Gtk.ManagedPtr widget -> widget) -- ^ A widget constructor from the underlying gi-gtk library.
    -> Vector (Attribute widget event)   -- ^ List of 'Attribute's.
    -> target event                      -- ^ The target, whose type is decided by 'FromWidget'.
  widget ctor = fromWidget . SingleWidget ctor
  