content: {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  {-# LANGUAGE DataKinds             #-}
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE GADTs                 #-}
  {-# LANGUAGE LambdaCase            #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedLabels      #-}
  {-# LANGUAGE OverloadedLists       #-}
  {-# LANGUAGE ScopedTypeVariables   #-}
  {-# LANGUAGE TypeFamilies          #-}
  {-# LANGUAGE TypeOperators         #-}
  
  -- | This module implements the patch algorithm for containers.
  module GI.Gtk.Declarative.Container.Patch
    ( IsContainer(..)
    , patchInContainer
    )
  where
  
  import           Data.Foldable                  ( foldMap )
  import           Data.Vector                    ( Vector
                                                  , (!?)
                                                  )
  import qualified Data.Vector                   as Vector
  import qualified GI.Gtk                        as Gtk
  
  import           GI.Gtk.Declarative.Container.Class
  import           GI.Gtk.Declarative.Patch
  import           GI.Gtk.Declarative.State
  
  -- | Patch all children in a container. This does not feature any ID checking,
  -- as seen in React, so reordering children in a container can produce many
  -- updates.
  patchInContainer
    :: ( Gtk.IsWidget container
       , Gtk.IsContainer container
       , Patchable child
       , IsContainer container child
       )
    => StateTree 'ContainerState container child event cs
    -> container
    -> Vector (child e1)
    -> Vector (child e2)
    -> IO (StateTree 'ContainerState container child event cs)
  patchInContainer (StateTreeContainer top children) container os' ns' = do
    let maxLength = maximum ([length children, length os', length ns'] :: [Int])
        indices   = Vector.enumFromN 0 (fromIntegral maxLength)
    newChildren <- foldMap
      go
      (Vector.zip4 indices
                   (padMaybes maxLength children)
                   (padMaybes maxLength os')
                   (padMaybes maxLength ns')
      )
  
    Gtk.widgetQueueResize container
    return (StateTreeContainer top newChildren)
   where
    go = \case
      -- In case we have a corresponding old and new declarative widget, we patch
      -- the GTK widget.
      (i, Just oldChildState, Just old, Just new) ->
        case patch oldChildState old new of
          Modify  modify       -> pure <$> modify
          Replace createWidget -> do
            newChildState  <- createWidget
            oldChildWidget <- someStateWidget oldChildState
            newChildWidget <- someStateWidget newChildState
            replaceChild container new i oldChildWidget newChildWidget
            return (pure newChildState)
          Keep -> return (pure oldChildState)
  
      -- When there is a new declarative widget, but there already exists a GTK
      -- widget in the corresponding place, we need to replace the GTK widget with
      -- one created from the declarative widget.
      (i, Just oldChildState, Nothing, Just new) -> do
        newChildState  <- create new
        oldChildWidget <- someStateWidget oldChildState
        newChildWidget <- someStateWidget newChildState
        replaceChild container new i oldChildWidget newChildWidget
        return (Vector.singleton newChildState)
  
      -- When there is a new declarative widget, or one that lacks a corresponding
      -- GTK widget, create and add it.
      (_i, Nothing, _, Just n) -> do
        newChildState <- create n
        w             <- someStateWidget newChildState
        appendChild container n w
        return (Vector.singleton newChildState)
  
      -- When a declarative widget has been removed, remove the GTK widget from
      -- the container.
      (_i, Just childState, Just _, Nothing) -> do
        Gtk.widgetDestroy =<< someStateWidget childState
        return Vector.empty
  
      -- When there are more old declarative widgets than GTK widgets, we can
      -- safely ignore the old declarative widgets.
      (_i, Nothing        , Just _ , Nothing) -> return Vector.empty
  
      -- But, when there are stray GTK widgets without corresponding
      -- declarative widgets, something has gone wrong, and we clean that up by
      -- removing the GTK widgets.
      (_i, Just childState, Nothing, Nothing) -> do
        Gtk.widgetDestroy =<< someStateWidget childState
        return Vector.empty
  
      -- No more GTK widgets or declarative widgets, we are done.
      (_i, Nothing, Nothing, Nothing) -> return Vector.empty
  
  padMaybes :: Int -> Vector a -> Vector (Maybe a)
  padMaybes len xs = Vector.generate len (xs !?)
  