{-|
Module      : Monomer.Widgets.Container
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Helper for creating widgets with children elements.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Monomer.Widgets.Container (
  -- * Re-exported modules
  module Monomer.Core,
  module Monomer.Core.Combinators,
  module Monomer.Event,
  module Monomer.Graphics,
  module Monomer.Widgets.Util,

  -- * Configuration
  ContainerGetBaseStyle,
  ContainerGetCurrentStyle,
  ContainerCreateContainerFromModel,
  ContainerUpdateCWenvHandler,
  ContainerInitHandler,
  ContainerInitPostHandler,
  ContainerMergeChildrenReqHandler,
  ContainerMergeHandler,
  ContainerMergePostHandler,
  ContainerDisposeHandler,
  ContainerFindNextFocusHandler,
  ContainerFindByPointHandler,
  ContainerFilterHandler,
  ContainerEventHandler,
  ContainerMessageHandler,
  ContainerGetSizeReqHandler,
  ContainerResizeHandler,
  ContainerRenderHandler,
  Container(..),
  updateWenvOffset,

  -- * Constructors
  createContainer
) where

import Control.Applicative ((<|>))
import Control.Exception (AssertionFailed(..), throw)
import Control.Lens ((&), (^.), (^?), (.~), (%~), (<>~), _Just)
import Control.Monad
import Data.Default
import Data.Foldable (fold, foldl')
import Data.Maybe
import Data.Map.Strict (Map)
import Data.Typeable (Typeable)
import Data.Sequence (Seq(..), (<|), (|>))

import qualified Data.Map.Strict as M
import qualified Data.Sequence as Seq

import Monomer.Core
import Monomer.Core.Combinators
import Monomer.Event
import Monomer.Graphics
import Monomer.Widgets.Util

import qualified Monomer.Lens as L

{-|
Returns the base style for this type of widget.

Usually this style comes from the active theme.
-}
type ContainerGetBaseStyle s e
  = GetBaseStyle s e  -- ^ The base style for a new node.

{-|
Returns the active style for this type of widget. It depends on the state of
the widget, which can be:

- Basic
- Hovered
- Focused
- Hovered and Focused
- Active
- Disabled

In general there's no needed to override it, except when the widget does not use
the full content rect.

An example can be found in "Monomer.Widgets.Containers.Tooltip".
-}
type ContainerGetCurrentStyle s e
  = WidgetEnv s e      -- ^ The widget environment.
  -> WidgetNode s e    -- ^ The widget node.
  -> StyleState        -- ^ The active style for the node.

{-|
Returns an updated version of the Container instance. Currently only used
during merge. Not needed in general, except for widgets that modify offset
or layout direction.

An example can be found in "Monomer.Widgets.Containers.Scroll".

Note:

Some widgets, scroll for example, provide offset/layout direction to the
Container instance; this information is passed down to children widgets in all
the lifecycle methods. During merge a problem arises: the new node has not yet
processed the old state and, since it is the Container whose merge function is
being invoked, it is not able to provide the correct offset/layout direction.
It is also not possible to directly extract this information from the old node,
because we have a Widget instance and not its Container instance. This function
provides a workaround for this.

This is a hacky solution; a more flexible dispatcher for Composite could avoid it.
-}
type ContainerCreateContainerFromModel s e a
  = WidgetEnv s e            -- ^ The widget environment.
  -> WidgetNode s e          -- ^ The widget node.
  -> a                       -- ^ The previous model.
  -> Maybe (Container s e a) -- ^ An updated Container instance.

{-|
Updates the widget environment before passing it down to children. This function
is called during the execution of all the widget functions. Useful for
restricting viewport or modifying other kind of contextual information.

An example can be found in "Monomer.Widgets.Containers.ThemeSwitch".
-}
type ContainerUpdateCWenvHandler s e
  = WidgetEnv s e    -- ^ The widget environment.
  -> WidgetNode s e  -- ^ The widget node.
  -> WidgetNode s e  -- ^ The child node.
  -> Int             -- ^ The index of the node.
  -> WidgetEnv s e   -- ^ The updated widget environment.

{-|
Initializes the given node. This could include rebuilding the widget in case
internal state needs to use model/environment information, generate user
events or make requests to the runtime.

An example can be found in "Monomer.Widgets.Containers.SelectList".

Most of the current containers serve layout purposes and don't need a custom
/init/.
-}
type ContainerInitHandler s e
  = WidgetEnv s e      -- ^ The widget environment.
  -> WidgetNode s e    -- ^ The widget node.
  -> WidgetResult s e  -- ^ The result of the init operation.

{-|
Allows making further operations after children have been initialized.

Note: if state was modified on 'containerInit', you should use the new state
provided as an argument, since the state referenced in the closure will be
outdated.
-}
type ContainerInitPostHandler s e a
  = WidgetEnv s e      -- ^ The widget environment.
  -> WidgetNode s e    -- ^ The widget node.
  -> a                 -- ^ The current state of the widget node.
  -> WidgetResult s e  -- ^ The result after children have been initialized.
  -> WidgetResult s e  -- ^ The result of the init post operation.

{-|
Returns whether merge is required for children. It's mostly used for performance
optimization.

An example can be found in "Monomer.Widgets.Containers.SelectList".
-}
type ContainerMergeChildrenReqHandler s e a
  = WidgetEnv s e    -- ^ The widget environment.
  -> WidgetNode s e  -- ^ The widget node.
  -> WidgetNode s e  -- ^ The previous widget node.
  -> a               -- ^ The state of the previous widget node.
  -> Bool            -- ^ True if widget is needed.

{-|
Merges the current node with the node it matched with during the merge process.
Receives the newly created node (whose *init* function is not called), the
previous node and the state extracted from that node. This process is widget
dependent, and may use or ignore the previous state depending on newly available
information.

In general, you want to at least keep the previous state unless the widget is
stateless or only consumes model/environment information.

Examples can be found in "Monomer.Widgets.Containers.Fade" and
"Monomer.Widgets.Containers.Tooltip". On the other hand,
"Monomer.Widgets.Containers.Grid" does not need to override merge since it's
stateless.
-}
type ContainerMergeHandler s e a
  = WidgetEnv s e      -- ^ The widget environment.
  -> WidgetNode s e    -- ^ The widget node.
  -> WidgetNode s e    -- ^ The previous widget node.
  -> a                 -- ^ The state of the previous widget node.
  -> WidgetResult s e  -- ^ The result of the merge operation.

{-|
Allows making further operations after children have been merged.

Examples can be found in "Monomer.Widgets.Containers.SelectList" and
"Monomer.Widgets.Containers.ZStack".

Note: if state was modified during merge, you should use the new state provided
as an argument, since the state referenced in the closure will be outdated.
-}
type ContainerMergePostHandler s e a
  = WidgetEnv s e      -- ^ The widget environment.
  -> WidgetNode s e    -- ^ The widget node.
  -> WidgetNode s e    -- ^ The previous widget node.
  -> a                 -- ^ The state of the previous widget node.
  -> a                 -- ^ The current state of the widget node.
  -> WidgetResult s e  -- ^ The result after children have been merged.
  -> WidgetResult s e  -- ^ The result of the merge post operation.

{-|
Disposes the current node. Only used by widgets which allocate resources during
/init/ or /merge/, and will usually involve requests to the runtime.

An example can be found "Monomer.Widgets.Containers.Dropdown".
-}
type ContainerDisposeHandler s e
  = WidgetEnv s e      -- ^ The widget environment.
  -> WidgetNode s e    -- ^ The widget node.
  -> WidgetResult s e  -- ^ The result of the dispose operation.

{-|
Returns the next focusable node. What next/previous is, depends on how the
container works. Moving right -> bottom is usually considered forward.
-}
type ContainerFindNextFocusHandler s e
  = WidgetEnv s e          -- ^ The widget environment.
  -> WidgetNode s e        -- ^ The widget node.
  -> FocusDirection        -- ^ The direction in which focus is moving.
  -> Path                  -- ^ The start path from which to search.
  -> Seq (WidgetNode s e)  -- ^ The next focusable node info.

{-|
Returns the currently hovered widget, if any. If the widget is rectangular and
uses the full content area, there is not need to override this function.

An example can be found "Monomer.Widgets.Containers.Dropdown".
-}
type ContainerFindByPointHandler s e
  = WidgetEnv s e    -- ^ The widget environment.
  -> WidgetNode s e  -- ^ The widget node.
  -> Path            -- ^ The start path from which to search.
  -> Point           -- ^ The point to test for.
  -> Maybe Int       -- ^ The hovered child index, if any.

{-|
Receives a System event and, optionally, modifies the event, its target, or
cancels the event propagation by returning null.

Examples can be found in "Monomer.Widgets.Containers.Base.LabeledItem".
-}
type ContainerFilterHandler s e
  = WidgetEnv s e               -- ^ The widget environment.
  -> WidgetNode s e             -- ^ The widget node.
  -> Path                       -- ^ The target path of the event.
  -> SystemEvent                -- ^ The SystemEvent to handle.
  -> Maybe (Path, SystemEvent)  -- ^ The optional modified event/target.

{-|
Receives a System event and, optionally, returns a result. This can include an
updated version of the widget (in case it has internal state), user events or
requests to the runtime.

Examples can be found in "Monomer.Widgets.Containers.Draggable" and
"Monomer.Widgets.Containers.Keystroke".
-}
type ContainerEventHandler s e
  = WidgetEnv s e              -- ^ The widget environment.
  -> WidgetNode s e            -- ^ The widget node.
  -> Path                      -- ^ The target path of the event.
  -> SystemEvent               -- ^ The SystemEvent to handle.
  -> Maybe (WidgetResult s e)  -- ^ The result of handling the event, if any.

{-|
Receives a message and, optionally, returns a result. This can include an
updated version of the widget (in case it has internal state), user events or
requests to the runtime. There is no validation regarding the message type, and
the widget should take care of _casting_ to the correct type using
"Data.Typeable.cast"

Examples can be found in "Monomer.Widgets.Containers.Fade" and
"Monomer.Widgets.Containers.Scroll".
-}
type ContainerMessageHandler s e
  = forall i . Typeable i
  => WidgetEnv s e             -- ^ The widget environment.
  -> WidgetNode s e            -- ^ The widget node.
  -> Path                      -- ^ The target path of the message.
  -> i                         -- ^ The message to handle.
  -> Maybe (WidgetResult s e)  -- ^ The result of handling the message, if any.

{-|
Returns the preferred size for the widget. This size should not include border
and padding; those are added automatically by Container.

This is called to update WidgetNodeInfo only at specific times.

Examples can be found in "Monomer.Widgets.Containers.Grid" and
"Monomer.Widgets.Containers.Stack".
-}
type ContainerGetSizeReqHandler s e
  = WidgetEnv s e          -- ^ The widget environment.
  -> WidgetNode s e        -- ^ The widget node.
  -> Seq (WidgetNode s e)  -- ^ The children widgets
  -> (SizeReq, SizeReq)    -- ^ The horizontal and vertical requirements.

{-|
Assigns space to children according to the Container's logic, returning a 'Seq'
of 'Rect's in the same order of the child widgets. If the container has a single
child it is not generally necessary to override this function. A new version of
the Container may be returned if state needs to be updated.

Examples can be found in "Monomer.Widgets.Containers.Grid" and
"Monomer.Widgets.Containers.Stack".

Note: if the Container's state depends on the current size, visibility should be
considered; since invisible nodes receive zero space, it may affect calculations
and cause unexpected behavior when the widget is made visible again. Examples
can be found in "Monomer.Widgets.Containers.Scroll" and
"Monomer.Widgets.Containers.Split".
-}
type ContainerResizeHandler s e
  = WidgetEnv s e                  -- ^ The widget environment.
  -> WidgetNode s e                -- ^ The widget node.
  -> Rect                          -- ^ The new viewport.
  -> Seq (WidgetNode s e)          -- ^ The children widgets
  -> (WidgetResult s e, Seq Rect)  -- ^ The result of resizing the widget.

{-|
Renders the widget's content using the given Renderer. In general, this method
needs to be overriden. There are two render methods: one runs before children,
the other one after.

Examples can be found in "Monomer.Widgets.Containers.Draggable" and
"Monomer.Widgets.Containers.Scroll".
-}
type ContainerRenderHandler s e
  = WidgetEnv s e      -- ^ The widget environment.
  -> WidgetNode s e    -- ^ The widget node.
  -> Renderer          -- ^ The renderer, providing low level drawing functions.
  -> IO ()             -- ^ The IO action with rendering instructions.

-- | Interface for Container widgets.
data Container s e a = Container {
  -- | True if border and padding should be added to size requirement. Defaults
  --   to True.
  Container s e a -> Bool
containerAddStyleReq :: Bool,
  -- | Offset to apply to children. This not only includes rendering, but also
  --   updating SystemEvents and all coordinate related functions.
  Container s e a -> Maybe Point
containerChildrenOffset :: Maybe Point,
  -- | Scissor to apply to child widgets. This is not the same as the widget
  --   enabled by containerUseScissor
  Container s e a -> Maybe Rect
containerChildrenScissor :: Maybe Rect,
  -- | If True, the container will render its background and border. In some
  --   cases passing rendering control to children is useful. Defaults to True.
  Container s e a -> Bool
containerDrawDecorations :: Bool,
  -- | The layout direction generated by this widget. If one is indicated, it
  --   can be used by widgets such as "Monomer.Widgets.Singles.Spacer"
  Container s e a -> LayoutDirection
containerLayoutDirection :: LayoutDirection,
  -- | If True, when none of the children is found under the pointer, indicates
  --   an event will not be handled. If False, the parent (i.e., current) widget
  --   will be returned. This is useful when using zstack and wanting for events
  --   to be handled in lower layers.
  Container s e a -> Bool
containerIgnoreEmptyArea :: Bool,
  -- | True if style cursor should be ignored. If it's False, cursor changes need
  --   to be handled in custom code. Defaults to False.
  Container s e a -> Bool
containerUseCustomCursor :: Bool,
  -- | If true, it will ignore extra space assigned by the parent container, but
  --   it will not use more space than assigned. Defaults to False.
  Container s e a -> Bool
containerUseCustomSize :: Bool,
  -- | If true, it will accept the size requested by children, restricted to the
  --   space already assigned.
  Container s e a -> Bool
containerUseChildrenSizes :: Bool,
  -- | True if automatic scissoring needs to be applied. Defaults to False.
  Container s e a -> Bool
containerUseScissor :: Bool,
  -- | Returns the base style for this type of widget.
  Container s e a -> ContainerGetBaseStyle s e
containerGetBaseStyle :: ContainerGetBaseStyle s e,
  -- | Returns an updated version of the Container instance.
  Container s e a -> ContainerCreateContainerFromModel s e a
containerCreateContainerFromModel :: ContainerCreateContainerFromModel s e a,
  -- | Returns the current style, depending on the status of the widget.
  Container s e a -> ContainerGetCurrentStyle s e
containerGetCurrentStyle :: ContainerGetCurrentStyle s e,
  -- | Updates the widget environment before passing it down to children.
  Container s e a -> ContainerUpdateCWenvHandler s e
containerUpdateCWenv :: ContainerUpdateCWenvHandler s e,
  -- | Initializes the given node.
  Container s e a -> ContainerInitHandler s e
containerInit :: ContainerInitHandler s e,
  -- | Allow for extra steps after children are initialized.
  Container s e a -> ContainerInitPostHandler s e a
containerInitPost :: ContainerInitPostHandler s e a,
  -- | Returns whether merge is required for children.
  Container s e a -> ContainerMergeChildrenReqHandler s e a
containerMergeChildrenReq :: ContainerMergeChildrenReqHandler s e a,
  -- | Merges the node with the node it matched with during the merge process.
  Container s e a -> ContainerMergeHandler s e a
containerMerge :: ContainerMergeHandler s e a,
  -- | Allow for extra steps after children are merged.
  Container s e a -> ContainerMergePostHandler s e a
containerMergePost :: ContainerMergePostHandler s e a,
  -- | Disposes the current node.
  Container s e a -> ContainerDisposeHandler s e
containerDispose :: ContainerDisposeHandler s e,
  -- | Returns the next focusable node.
  Container s e a -> ContainerFindNextFocusHandler s e
containerFindNextFocus :: ContainerFindNextFocusHandler s e,
  -- | Returns the currently hovered widget, if any.
  Container s e a -> ContainerFindByPointHandler s e
containerFindByPoint :: ContainerFindByPointHandler s e,
  -- | Receives a System event and, optionally, filters/modifies it.
  Container s e a -> ContainerFilterHandler s e
containerFilterEvent :: ContainerFilterHandler s e,
  -- | Receives a System event and, optionally, returns a result.
  Container s e a -> ContainerEventHandler s e
containerHandleEvent :: ContainerEventHandler s e,
  -- | Receives a message and, optionally, returns a result.
  Container s e a
-> forall i.
   Typeable i =>
   WidgetEnv s e
   -> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
containerHandleMessage :: ContainerMessageHandler s e,
  -- | Returns the preferred size for the widget.
  Container s e a -> ContainerGetSizeReqHandler s e
containerGetSizeReq :: ContainerGetSizeReqHandler s e,
  -- | Resizes the widget to the provided size.
  Container s e a -> ContainerResizeHandler s e
containerResize :: ContainerResizeHandler s e,
  -- | Renders the widget's content. This runs before childrens' render.
  Container s e a -> ContainerRenderHandler s e
containerRender :: ContainerRenderHandler s e,
  -- | Renders the widget's content. This runs after childrens' render.
  Container s e a -> ContainerRenderHandler s e
containerRenderAfter :: ContainerRenderHandler s e
}

instance Default (Container s e a) where
  def :: Container s e a
def = Container :: forall s e a.
Bool
-> Maybe Point
-> Maybe Rect
-> Bool
-> LayoutDirection
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ContainerGetBaseStyle s e
-> ContainerCreateContainerFromModel s e a
-> ContainerGetCurrentStyle s e
-> ContainerUpdateCWenvHandler s e
-> ContainerInitHandler s e
-> ContainerInitPostHandler s e a
-> ContainerMergeChildrenReqHandler s e a
-> ContainerMergeHandler s e a
-> ContainerMergePostHandler s e a
-> ContainerInitHandler s e
-> ContainerFindNextFocusHandler s e
-> ContainerFindByPointHandler s e
-> ContainerFilterHandler s e
-> ContainerEventHandler s e
-> ContainerMessageHandler s e
-> ContainerGetSizeReqHandler s e
-> ContainerResizeHandler s e
-> ContainerRenderHandler s e
-> ContainerRenderHandler s e
-> Container s e a
Container {
    containerAddStyleReq :: Bool
containerAddStyleReq = Bool
True,
    containerChildrenOffset :: Maybe Point
containerChildrenOffset = Maybe Point
forall a. Maybe a
Nothing,
    containerChildrenScissor :: Maybe Rect
containerChildrenScissor = Maybe Rect
forall a. Maybe a
Nothing,
    containerDrawDecorations :: Bool
containerDrawDecorations = Bool
True,
    containerLayoutDirection :: LayoutDirection
containerLayoutDirection = LayoutDirection
LayoutNone,
    containerIgnoreEmptyArea :: Bool
containerIgnoreEmptyArea = Bool
False,
    containerUseCustomCursor :: Bool
containerUseCustomCursor = Bool
False,
    containerUseCustomSize :: Bool
containerUseCustomSize = Bool
False,
    containerUseChildrenSizes :: Bool
containerUseChildrenSizes = Bool
False,
    containerUseScissor :: Bool
containerUseScissor = Bool
False,
    containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = ContainerGetBaseStyle s e
forall s e. ContainerGetBaseStyle s e
defaultGetBaseStyle,
    containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = ContainerGetCurrentStyle s e
forall s e. ContainerGetCurrentStyle s e
defaultGetCurrentStyle,
    containerCreateContainerFromModel :: ContainerCreateContainerFromModel s e a
containerCreateContainerFromModel = ContainerCreateContainerFromModel s e a
forall s e a. ContainerCreateContainerFromModel s e a
defaultCreateContainerFromModel,
    containerUpdateCWenv :: ContainerUpdateCWenvHandler s e
containerUpdateCWenv = ContainerUpdateCWenvHandler s e
forall s e. ContainerUpdateCWenvHandler s e
defaultUpdateCWenv,
    containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
forall s e. ContainerInitHandler s e
defaultInit,
    containerInitPost :: ContainerInitPostHandler s e a
containerInitPost = ContainerInitPostHandler s e a
forall s e a. ContainerInitPostHandler s e a
defaultInitPost,
    containerMergeChildrenReq :: ContainerMergeChildrenReqHandler s e a
containerMergeChildrenReq = ContainerMergeChildrenReqHandler s e a
forall s e a. ContainerMergeChildrenReqHandler s e a
defaultMergeRequired,
    containerMerge :: ContainerMergeHandler s e a
containerMerge = ContainerMergeHandler s e a
forall s e a. ContainerMergeHandler s e a
defaultMerge,
    containerMergePost :: ContainerMergePostHandler s e a
containerMergePost = ContainerMergePostHandler s e a
forall s e a. ContainerMergePostHandler s e a
defaultMergePost,
    containerDispose :: ContainerInitHandler s e
containerDispose = ContainerInitHandler s e
forall s e. ContainerInitHandler s e
defaultDispose,
    containerFindNextFocus :: ContainerFindNextFocusHandler s e
containerFindNextFocus = ContainerFindNextFocusHandler s e
forall s e. ContainerFindNextFocusHandler s e
defaultFindNextFocus,
    containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = ContainerFindByPointHandler s e
forall s e. ContainerFindByPointHandler s e
defaultFindByPoint,
    containerFilterEvent :: ContainerFilterHandler s e
containerFilterEvent = ContainerFilterHandler s e
forall s e. ContainerFilterHandler s e
defaultFilterEvent,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall s e. ContainerEventHandler s e
defaultHandleEvent,
    containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = ContainerMessageHandler s e
forall s e. ContainerMessageHandler s e
defaultHandleMessage,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
forall s e. ContainerGetSizeReqHandler s e
defaultGetSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall s e. ContainerResizeHandler s e
defaultResize,
    containerRender :: ContainerRenderHandler s e
containerRender = ContainerRenderHandler s e
forall s e. ContainerRenderHandler s e
defaultRender,
    containerRenderAfter :: ContainerRenderHandler s e
containerRenderAfter = ContainerRenderHandler s e
forall s e. ContainerRenderHandler s e
defaultRender
  }

{-|
Creates a widget based on the Container infrastructure. An initial state and the
Container definition need to be provided. In case internal state is not needed,
__()__ can be provided. Using the __def__ instance as a starting point is
recommended to focus on overriding only what is needed:

@
widget = createContainer () def {
  containerRender = ...
}
@
-}
createContainer
  :: WidgetModel a
  => a
  -> Container s e a
  -> Widget s e
createContainer :: a -> Container s e a -> Widget s e
createContainer !a
state !Container s e a
container = Widget :: forall s e.
(WidgetEnv s e -> WidgetNode s e -> WidgetResult s e)
-> (WidgetEnv s e
    -> WidgetNode s e -> WidgetNode s e -> WidgetResult s e)
-> (WidgetEnv s e -> WidgetNode s e -> WidgetResult s e)
-> (WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState)
-> (WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode)
-> (WidgetEnv s e
    -> WidgetNode s e
    -> FocusDirection
    -> Path
    -> Maybe WidgetNodeInfo)
-> (WidgetEnv s e
    -> WidgetNode s e -> Path -> Point -> Maybe WidgetNodeInfo)
-> (WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo)
-> (WidgetEnv s e
    -> WidgetNode s e
    -> Path
    -> SystemEvent
    -> Maybe (WidgetResult s e))
-> (forall i.
    Typeable i =>
    WidgetEnv s e
    -> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e))
-> (WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq))
-> (WidgetEnv s e
    -> WidgetNode s e -> Rect -> (Path -> Bool) -> WidgetResult s e)
-> (WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ())
-> Widget s e
Widget {
  widgetInit :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
initWrapper Container s e a
container,
  widgetMerge :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> WidgetResult s e
widgetMerge = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
mergeWrapper Container s e a
container,
  widgetDispose :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetDispose = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
disposeWrapper Container s e a
container,
  widgetGetState :: WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState = a -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
forall i s e.
WidgetModel i =>
i -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
makeState a
state,
  widgetGetInstanceTree :: WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
widgetGetInstanceTree = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
getInstanceTreeWrapper Container s e a
container,
  widgetFindNextFocus :: WidgetEnv s e
-> WidgetNode s e -> FocusDirection -> Path -> Maybe WidgetNodeInfo
widgetFindNextFocus = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
forall s e a.
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
findNextFocusWrapper Container s e a
container,
  widgetFindByPoint :: WidgetEnv s e
-> WidgetNode s e -> Path -> Point -> Maybe WidgetNodeInfo
widgetFindByPoint = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
forall s e a.
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
findByPointWrapper Container s e a
container,
  widgetFindBranchByPath :: WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
widgetFindBranchByPath = WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
containerFindBranchByPath,
  widgetHandleEvent :: WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
widgetHandleEvent = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
handleEventWrapper Container s e a
container,
  widgetHandleMessage :: forall i.
Typeable i =>
WidgetEnv s e
-> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
widgetHandleMessage = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> i
-> Maybe (WidgetResult s e)
forall a i s e.
(WidgetModel a, Typeable i) =>
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> i
-> Maybe (WidgetResult s e)
handleMessageWrapper Container s e a
container,
  widgetGetSizeReq :: WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
widgetGetSizeReq = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReqWrapper Container s e a
container,
  widgetResize :: WidgetEnv s e
-> WidgetNode s e -> Rect -> (Path -> Bool) -> WidgetResult s e
widgetResize = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
resizeWrapper Container s e a
container,
  widgetRender :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
renderWrapper Container s e a
container
}

-- | Get base style for component
defaultGetBaseStyle :: ContainerGetBaseStyle s e
defaultGetBaseStyle :: ContainerGetBaseStyle s e
defaultGetBaseStyle WidgetEnv s e
wenv WidgetNode s e
node = Maybe Style
forall a. Maybe a
Nothing

defaultGetCurrentStyle :: ContainerGetCurrentStyle s e
defaultGetCurrentStyle :: ContainerGetCurrentStyle s e
defaultGetCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node = ContainerGetCurrentStyle s e
forall s e. ContainerGetCurrentStyle s e
currentStyle WidgetEnv s e
wenv WidgetNode s e
node

defaultCreateContainerFromModel :: ContainerCreateContainerFromModel s e a
defaultCreateContainerFromModel :: ContainerCreateContainerFromModel s e a
defaultCreateContainerFromModel WidgetEnv s e
wenv WidgetNode s e
node a
state = Maybe (Container s e a)
forall a. Maybe a
Nothing

defaultUpdateCWenv :: ContainerUpdateCWenvHandler s e
defaultUpdateCWenv :: ContainerUpdateCWenvHandler s e
defaultUpdateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
cnode Int
cidx = WidgetEnv s e
wenv

getUpdateCWenv
  :: Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> WidgetNode s e
  -> Int
  -> WidgetEnv s e
getUpdateCWenv :: Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
getUpdateCWenv Container s e a
container !WidgetEnv s e
wenv !WidgetNode s e
node !WidgetNode s e
cnode !Int
cidx = WidgetEnv s e
newWenv where
  cOffset :: Maybe Point
cOffset = Container s e a -> Maybe Point
forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
containerUpdateCWenv Container s e a
container
  layoutDirection :: LayoutDirection
layoutDirection = Container s e a -> LayoutDirection
forall s e a. Container s e a -> LayoutDirection
containerLayoutDirection Container s e a
container

  pViewport :: Rect
pViewport = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
  cViewport :: Rect
cViewport = WidgetNode s e
cnode WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
  newViewport :: Rect
newViewport = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
forall a. Default a => a
def (Rect -> Rect -> Maybe Rect
intersectRects Rect
pViewport Rect
cViewport)

  offsetWenv :: WidgetEnv s e -> WidgetEnv s e
offsetWenv !WidgetEnv s e
wenv
    | Maybe Point -> Bool
forall a. Maybe a -> Bool
isJust Maybe Point
cOffset = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
updateWenvOffset Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node Rect
newViewport
    | Bool
otherwise = WidgetEnv s e
wenv
  !directionWenv :: WidgetEnv s e
directionWenv = WidgetEnv s e
wenv
    WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (LayoutDirection -> Identity LayoutDirection)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasLayoutDirection s a => Lens' s a
L.layoutDirection ((LayoutDirection -> Identity LayoutDirection)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> LayoutDirection -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LayoutDirection
layoutDirection

  !newWenv :: WidgetEnv s e
newWenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv (WidgetEnv s e -> WidgetEnv s e
offsetWenv WidgetEnv s e
directionWenv) WidgetNode s e
node WidgetNode s e
cnode Int
cidx

{-|
Helper function that updates widget environment based on current container
information. In case the created container needs to pass information down using
wenv, it should call this function first and update the resulting wenv.
-}
updateWenvOffset
  :: Container s e a  -- ^ The container config
  -> WidgetEnv s e    -- ^ The widget environment.
  -> WidgetNode s e   -- ^ The widget node.
  -> Rect             -- ^ The target viewport.
  -> WidgetEnv s e    -- ^ THe updated widget environment.
updateWenvOffset :: Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
updateWenvOffset Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport = WidgetEnv s e
newWenv where
  cOffset :: Maybe Point
cOffset = Container s e a -> Maybe Point
forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container
  offset :: Point
offset = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
forall a. Default a => a
def Maybe Point
cOffset

  updateMain :: (Path, Point) -> (Path, Point)
updateMain (Path
path, Point
point)
    | WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath WidgetNode s e
node Path
path = (Path
path, Point -> Point -> Point
addPoint (Point -> Point
negPoint Point
offset) Point
point)
    | Bool
otherwise = (Path
path, Point
point)

  newWenv :: WidgetEnv s e
newWenv = WidgetEnv s e
wenv
    WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Identity Rect)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> Rect -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point -> Rect -> Rect
moveRect (Point -> Point
negPoint Point
offset) Rect
viewport
    WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (InputStatus -> Identity InputStatus)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Identity InputStatus)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> ((Point -> Identity Point)
    -> InputStatus -> Identity InputStatus)
-> (Point -> Identity Point)
-> WidgetEnv s e
-> Identity (WidgetEnv s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Identity Point) -> InputStatus -> Identity InputStatus
forall s a. HasMousePos s a => Lens' s a
L.mousePos ((Point -> Identity Point)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> (Point -> Point) -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point -> Point -> Point
addPoint (Point -> Point
negPoint Point
offset)
    WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (InputStatus -> Identity InputStatus)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Identity InputStatus)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> ((Point -> Identity Point)
    -> InputStatus -> Identity InputStatus)
-> (Point -> Identity Point)
-> WidgetEnv s e
-> Identity (WidgetEnv s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Identity Point) -> InputStatus -> Identity InputStatus
forall s a. HasMousePosPrev s a => Lens' s a
L.mousePosPrev ((Point -> Identity Point)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> (Point -> Point) -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point -> Point -> Point
addPoint (Point -> Point
negPoint Point
offset)
    WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Point -> Identity Point)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasOffset s a => Lens' s a
L.offset ((Point -> Identity Point)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> (Point -> Point) -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point -> Point -> Point
addPoint Point
offset
    WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Maybe (Path, Point) -> Identity (Maybe (Path, Point)))
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress ((Maybe (Path, Point) -> Identity (Maybe (Path, Point)))
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> (Maybe (Path, Point) -> Maybe (Path, Point))
-> WidgetEnv s e
-> WidgetEnv s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Path, Point) -> (Path, Point))
-> Maybe (Path, Point) -> Maybe (Path, Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path, Point) -> (Path, Point)
updateMain

-- | Init handler
defaultInit :: ContainerInitHandler s e
defaultInit :: ContainerInitHandler s e
defaultInit WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

defaultInitPost :: ContainerInitPostHandler s e a
defaultInitPost :: ContainerInitPostHandler s e a
defaultInitPost WidgetEnv s e
wenv WidgetNode s e
node a
state WidgetResult s e
result = WidgetResult s e
result

initWrapper
  :: WidgetModel a
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> WidgetResult s e
initWrapper :: Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
initWrapper Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
  initHandler :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
initHandler = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
containerInit Container s e a
container
  initPostHandler :: ContainerInitPostHandler s e a
initPostHandler = Container s e a -> ContainerInitPostHandler s e a
forall s e a. Container s e a -> ContainerInitPostHandler s e a
containerInitPost Container s e a
container
  getBaseStyle :: ContainerGetBaseStyle s e
getBaseStyle = Container s e a -> ContainerGetBaseStyle s e
forall s e a. Container s e a -> ContainerGetBaseStyle s e
containerGetBaseStyle Container s e a
container
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container

  styledNode :: WidgetNode s e
styledNode = ContainerGetBaseStyle s e
-> WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall s e.
GetBaseStyle s e
-> WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
initNodeStyle ContainerGetBaseStyle s e
getBaseStyle WidgetEnv s e
wenv WidgetNode s e
node
  WidgetResult WidgetNode s e
tempNode Seq (WidgetRequest s e)
reqs = WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
initHandler WidgetEnv s e
wenv WidgetNode s e
styledNode
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
tempNode WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
  initChild :: Int -> WidgetNode s e -> WidgetResult s e
initChild Int
idx WidgetNode s e
child = Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit Widget s e
newWidget WidgetEnv s e
cwenv WidgetNode s e
newChild where
    newChild :: WidgetNode s e
newChild = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
forall s e.
WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
cascadeCtx WidgetEnv s e
wenv WidgetNode s e
tempNode WidgetNode s e
child Int
idx
    cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
newChild Int
idx
    newWidget :: Widget s e
newWidget = WidgetNode s e
newChild WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget
  results :: Seq (WidgetResult s e)
results = (Int -> WidgetNode s e -> WidgetResult s e)
-> Seq (WidgetNode s e) -> Seq (WidgetResult s e)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> WidgetNode s e -> WidgetResult s e
initChild Seq (WidgetNode s e)
children
  newReqs :: Seq (WidgetRequest s e)
newReqs = (WidgetResult s e -> Seq (WidgetRequest s e))
-> Seq (WidgetResult s e) -> Seq (WidgetRequest s e)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests Seq (WidgetResult s e)
results
  newChildren :: Seq (WidgetNode s e)
newChildren = (WidgetResult s e -> WidgetNode s e)
-> Seq (WidgetResult s e) -> Seq (WidgetNode s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WidgetResult s e -> WidgetNode s e
forall s e. WidgetResult s e -> WidgetNode s e
_wrNode Seq (WidgetResult s e)
results
  newNode :: WidgetNode s e
newNode = WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv (WidgetNode s e -> WidgetNode s e)
-> WidgetNode s e -> WidgetNode s e
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
tempNode
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode s e)
newChildren

  tmpResult :: WidgetResult s e
tmpResult = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
newNode (Seq (WidgetRequest s e)
reqs Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
newReqs)
  newState :: Maybe WidgetState
newState = Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
newNode WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
newNode
  result :: WidgetResult s e
result = case Maybe WidgetState -> Maybe a
forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
newState of
    Just a
st -> ContainerInitPostHandler s e a
initPostHandler WidgetEnv s e
wenv WidgetNode s e
newNode a
st WidgetResult s e
tmpResult
    Maybe a
Nothing -> WidgetResult s e
tmpResult

-- | Merging
defaultMergeRequired :: ContainerMergeChildrenReqHandler s e a
defaultMergeRequired :: ContainerMergeChildrenReqHandler s e a
defaultMergeRequired WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode a
oldState = Bool
True

defaultMerge :: ContainerMergeHandler s e a
defaultMerge :: ContainerMergeHandler s e a
defaultMerge WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode a
oldState = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode

defaultMergePost :: ContainerMergePostHandler s e a
defaultMergePost :: ContainerMergePostHandler s e a
defaultMergePost WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode a
oldState a
newState WidgetResult s e
result = WidgetResult s e
result

mergeWrapper
  :: WidgetModel a
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> WidgetNode s e
  -> WidgetResult s e
mergeWrapper :: Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
mergeWrapper Container s e a
container WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode = WidgetResult s e
newResult where
  getBaseStyle :: ContainerGetBaseStyle s e
getBaseStyle = Container s e a -> ContainerGetBaseStyle s e
forall s e a. Container s e a -> ContainerGetBaseStyle s e
containerGetBaseStyle Container s e a
container
  createContainerFromModel :: ContainerCreateContainerFromModel s e a
createContainerFromModel = Container s e a -> ContainerCreateContainerFromModel s e a
forall s e a.
Container s e a -> ContainerCreateContainerFromModel s e a
containerCreateContainerFromModel Container s e a
container

  mergeRequiredHandler :: ContainerMergeChildrenReqHandler s e a
mergeRequiredHandler = Container s e a -> ContainerMergeChildrenReqHandler s e a
forall s e a.
Container s e a -> ContainerMergeChildrenReqHandler s e a
containerMergeChildrenReq Container s e a
container
  mergeHandler :: ContainerMergeHandler s e a
mergeHandler = Container s e a -> ContainerMergeHandler s e a
forall s e a. Container s e a -> ContainerMergeHandler s e a
containerMerge Container s e a
container
  mergePostHandler :: ContainerMergePostHandler s e a
mergePostHandler = Container s e a -> ContainerMergePostHandler s e a
forall s e a. Container s e a -> ContainerMergePostHandler s e a
containerMergePost Container s e a
container

  oldState :: Maybe WidgetState
oldState = Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
oldNode WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
oldNode
  mergeRequired :: Bool
mergeRequired = case Maybe WidgetState -> Maybe a
forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
oldState of
    Just a
ostate -> ContainerMergeChildrenReqHandler s e a
mergeRequiredHandler WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode a
ostate
    Maybe a
Nothing -> Bool
True

  styledNode :: WidgetNode s e
styledNode = ContainerGetBaseStyle s e
-> WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall s e.
GetBaseStyle s e
-> WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
initNodeStyle ContainerGetBaseStyle s e
getBaseStyle WidgetEnv s e
wenv WidgetNode s e
newNode

  -- Check if an updated container can be used for offset/layout direction.
  pNode :: WidgetNode s e
pNode = WidgetResult s e
pResult WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = case Maybe WidgetState -> Maybe a
forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
oldState Maybe a
-> (a -> Maybe (Container s e a)) -> Maybe (Container s e a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ContainerCreateContainerFromModel s e a
createContainerFromModel WidgetEnv s e
wenv WidgetNode s e
pNode of
    Just Container s e a
newContainer -> Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
newContainer
    Maybe (Container s e a)
_ -> Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  cWenvHelper :: Int -> WidgetNode s e -> WidgetEnv s e
cWenvHelper Int
idx WidgetNode s e
child = WidgetEnv s e
cwenv where
    cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
pNode WidgetNode s e
child Int
idx

  pResult :: WidgetResult s e
pResult = ContainerMergeHandler s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Maybe WidgetState
-> WidgetResult s e
forall a s e.
WidgetModel a =>
ContainerMergeHandler s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Maybe WidgetState
-> WidgetResult s e
mergeParent ContainerMergeHandler s e a
mergeHandler WidgetEnv s e
wenv WidgetNode s e
styledNode WidgetNode s e
oldNode Maybe WidgetState
oldState
  cResult :: WidgetResult s e
cResult = (Int -> WidgetNode s e -> WidgetEnv s e)
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
-> WidgetResult s e
forall s e.
(Int -> WidgetNode s e -> WidgetEnv s e)
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
-> WidgetResult s e
mergeChildren Int -> WidgetNode s e -> WidgetEnv s e
cWenvHelper WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode WidgetResult s e
pResult
  vResult :: WidgetResult s e
vResult = WidgetNode s e -> WidgetResult s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e -> WidgetResult s e
mergeChildrenCheckVisible WidgetNode s e
oldNode WidgetResult s e
cResult

  flagsChanged :: Bool
flagsChanged = WidgetNode s e -> WidgetNode s e -> Bool
forall s e. WidgetNode s e -> WidgetNode s e -> Bool
nodeFlagsChanged WidgetNode s e
oldNode WidgetNode s e
newNode
  themeChanged :: Bool
themeChanged = WidgetEnv s e
wenv WidgetEnv s e -> Getting Bool (WidgetEnv s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (WidgetEnv s e) Bool
forall s a. HasThemeChanged s a => Lens' s a
L.themeChanged
  mResult :: WidgetResult s e
mResult
    | Bool
mergeRequired Bool -> Bool -> Bool
|| Bool
flagsChanged Bool -> Bool -> Bool
|| Bool
themeChanged = WidgetResult s e
vResult
    | Bool
otherwise = WidgetResult s e
pResult WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Identity (WidgetNode s e))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
    -> WidgetNode s e -> Identity (WidgetNode s e))
-> (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetResult s e
-> Identity (WidgetResult s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetNode s e) -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNode s e
oldNode WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children

  mNode :: WidgetNode s e
mNode = WidgetResult s e
mResult WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node
  mState :: Maybe WidgetState
mState = Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
mNode WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
mNode
  postRes :: WidgetResult s e
postRes = case (,) (a -> a -> (a, a)) -> Maybe a -> Maybe (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe WidgetState -> Maybe a
forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
oldState Maybe (a -> (a, a)) -> Maybe a -> Maybe (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe WidgetState -> Maybe a
forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
mState of
    Just (a
ost, a
st) -> ContainerMergePostHandler s e a
mergePostHandler WidgetEnv s e
wenv WidgetNode s e
mNode WidgetNode s e
oldNode a
ost a
st WidgetResult s e
mResult
    Maybe (a, a)
Nothing -> WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetResult s e
mResult WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node)

  tmpResult :: WidgetResult s e
tmpResult
    | Maybe (WidgetResult s e) -> Bool
forall s e. Maybe (WidgetResult s e) -> Bool
isResizeAnyResult (WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
postRes) = WidgetResult s e
postRes
        WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Identity (WidgetNode s e))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> WidgetNode s e -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv (WidgetResult s e
postRes WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node)
    | Bool
otherwise = WidgetResult s e
postRes
  newResult :: WidgetResult s e
newResult = WidgetNode s e -> WidgetResult s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e -> WidgetResult s e
handleWidgetIdChange WidgetNode s e
oldNode WidgetResult s e
tmpResult

mergeParent
  :: WidgetModel a
  => ContainerMergeHandler s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> WidgetNode s e
  -> Maybe WidgetState
  -> WidgetResult s e
mergeParent :: ContainerMergeHandler s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Maybe WidgetState
-> WidgetResult s e
mergeParent ContainerMergeHandler s e a
mergeHandler WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode Maybe WidgetState
oldState = WidgetResult s e
result where
  oldInfo :: WidgetNodeInfo
oldInfo = WidgetNode s e
oldNode WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
  tempNode :: WidgetNode s e
tempNode = WidgetNode s e
newNode
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((WidgetId -> Identity WidgetId)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (WidgetId -> Identity WidgetId)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Identity WidgetId)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId ((WidgetId -> Identity WidgetId)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetId -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo WidgetNodeInfo
-> Getting WidgetId WidgetNodeInfo WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Rect -> Identity Rect)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Rect -> Identity Rect)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Identity Rect)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Identity Rect)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Rect -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo WidgetNodeInfo
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Rect
forall s a. s -> Getting a s a -> a
^. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((SizeReq -> Identity SizeReq)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (SizeReq -> Identity SizeReq)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Identity SizeReq)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW ((SizeReq -> Identity SizeReq)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> SizeReq -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo WidgetNodeInfo -> Getting SizeReq WidgetNodeInfo SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. Getting SizeReq WidgetNodeInfo SizeReq
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((SizeReq -> Identity SizeReq)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (SizeReq -> Identity SizeReq)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Identity SizeReq)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH ((SizeReq -> Identity SizeReq)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> SizeReq -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo WidgetNodeInfo -> Getting SizeReq WidgetNodeInfo SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. Getting SizeReq WidgetNodeInfo SizeReq
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
  result :: WidgetResult s e
result = case Maybe WidgetState -> Maybe a
forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
oldState of
    Just a
ostate -> ContainerMergeHandler s e a
mergeHandler WidgetEnv s e
wenv WidgetNode s e
tempNode WidgetNode s e
oldNode a
ostate
    Maybe a
Nothing -> WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
tempNode

mergeChildren
  :: (Int -> WidgetNode s e -> WidgetEnv s e)
  -> WidgetEnv s e
  -> WidgetNode s e
  -> WidgetNode s e
  -> WidgetResult s e
  -> WidgetResult s e
mergeChildren :: (Int -> WidgetNode s e -> WidgetEnv s e)
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
-> WidgetResult s e
mergeChildren Int -> WidgetNode s e -> WidgetEnv s e
updateCWenv !WidgetEnv s e
wenv !WidgetNode s e
newNode !WidgetNode s e
oldNode !WidgetResult s e
pResult = WidgetResult s e
newResult where
  WidgetResult WidgetNode s e
pNode Seq (WidgetRequest s e)
pReqs = WidgetResult s e
pResult
  oldChildren :: Seq (WidgetNode s e)
oldChildren = WidgetNode s e
oldNode WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
  oldIts :: Seq (Int, WidgetNode s e)
oldIts = (Int -> WidgetNode s e -> (Int, WidgetNode s e))
-> Seq (WidgetNode s e) -> Seq (Int, WidgetNode s e)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex (,) Seq (WidgetNode s e)
oldChildren
  updatedChildren :: Seq (WidgetNode s e)
updatedChildren = WidgetNode s e
pNode WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children

  mergeChild :: Int -> WidgetNode s e -> (Int, WidgetNode s e)
mergeChild Int
idx WidgetNode s e
child = (Int
idx, WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
forall s e.
WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
cascadeCtx WidgetEnv s e
wenv WidgetNode s e
pNode WidgetNode s e
child Int
idx)
  newIts :: Seq (Int, WidgetNode s e)
newIts = (Int -> WidgetNode s e -> (Int, WidgetNode s e))
-> Seq (WidgetNode s e) -> Seq (Int, WidgetNode s e)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> WidgetNode s e -> (Int, WidgetNode s e)
mergeChild Seq (WidgetNode s e)
updatedChildren
  oldKeys :: Map WidgetKey (WidgetNode s e)
oldKeys = Seq (WidgetNode s e) -> Map WidgetKey (WidgetNode s e)
forall s e. Seq (WidgetNode s e) -> Map WidgetKey (WidgetNode s e)
buildLocalMap Seq (WidgetNode s e)
oldChildren
  newKeys :: Map WidgetKey (WidgetNode s e)
newKeys = Seq (WidgetNode s e) -> Map WidgetKey (WidgetNode s e)
forall s e. Seq (WidgetNode s e) -> Map WidgetKey (WidgetNode s e)
buildLocalMap ((Int, WidgetNode s e) -> WidgetNode s e
forall a b. (a, b) -> b
snd ((Int, WidgetNode s e) -> WidgetNode s e)
-> Seq (Int, WidgetNode s e) -> Seq (WidgetNode s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Int, WidgetNode s e)
newIts)

  mpairs :: (Seq (WidgetResult s e), Seq (WidgetResult s e))
mpairs = (Int -> WidgetNode s e -> WidgetEnv s e)
-> WidgetEnv s e
-> Map WidgetKey (WidgetNode s e)
-> Map WidgetKey (WidgetNode s e)
-> WidgetNode s e
-> Seq (Int, WidgetNode s e)
-> Seq (Int, WidgetNode s e)
-> (Seq (WidgetResult s e), Seq (WidgetResult s e))
forall s e.
(Int -> WidgetNode s e -> WidgetEnv s e)
-> WidgetEnv s e
-> WidgetKeyMap s e
-> WidgetKeyMap s e
-> WidgetNode s e
-> Seq (Int, WidgetNode s e)
-> Seq (Int, WidgetNode s e)
-> (Seq (WidgetResult s e), Seq (WidgetResult s e))
mergeChildSeq Int -> WidgetNode s e -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv Map WidgetKey (WidgetNode s e)
oldKeys Map WidgetKey (WidgetNode s e)
newKeys WidgetNode s e
newNode Seq (Int, WidgetNode s e)
oldIts Seq (Int, WidgetNode s e)
newIts
  (Seq (WidgetResult s e)
mergedResults, Seq (WidgetResult s e)
removedResults) = (Seq (WidgetResult s e), Seq (WidgetResult s e))
mpairs
  mergedChildren :: Seq (WidgetNode s e)
mergedChildren = (WidgetResult s e -> WidgetNode s e)
-> Seq (WidgetResult s e) -> Seq (WidgetNode s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WidgetResult s e -> WidgetNode s e
forall s e. WidgetResult s e -> WidgetNode s e
_wrNode Seq (WidgetResult s e)
mergedResults
  mergedReqs :: Seq (WidgetRequest s e)
mergedReqs = (WidgetResult s e -> Seq (WidgetRequest s e))
-> Seq (WidgetResult s e) -> Seq (WidgetRequest s e)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests Seq (WidgetResult s e)
mergedResults
  removedReqs :: Seq (WidgetRequest s e)
removedReqs = (WidgetResult s e -> Seq (WidgetRequest s e))
-> Seq (WidgetResult s e) -> Seq (WidgetRequest s e)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests Seq (WidgetResult s e)
removedResults
  mergedNode :: WidgetNode s e
mergedNode = WidgetNode s e
pNode WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode s e)
mergedChildren
  newReqs :: Seq (WidgetRequest s e)
newReqs = Seq (WidgetRequest s e)
pReqs Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
mergedReqs Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
removedReqs
  !newResult :: WidgetResult s e
newResult = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
mergedNode Seq (WidgetRequest s e)
newReqs

mergeChildSeq
  :: (Int -> WidgetNode s e -> WidgetEnv s e)
  -> WidgetEnv s e
  -> WidgetKeyMap s e
  -> WidgetKeyMap s e
  -> WidgetNode s e
  -> Seq (Int, WidgetNode s e)
  -> Seq (Int, WidgetNode s e)
  -> (Seq (WidgetResult s e), Seq (WidgetResult s e))
mergeChildSeq :: (Int -> WidgetNode s e -> WidgetEnv s e)
-> WidgetEnv s e
-> WidgetKeyMap s e
-> WidgetKeyMap s e
-> WidgetNode s e
-> Seq (Int, WidgetNode s e)
-> Seq (Int, WidgetNode s e)
-> (Seq (WidgetResult s e), Seq (WidgetResult s e))
mergeChildSeq Int -> WidgetNode s e -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetKeyMap s e
oldKeys WidgetKeyMap s e
newKeys WidgetNode s e
newNode Seq (Int, WidgetNode s e)
oldIts Seq (Int, WidgetNode s e)
Empty = (Seq (WidgetResult s e), Seq (WidgetResult s e))
forall a. (Seq a, Seq (WidgetResult s e))
res where
  isMember :: WidgetKey -> Bool
isMember = (WidgetKey -> WidgetKeyMap s e -> Bool)
-> WidgetKeyMap s e -> WidgetKey -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip WidgetKey -> WidgetKeyMap s e -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member WidgetKeyMap s e
newKeys
  dispose :: (a, WidgetNode s e) -> WidgetResult s e
dispose (!a
idx, !WidgetNode s e
child) = case WidgetKey -> Bool
isMember (WidgetKey -> Bool) -> Maybe WidgetKey -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WidgetNode s e
child WidgetNode s e
-> Getting (Maybe WidgetKey) (WidgetNode s e) (Maybe WidgetKey)
-> Maybe WidgetKey
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const (Maybe WidgetKey) WidgetNodeInfo)
-> WidgetNode s e -> Const (Maybe WidgetKey) (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const (Maybe WidgetKey) WidgetNodeInfo)
 -> WidgetNode s e -> Const (Maybe WidgetKey) (WidgetNode s e))
-> ((Maybe WidgetKey -> Const (Maybe WidgetKey) (Maybe WidgetKey))
    -> WidgetNodeInfo -> Const (Maybe WidgetKey) WidgetNodeInfo)
-> Getting (Maybe WidgetKey) (WidgetNode s e) (Maybe WidgetKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe WidgetKey -> Const (Maybe WidgetKey) (Maybe WidgetKey))
-> WidgetNodeInfo -> Const (Maybe WidgetKey) WidgetNodeInfo
forall s a. HasKey s a => Lens' s a
L.key of
    Just Bool
True -> WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
child Seq (WidgetRequest s e)
forall a. Seq a
Empty
    Maybe Bool
_ -> Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetDispose (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
child
  !removed :: Seq (WidgetResult s e)
removed = ((Int, WidgetNode s e) -> WidgetResult s e)
-> Seq (Int, WidgetNode s e) -> Seq (WidgetResult s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, WidgetNode s e) -> WidgetResult s e
forall a. (a, WidgetNode s e) -> WidgetResult s e
dispose Seq (Int, WidgetNode s e)
oldIts
  !res :: (Seq a, Seq (WidgetResult s e))
res = (Seq a
forall a. Seq a
Empty, Seq (WidgetResult s e)
removed)
mergeChildSeq Int -> WidgetNode s e -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetKeyMap s e
oldKeys WidgetKeyMap s e
newKeys WidgetNode s e
newNode Seq (Int, WidgetNode s e)
Empty Seq (Int, WidgetNode s e)
newIts = (Seq (WidgetResult s e), Seq (WidgetResult s e))
forall a. (Seq (WidgetResult s e), Seq a)
res where
  init :: (a, WidgetNode s e) -> WidgetResult s e
init (a
idx, !WidgetNode s e
child) = Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
child
  !merged :: Seq (WidgetResult s e)
merged = ((Int, WidgetNode s e) -> WidgetResult s e)
-> Seq (Int, WidgetNode s e) -> Seq (WidgetResult s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, WidgetNode s e) -> WidgetResult s e
forall a. (a, WidgetNode s e) -> WidgetResult s e
init Seq (Int, WidgetNode s e)
newIts
  !res :: (Seq (WidgetResult s e), Seq a)
res = (Seq (WidgetResult s e)
merged, Seq a
forall a. Seq a
Empty)
mergeChildSeq Int -> WidgetNode s e -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetKeyMap s e
oldKeys WidgetKeyMap s e
newKeys WidgetNode s e
newNode Seq (Int, WidgetNode s e)
oldIts Seq (Int, WidgetNode s e)
newIts = (Seq (WidgetResult s e), Seq (WidgetResult s e))
res where
  (Int
_, !WidgetNode s e
oldChild) :<| Seq (Int, WidgetNode s e)
oldChildren = Seq (Int, WidgetNode s e)
oldIts
  (!Int
newIdx, !WidgetNode s e
newChild) :<| Seq (Int, WidgetNode s e)
newChildren = Seq (Int, WidgetNode s e)
newIts
  !newWidget :: Widget s e
newWidget = WidgetNode s e
newChild WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget
  !newWidgetId :: WidgetId
newWidgetId = WidgetNode s e
newChild WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
  !newChildKey :: Maybe WidgetKey
newChildKey = WidgetNode s e
newChild WidgetNode s e
-> Getting (Maybe WidgetKey) (WidgetNode s e) (Maybe WidgetKey)
-> Maybe WidgetKey
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const (Maybe WidgetKey) WidgetNodeInfo)
-> WidgetNode s e -> Const (Maybe WidgetKey) (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const (Maybe WidgetKey) WidgetNodeInfo)
 -> WidgetNode s e -> Const (Maybe WidgetKey) (WidgetNode s e))
-> ((Maybe WidgetKey -> Const (Maybe WidgetKey) (Maybe WidgetKey))
    -> WidgetNodeInfo -> Const (Maybe WidgetKey) WidgetNodeInfo)
-> Getting (Maybe WidgetKey) (WidgetNode s e) (Maybe WidgetKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe WidgetKey -> Const (Maybe WidgetKey) (Maybe WidgetKey))
-> WidgetNodeInfo -> Const (Maybe WidgetKey) WidgetNodeInfo
forall s a. HasKey s a => Lens' s a
L.key
  !cwenv :: WidgetEnv s e
cwenv = Int -> WidgetNode s e -> WidgetEnv s e
updateCWenv Int
newIdx WidgetNode s e
newChild

  oldKeyMatch :: Maybe (WidgetNode s e)
oldKeyMatch = Maybe WidgetKey
newChildKey Maybe WidgetKey
-> (WidgetKey -> Maybe (WidgetNode s e)) -> Maybe (WidgetNode s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WidgetKey
key -> WidgetKey -> WidgetKeyMap s e -> Maybe (WidgetNode s e)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WidgetKey
key WidgetKeyMap s e
oldKeys
  oldMatch :: WidgetNode s e
oldMatch = WidgetNode s e -> Maybe (WidgetNode s e) -> WidgetNode s e
forall a. a -> Maybe a -> a
fromMaybe WidgetNode s e
newNode Maybe (WidgetNode s e)
oldKeyMatch
  isMergeKey :: Bool
isMergeKey = Maybe (WidgetNode s e) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (WidgetNode s e)
oldKeyMatch Bool -> Bool -> Bool
&& WidgetNode s e -> WidgetNode s e -> Bool
forall s e. WidgetNode s e -> WidgetNode s e -> Bool
nodeMatches WidgetNode s e
newChild WidgetNode s e
oldMatch

  mergedOld :: WidgetResult s e
mergedOld = Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
widgetMerge Widget s e
newWidget WidgetEnv s e
cwenv WidgetNode s e
newChild WidgetNode s e
oldChild
  mergedKey :: WidgetResult s e
mergedKey = Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
widgetMerge Widget s e
newWidget WidgetEnv s e
cwenv WidgetNode s e
newChild WidgetNode s e
oldMatch
  initNew :: WidgetResult s e
initNew = Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit Widget s e
newWidget WidgetEnv s e
cwenv WidgetNode s e
newChild
    WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
newWidgetId)

  (!WidgetResult s e
child, !Seq (Int, WidgetNode s e)
oldRest)
    | WidgetNode s e -> WidgetNode s e -> Bool
forall s e. WidgetNode s e -> WidgetNode s e -> Bool
nodeMatches WidgetNode s e
newChild WidgetNode s e
oldChild = (WidgetResult s e
mergedOld, Seq (Int, WidgetNode s e)
oldChildren)
    | Bool
isMergeKey = (WidgetResult s e
mergedKey, Seq (Int, WidgetNode s e)
oldIts)
    | Bool
otherwise = (WidgetResult s e
initNew, Seq (Int, WidgetNode s e)
oldIts)

  (!Seq (WidgetResult s e)
cmerged, !Seq (WidgetResult s e)
cremoved)
    = (Int -> WidgetNode s e -> WidgetEnv s e)
-> WidgetEnv s e
-> WidgetKeyMap s e
-> WidgetKeyMap s e
-> WidgetNode s e
-> Seq (Int, WidgetNode s e)
-> Seq (Int, WidgetNode s e)
-> (Seq (WidgetResult s e), Seq (WidgetResult s e))
forall s e.
(Int -> WidgetNode s e -> WidgetEnv s e)
-> WidgetEnv s e
-> WidgetKeyMap s e
-> WidgetKeyMap s e
-> WidgetNode s e
-> Seq (Int, WidgetNode s e)
-> Seq (Int, WidgetNode s e)
-> (Seq (WidgetResult s e), Seq (WidgetResult s e))
mergeChildSeq Int -> WidgetNode s e -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetKeyMap s e
oldKeys WidgetKeyMap s e
newKeys WidgetNode s e
newNode Seq (Int, WidgetNode s e)
oldRest Seq (Int, WidgetNode s e)
newChildren
  !merged :: Seq (WidgetResult s e)
merged = WidgetResult s e
child WidgetResult s e
-> Seq (WidgetResult s e) -> Seq (WidgetResult s e)
forall a. a -> Seq a -> Seq a
<| Seq (WidgetResult s e)
cmerged
  !res :: (Seq (WidgetResult s e), Seq (WidgetResult s e))
res = (Seq (WidgetResult s e)
merged, Seq (WidgetResult s e)
cremoved)

mergeChildrenCheckVisible
  :: WidgetNode s e
  -> WidgetResult s e
  -> WidgetResult s e
mergeChildrenCheckVisible :: WidgetNode s e -> WidgetResult s e -> WidgetResult s e
mergeChildrenCheckVisible WidgetNode s e
oldNode WidgetResult s e
result = WidgetResult s e
newResult where
  newNode :: WidgetNode s e
newNode = WidgetResult s e
result WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node
  widgetId :: WidgetId
widgetId = WidgetNode s e
newNode WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
  resizeRequired :: Bool
resizeRequired = WidgetNode s e -> WidgetNode s e -> Bool
forall s e. WidgetNode s e -> WidgetNode s e -> Bool
childrenVisibleChanged WidgetNode s e
oldNode WidgetNode s e
newNode
  !newResult :: WidgetResult s e
newResult
    | Bool
resizeRequired = WidgetResult s e
result WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId)
    | Bool
otherwise = WidgetResult s e
result

getInstanceTreeWrapper
  :: WidgetModel a
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> WidgetInstanceNode
getInstanceTreeWrapper :: Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
getInstanceTreeWrapper Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node = WidgetInstanceNode
instNode where
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  instNode :: WidgetInstanceNode
instNode = WidgetInstanceNode :: WidgetNodeInfo
-> Maybe WidgetState
-> Seq WidgetInstanceNode
-> WidgetInstanceNode
WidgetInstanceNode {
    _winInfo :: WidgetNodeInfo
_winInfo = WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info,
    _winState :: Maybe WidgetState
_winState = Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
node WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
node,
    _winChildren :: Seq WidgetInstanceNode
_winChildren = (Int -> WidgetNode s e -> WidgetInstanceNode)
-> Seq (WidgetNode s e) -> Seq WidgetInstanceNode
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> WidgetNode s e -> WidgetInstanceNode
getChildTree (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children)
  }
  getChildTree :: Int -> WidgetNode s e -> WidgetInstanceNode
getChildTree Int
idx WidgetNode s e
child = WidgetInstanceNode
tree where
    cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
child Int
idx
    tree :: WidgetInstanceNode
tree = Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
widgetGetInstanceTree (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
cwenv WidgetNode s e
child

-- | Dispose handler
defaultDispose :: ContainerInitHandler s e
defaultDispose :: ContainerInitHandler s e
defaultDispose WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

disposeWrapper
  :: Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> WidgetResult s e
disposeWrapper :: Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
disposeWrapper Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  disposeHandler :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
disposeHandler = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
containerDispose Container s e a
container

  WidgetResult WidgetNode s e
tempNode Seq (WidgetRequest s e)
reqs = WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
disposeHandler WidgetEnv s e
wenv WidgetNode s e
node
  widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> Getting WidgetId WidgetNodeInfo WidgetId
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting WidgetId WidgetNodeInfo WidgetId
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
tempNode WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children

  dispose :: Int -> WidgetNode s e -> WidgetResult s e
dispose !Int
idx !WidgetNode s e
child = Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetDispose (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
cwenv WidgetNode s e
child where
    cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
child Int
idx
  results :: Seq (WidgetResult s e)
results = (Int -> WidgetNode s e -> WidgetResult s e)
-> Seq (WidgetNode s e) -> Seq (WidgetResult s e)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> WidgetNode s e -> WidgetResult s e
dispose Seq (WidgetNode s e)
children
  newReqs :: Seq (WidgetRequest s e)
newReqs = (WidgetResult s e -> Seq (WidgetRequest s e))
-> Seq (WidgetResult s e) -> Seq (WidgetRequest s e)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests Seq (WidgetResult s e)
results Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetWidgetPath WidgetId
widgetId
  !result :: WidgetResult s e
result = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
node (Seq (WidgetRequest s e)
reqs Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
newReqs)

-- | Find next focusable item
defaultFindNextFocus :: ContainerFindNextFocusHandler s e
defaultFindNextFocus :: ContainerFindNextFocusHandler s e
defaultFindNextFocus !WidgetEnv s e
wenv !WidgetNode s e
node !FocusDirection
direction !Path
start = Seq (WidgetNode s e)
vchildren where
  vchildren :: Seq (WidgetNode s e)
vchildren = (WidgetNode s e -> Bool)
-> Seq (WidgetNode s e) -> Seq (WidgetNode s e)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasVisible s a => Lens' s a
L.visible) (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children)

findNextFocusWrapper
  :: Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> FocusDirection
  -> Path
  -> Maybe WidgetNodeInfo
findNextFocusWrapper :: Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
findNextFocusWrapper Container s e a
container !WidgetEnv s e
wenv !WidgetNode s e
node !FocusDirection
dir !Path
start = Maybe WidgetNodeInfo
nextFocus where
  handler :: ContainerFindNextFocusHandler s e
handler = Container s e a -> ContainerFindNextFocusHandler s e
forall s e a. Container s e a -> ContainerFindNextFocusHandler s e
containerFindNextFocus Container s e a
container
  handlerResult :: Seq (WidgetNode s e)
handlerResult = ContainerFindNextFocusHandler s e
handler WidgetEnv s e
wenv WidgetNode s e
node FocusDirection
dir Path
start
  children :: Seq (WidgetNode s e)
children
    | FocusDirection
dir FocusDirection -> FocusDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FocusDirection
FocusBwd = Seq (WidgetNode s e) -> Seq (WidgetNode s e)
forall a. Seq a -> Seq a
Seq.reverse Seq (WidgetNode s e)
handlerResult
    | Bool
otherwise = Seq (WidgetNode s e)
handlerResult
  !nextFocus :: Maybe WidgetNodeInfo
nextFocus
    | WidgetNode s e -> Path -> FocusDirection -> Bool
forall s e. WidgetNode s e -> Path -> FocusDirection -> Bool
isFocusCandidate WidgetNode s e
node Path
start FocusDirection
dir = WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. a -> Maybe a
Just (WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info)
    | Bool
otherwise = Container s e a
-> WidgetEnv s e
-> FocusDirection
-> Path
-> WidgetNode s e
-> Seq (WidgetNode s e)
-> Maybe WidgetNodeInfo
forall s e a.
Container s e a
-> WidgetEnv s e
-> FocusDirection
-> Path
-> WidgetNode s e
-> Seq (WidgetNode s e)
-> Maybe WidgetNodeInfo
findFocusCandidate Container s e a
container WidgetEnv s e
wenv FocusDirection
dir Path
start WidgetNode s e
node Seq (WidgetNode s e)
children

findFocusCandidate
  :: Container s e a
  -> WidgetEnv s e
  -> FocusDirection
  -> Path
  -> WidgetNode s e
  -> Seq (WidgetNode s e)
  -> Maybe WidgetNodeInfo
findFocusCandidate :: Container s e a
-> WidgetEnv s e
-> FocusDirection
-> Path
-> WidgetNode s e
-> Seq (WidgetNode s e)
-> Maybe WidgetNodeInfo
findFocusCandidate Container s e a
_ WidgetEnv s e
_ FocusDirection
_ Path
_ WidgetNode s e
_ Seq (WidgetNode s e)
Empty = Maybe WidgetNodeInfo
forall a. Maybe a
Nothing
findFocusCandidate Container s e a
container !WidgetEnv s e
wenv !FocusDirection
dir !Path
start !WidgetNode s e
node (WidgetNode s e
ch :<| Seq (WidgetNode s e)
chs) = Maybe WidgetNodeInfo
result where
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  !path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
  !idx :: Int
idx = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Int -> Path -> Maybe Int
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Path -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Path
path Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Path
path)
  !cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
ch Int
idx
  !isWidgetAfterStart :: Bool
isWidgetAfterStart
    | FocusDirection
dir FocusDirection -> FocusDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FocusDirection
FocusBwd = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeBeforePath WidgetNode s e
ch Path
start
    | Bool
otherwise = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath WidgetNode s e
ch Path
start Bool -> Bool -> Bool
|| WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeAfterPath WidgetNode s e
ch Path
start

  candidate :: Maybe WidgetNodeInfo
candidate = Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
widgetFindNextFocus (WidgetNode s e
ch WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
cwenv WidgetNode s e
ch FocusDirection
dir Path
start
  result :: Maybe WidgetNodeInfo
result
    | Bool
isWidgetAfterStart Bool -> Bool -> Bool
&& Maybe WidgetNodeInfo -> Bool
forall a. Maybe a -> Bool
isJust Maybe WidgetNodeInfo
candidate = Maybe WidgetNodeInfo
candidate
    | Bool
otherwise = Container s e a
-> WidgetEnv s e
-> FocusDirection
-> Path
-> WidgetNode s e
-> Seq (WidgetNode s e)
-> Maybe WidgetNodeInfo
forall s e a.
Container s e a
-> WidgetEnv s e
-> FocusDirection
-> Path
-> WidgetNode s e
-> Seq (WidgetNode s e)
-> Maybe WidgetNodeInfo
findFocusCandidate Container s e a
container WidgetEnv s e
wenv FocusDirection
dir Path
start WidgetNode s e
node Seq (WidgetNode s e)
chs

-- | Find instance matching point
defaultFindByPoint :: ContainerFindByPointHandler s e
defaultFindByPoint :: ContainerFindByPointHandler s e
defaultFindByPoint !WidgetEnv s e
wenv !WidgetNode s e
node !Path
start !Point
point = Maybe Int
result where
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
  pointInWidget :: s -> Bool
pointInWidget s
wi = s
wi s -> Getting Bool s Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool s Bool
forall s a. HasVisible s a => Lens' s a
L.visible Bool -> Bool -> Bool
&& Point -> Rect -> Bool
pointInRect Point
point (s
wi s -> Getting Rect s Rect -> Rect
forall s a. s -> Getting a s a -> a
^. Getting Rect s Rect
forall s a. HasViewport s a => Lens' s a
L.viewport)
  result :: Maybe Int
result = (WidgetNode s e -> Bool) -> Seq (WidgetNode s e) -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL (WidgetNodeInfo -> Bool
forall s. (HasVisible s Bool, HasViewport s Rect) => s -> Bool
pointInWidget (WidgetNodeInfo -> Bool)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children

findByPointWrapper
  :: Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> Path
  -> Point
  -> Maybe WidgetNodeInfo
findByPointWrapper :: Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
findByPointWrapper !Container s e a
container !WidgetEnv s e
wenv !WidgetNode s e
node !Path
start !Point
point = Maybe WidgetNodeInfo
result where
  offset :: Point
offset = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
forall a. Default a => a
def (Container s e a -> Maybe Point
forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container)
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  ignoreEmpty :: Bool
ignoreEmpty = Container s e a -> Bool
forall s e a. Container s e a -> Bool
containerIgnoreEmptyArea Container s e a
container
  handler :: ContainerFindByPointHandler s e
handler = Container s e a -> ContainerFindByPointHandler s e
forall s e a. Container s e a -> ContainerFindByPointHandler s e
containerFindByPoint Container s e a
container

  isVisible :: Bool
isVisible = WidgetNode s e
node WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasVisible s a => Lens' s a
L.visible
  inVp :: Bool
inVp = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
point
  cpoint :: Point
cpoint = Point -> Point -> Point
addPoint (Point -> Point
negPoint Point
offset) Point
point
  path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
  childIdx :: Maybe Int
childIdx = WidgetNode s e -> Path -> Maybe Int
forall s e. WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
node Path
start Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ContainerFindByPointHandler s e
handler WidgetEnv s e
wenv WidgetNode s e
node Path
start Point
cpoint
  validateIdx :: Int -> Maybe Int
validateIdx Int
p
    | Seq (WidgetNode s e) -> Int
forall a. Seq a -> Int
Seq.length Seq (WidgetNode s e)
children Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
p Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p
    | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing

  win :: Maybe WidgetNodeInfo
win = case Maybe Int
childIdx Maybe Int -> (Int -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Maybe Int
validateIdx of
    Just Int
idx -> Maybe WidgetNodeInfo
childWni where
      cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
child Int
idx
      child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
idx
      childWidget :: Widget s e
childWidget = WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget
      childWni :: Maybe WidgetNodeInfo
childWni = Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
widgetFindByPoint Widget s e
childWidget WidgetEnv s e
cwenv WidgetNode s e
child Path
start Point
cpoint
    Maybe Int
Nothing
      | Bool -> Bool
not Bool
ignoreEmpty -> WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. a -> Maybe a
Just (WidgetNodeInfo -> Maybe WidgetNodeInfo)
-> WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
      | Bool
otherwise -> Maybe WidgetNodeInfo
forall a. Maybe a
Nothing
  result :: Maybe WidgetNodeInfo
result
    | Bool
isVisible Bool -> Bool -> Bool
&& (Bool
inVp Bool -> Bool -> Bool
|| (WidgetNodeInfo -> Path) -> Maybe WidgetNodeInfo -> Maybe Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WidgetNodeInfo
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Path
forall s a. s -> Getting a s a -> a
^. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path) Maybe WidgetNodeInfo
win Maybe Path -> Maybe Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path -> Maybe Path
forall a. a -> Maybe a
Just Path
path) = Maybe WidgetNodeInfo
win
    | Bool
otherwise = Maybe WidgetNodeInfo
forall a. Maybe a
Nothing

containerFindBranchByPath
  :: WidgetEnv s e
  -> WidgetNode s e
  -> Path
  -> Seq WidgetNodeInfo
containerFindBranchByPath :: WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
containerFindBranchByPath !WidgetEnv s e
wenv !WidgetNode s e
node !Path
path
  | WidgetNodeInfo
info WidgetNodeInfo
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Path
forall s a. s -> Getting a s a -> a
^. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
path = WidgetNodeInfo -> Seq WidgetNodeInfo
forall a. a -> Seq a
Seq.singleton WidgetNodeInfo
info
  | Maybe (WidgetNode s e) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (WidgetNode s e)
nextChild = WidgetNodeInfo
info WidgetNodeInfo -> Seq WidgetNodeInfo -> Seq WidgetNodeInfo
forall a. a -> Seq a -> Seq a
<| WidgetNode s e -> Seq WidgetNodeInfo
nextInst (Maybe (WidgetNode s e) -> WidgetNode s e
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetNode s e)
nextChild)
  | Bool
otherwise = Seq WidgetNodeInfo
forall a. Seq a
Seq.empty
  where
    children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
    info :: WidgetNodeInfo
info = WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
    nextStep :: Maybe Int
nextStep = WidgetNode s e -> Path -> Maybe Int
forall s e. WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
node Path
path
    nextChild :: Maybe (WidgetNode s e)
nextChild = Maybe Int
nextStep Maybe Int
-> (Int -> Maybe (WidgetNode s e)) -> Maybe (WidgetNode s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Seq (WidgetNode s e) -> Maybe (WidgetNode s e))
-> Seq (WidgetNode s e) -> Int -> Maybe (WidgetNode s e)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Seq (WidgetNode s e) -> Maybe (WidgetNode s e)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Seq (WidgetNode s e)
children
    nextInst :: WidgetNode s e -> Seq WidgetNodeInfo
nextInst WidgetNode s e
child = Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
forall s e.
Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
widgetFindBranchByPath (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
child Path
path

-- | Event Handling
defaultFilterEvent :: ContainerFilterHandler s e
defaultFilterEvent :: ContainerFilterHandler s e
defaultFilterEvent WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt = (Path, SystemEvent) -> Maybe (Path, SystemEvent)
forall a. a -> Maybe a
Just (Path
target, SystemEvent
evt)

defaultHandleEvent :: ContainerEventHandler s e
defaultHandleEvent :: ContainerEventHandler s e
defaultHandleEvent WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

handleEventWrapper
  :: WidgetModel a
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> Path
  -> SystemEvent
  -> Maybe (WidgetResult s e)
handleEventWrapper :: Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
handleEventWrapper Container s e a
container !WidgetEnv s e
wenv !WidgetNode s e
node !Path
baseTarget !SystemEvent
baseEvt
  | Bool -> Bool
not (WidgetNode s e
node WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasVisible s a => Lens' s a
L.visible) Bool -> Bool -> Bool
|| Maybe (Path, SystemEvent) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Path, SystemEvent)
filteredEvt = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
  | Bool
targetReached Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
targetValid = Maybe (WidgetResult s e)
pResultStyled
  | Bool
otherwise = WidgetNode s e -> Path -> Maybe Int
forall s e. WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
pNode Path
target Maybe Int
-> (Int -> Maybe (WidgetResult s e)) -> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Maybe (WidgetResult s e)
cResultStyled
  where
    -- Having targetValid = False means the next path step is not in
    -- _wiChildren, but may still be valid in the receiving widget
    -- For example, Composite has its own tree of child widgets with (possibly)
    -- different types for Model and Events, and is candidate for the next step
    !offset :: Point
offset = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
forall a. Default a => a
def (Container s e a -> Maybe Point
forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container)
    !style :: StyleState
style = Container s e a -> ContainerGetCurrentStyle s e
forall s e a. Container s e a -> ContainerGetCurrentStyle s e
containerGetCurrentStyle Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node
    !doCursor :: Bool
doCursor = Bool -> Bool
not (Container s e a -> Bool
forall s e a. Container s e a -> Bool
containerUseCustomCursor Container s e a
container)
    updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
    filterHandler :: ContainerFilterHandler s e
filterHandler = Container s e a -> ContainerFilterHandler s e
forall s e a. Container s e a -> ContainerFilterHandler s e
containerFilterEvent Container s e a
container
    eventHandler :: WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
eventHandler = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
forall s e a. Container s e a -> ContainerEventHandler s e
containerHandleEvent Container s e a
container

    !targetReached :: Bool
targetReached = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isTargetReached WidgetNode s e
node Path
target
    !targetValid :: Bool
targetValid = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isTargetValid WidgetNode s e
node Path
target
    !filteredEvt :: Maybe (Path, SystemEvent)
filteredEvt = ContainerFilterHandler s e
filterHandler WidgetEnv s e
wenv WidgetNode s e
node Path
baseTarget SystemEvent
baseEvt
    (!Path
target, !SystemEvent
evt) = (Path, SystemEvent)
-> Maybe (Path, SystemEvent) -> (Path, SystemEvent)
forall a. a -> Maybe a -> a
fromMaybe (Path
baseTarget, SystemEvent
baseEvt) Maybe (Path, SystemEvent)
filteredEvt
    -- Event targeted at parent
    !pResult :: Maybe (WidgetResult s e)
pResult = WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
eventHandler WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt
    pResultStyled :: Maybe (WidgetResult s e)
pResultStyled = WidgetEnv s e
-> Path
-> StyleState
-> Bool
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
forall s e.
WidgetEnv s e
-> Path
-> StyleState
-> Bool
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleStyleChange WidgetEnv s e
wenv Path
target StyleState
style Bool
doCursor WidgetNode s e
node SystemEvent
evt
      (Maybe (WidgetResult s e) -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e) -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node (SystemEvent -> Maybe SystemEvent
forall a. a -> Maybe a
Just SystemEvent
evt) Maybe (WidgetResult s e)
pResult
    pNode :: WidgetNode s e
pNode = WidgetNode s e
-> (WidgetResult s e -> WidgetNode s e)
-> Maybe (WidgetResult s e)
-> WidgetNode s e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetNode s e
node (WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node) Maybe (WidgetResult s e)
pResult

    -- Event targeted at children
    cResultStyled :: Int -> Maybe (WidgetResult s e)
cResultStyled Int
childIdx = Maybe (WidgetResult s e)
result where
      --childIdx = fromJust $ nextTargetStep pNode target
      children :: Seq (WidgetNode s e)
children = WidgetNode s e
pNode WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
      child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
childIdx
      childWidget :: Widget s e
childWidget = WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget
      cevt :: SystemEvent
cevt = Point -> SystemEvent -> SystemEvent
translateEvent (Point -> Point
negPoint Point
offset) SystemEvent
evt
      cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
pNode WidgetNode s e
child Int
childIdx

      childrenIgnored :: Bool
childrenIgnored = Maybe (WidgetResult s e) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (WidgetResult s e)
pResult Bool -> Bool -> Bool
&& WidgetResult s e -> Bool
forall s e. WidgetResult s e -> Bool
ignoreChildren (Maybe (WidgetResult s e) -> WidgetResult s e
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetResult s e)
pResult)
      parentIgnored :: Bool
parentIgnored = Maybe (WidgetResult s e) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (WidgetResult s e)
cResult Bool -> Bool -> Bool
&& WidgetResult s e -> Bool
forall s e. WidgetResult s e -> Bool
ignoreParent (Maybe (WidgetResult s e) -> WidgetResult s e
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetResult s e)
cResult)

      cResult :: Maybe (WidgetResult s e)
cResult
        | Bool
childrenIgnored Bool -> Bool -> Bool
|| Bool -> Bool
not (WidgetNode s e
child WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasEnabled s a => Lens' s a
L.enabled) = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
        | Bool
otherwise = Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
widgetHandleEvent Widget s e
childWidget WidgetEnv s e
cwenv WidgetNode s e
child Path
target SystemEvent
cevt
      cResultMerged :: Maybe (WidgetResult s e)
cResultMerged
        | Bool
parentIgnored = WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
-> Int
-> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
-> Int
-> Maybe (WidgetResult s e)
mergeParentChildEvts WidgetNode s e
node Maybe (WidgetResult s e)
forall a. Maybe a
Nothing Maybe (WidgetResult s e)
cResult Int
childIdx
        | Bool
otherwise = WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
-> Int
-> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
-> Int
-> Maybe (WidgetResult s e)
mergeParentChildEvts WidgetNode s e
pNode Maybe (WidgetResult s e)
pResult Maybe (WidgetResult s e)
cResult Int
childIdx

      cpNode :: WidgetNode s e
cpNode
        | Bool
parentIgnored = WidgetNode s e
node
        | Bool
otherwise = WidgetNode s e
pNode
      !result :: Maybe (WidgetResult s e)
result = WidgetEnv s e
-> Path
-> StyleState
-> Bool
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
forall s e.
WidgetEnv s e
-> Path
-> StyleState
-> Bool
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleStyleChange WidgetEnv s e
cwenv Path
target StyleState
style Bool
doCursor WidgetNode s e
cpNode SystemEvent
cevt
        (Maybe (WidgetResult s e) -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e) -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Container s e a
container WidgetEnv s e
cwenv WidgetNode s e
cpNode (SystemEvent -> Maybe SystemEvent
forall a. a -> Maybe a
Just SystemEvent
cevt) Maybe (WidgetResult s e)
cResultMerged

mergeParentChildEvts
  :: WidgetNode s e
  -> Maybe (WidgetResult s e)
  -> Maybe (WidgetResult s e)
  -> Int
  -> Maybe (WidgetResult s e)
mergeParentChildEvts :: WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
-> Int
-> Maybe (WidgetResult s e)
mergeParentChildEvts WidgetNode s e
_ Maybe (WidgetResult s e)
Nothing Maybe (WidgetResult s e)
Nothing Int
_ = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
mergeParentChildEvts WidgetNode s e
_ Maybe (WidgetResult s e)
pResponse Maybe (WidgetResult s e)
Nothing Int
_ = Maybe (WidgetResult s e)
pResponse
mergeParentChildEvts WidgetNode s e
original Maybe (WidgetResult s e)
Nothing (Just WidgetResult s e
cResponse) Int
idx = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetResult s e
cResponse {
    _wrNode :: WidgetNode s e
_wrNode = WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
forall s e.
WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild WidgetNode s e
original (WidgetResult s e -> WidgetNode s e
forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
cResponse) Int
idx
  }
mergeParentChildEvts WidgetNode s e
original (Just WidgetResult s e
pResponse) (Just WidgetResult s e
cResponse) Int
idx
  | WidgetResult s e -> Bool
forall s e. WidgetResult s e -> Bool
ignoreChildren WidgetResult s e
pResponse = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
pResponse
  | WidgetResult s e -> Bool
forall s e. WidgetResult s e -> Bool
ignoreParent WidgetResult s e
cResponse = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
newChildResponse
  | Bool
otherwise = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
newWidget Seq (WidgetRequest s e)
requests
  where
    pWidget :: WidgetNode s e
pWidget = WidgetResult s e -> WidgetNode s e
forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
pResponse
    cWidget :: WidgetNode s e
cWidget = WidgetResult s e -> WidgetNode s e
forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
cResponse
    requests :: Seq (WidgetRequest s e)
requests = WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
pResponse Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
cResponse
    newWidget :: WidgetNode s e
newWidget = WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
forall s e.
WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild WidgetNode s e
pWidget WidgetNode s e
cWidget Int
idx
    newChildResponse :: WidgetResult s e
newChildResponse = WidgetResult s e
cResponse {
      _wrNode :: WidgetNode s e
_wrNode = WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
forall s e.
WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild WidgetNode s e
original (WidgetResult s e -> WidgetNode s e
forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
cResponse) Int
idx
    }

-- | Message Handling
defaultHandleMessage :: ContainerMessageHandler s e
defaultHandleMessage :: WidgetEnv s e
-> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
defaultHandleMessage WidgetEnv s e
wenv WidgetNode s e
node Path
target i
message = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

handleMessageWrapper
  :: (WidgetModel a, Typeable i)
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> Path
  -> i
  -> Maybe (WidgetResult s e)
handleMessageWrapper :: Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> i
-> Maybe (WidgetResult s e)
handleMessageWrapper Container s e a
container !WidgetEnv s e
wenv !WidgetNode s e
node !Path
target i
arg
  | Bool -> Bool
not Bool
targetReached Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
targetValid = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
  | Bool
otherwise = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node Maybe SystemEvent
forall a. Maybe a
Nothing Maybe (WidgetResult s e)
result
  where
    updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
    handler :: WidgetEnv s e
-> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
handler = Container s e a
-> forall i.
   Typeable i =>
   WidgetEnv s e
   -> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
forall s e a. Container s e a -> ContainerMessageHandler s e
containerHandleMessage Container s e a
container

    targetReached :: Bool
targetReached = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isTargetReached WidgetNode s e
node Path
target
    targetValid :: Bool
targetValid = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isTargetValid WidgetNode s e
node Path
target

    messageResult :: Int -> Maybe (WidgetResult s e)
messageResult Int
childIdx = WidgetResult s e -> WidgetResult s e
updateChild (WidgetResult s e -> WidgetResult s e)
-> Maybe (WidgetResult s e) -> Maybe (WidgetResult s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (WidgetResult s e)
message where
      children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
      child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
childIdx
      cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
child Int
childIdx

      message :: Maybe (WidgetResult s e)
message = Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> i
-> Maybe (WidgetResult s e)
forall s e.
Widget s e
-> forall i.
   Typeable i =>
   WidgetEnv s e
   -> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
widgetHandleMessage (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
cwenv WidgetNode s e
child Path
target i
arg
      updateChild :: WidgetResult s e -> WidgetResult s e
updateChild !WidgetResult s e
cr = WidgetResult s e
cr {
        _wrNode :: WidgetNode s e
_wrNode = WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
forall s e.
WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild WidgetNode s e
node (WidgetResult s e -> WidgetNode s e
forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
cr) Int
childIdx
      }

    result :: Maybe (WidgetResult s e)
result
      | Bool
targetReached = WidgetEnv s e
-> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
handler WidgetEnv s e
wenv WidgetNode s e
node Path
target i
arg
      | Bool
otherwise = WidgetNode s e -> Path -> Maybe Int
forall s e. WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
node Path
target Maybe Int
-> (Int -> Maybe (WidgetResult s e)) -> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Maybe (WidgetResult s e)
messageResult

-- | Preferred size
defaultGetSizeReq :: ContainerGetSizeReqHandler s e
defaultGetSizeReq :: ContainerGetSizeReqHandler s e
defaultGetSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq
newReqW, SizeReq
newReqH) where
  (SizeReq
newReqW, SizeReq
newReqH) = case Int -> Seq (WidgetNode s e) -> Maybe (WidgetNode s e)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq (WidgetNode s e)
children of
    Just WidgetNode s e
child -> (WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> Getting SizeReq WidgetNodeInfo SizeReq
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting SizeReq WidgetNodeInfo SizeReq
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW, WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> Getting SizeReq WidgetNodeInfo SizeReq
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting SizeReq WidgetNodeInfo SizeReq
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)
    Maybe (WidgetNode s e)
_ -> (SizeReq, SizeReq)
forall a. Default a => a
def

getSizeReqWrapper
  :: WidgetModel a
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> (SizeReq, SizeReq)
getSizeReqWrapper :: Container s e a
-> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReqWrapper Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node = (SizeReq
newReqW, SizeReq
newReqH) where
  addStyleReq :: Bool
addStyleReq = Container s e a -> Bool
forall s e a. Container s e a -> Bool
containerAddStyleReq Container s e a
container
  handler :: ContainerGetSizeReqHandler s e
handler = Container s e a -> ContainerGetSizeReqHandler s e
forall s e a. Container s e a -> ContainerGetSizeReqHandler s e
containerGetSizeReq Container s e a
container
  style :: StyleState
style = Container s e a -> ContainerGetCurrentStyle s e
forall s e a. Container s e a -> ContainerGetCurrentStyle s e
containerGetCurrentStyle Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node

  children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
  reqs :: (SizeReq, SizeReq)
reqs = ContainerGetSizeReqHandler s e
handler WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children
  (SizeReq
tmpReqW, SizeReq
tmpReqH)
    | Bool
addStyleReq = StyleState -> (SizeReq, SizeReq) -> (SizeReq, SizeReq)
sizeReqAddStyle StyleState
style (SizeReq, SizeReq)
reqs
    | Bool
otherwise = (SizeReq, SizeReq)
reqs
  -- User settings take precedence
  newReqW :: SizeReq
newReqW = SizeReq -> Maybe SizeReq -> SizeReq
forall a. a -> Maybe a -> a
fromMaybe SizeReq
tmpReqW (StyleState
style StyleState
-> Getting (Maybe SizeReq) StyleState (Maybe SizeReq)
-> Maybe SizeReq
forall s a. s -> Getting a s a -> a
^. Getting (Maybe SizeReq) StyleState (Maybe SizeReq)
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW)
  newReqH :: SizeReq
newReqH = SizeReq -> Maybe SizeReq -> SizeReq
forall a. a -> Maybe a -> a
fromMaybe SizeReq
tmpReqH (StyleState
style StyleState
-> Getting (Maybe SizeReq) StyleState (Maybe SizeReq)
-> Maybe SizeReq
forall s a. s -> Getting a s a -> a
^. Getting (Maybe SizeReq) StyleState (Maybe SizeReq)
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)

updateSizeReq
  :: WidgetEnv s e
  -> WidgetNode s e
  -> WidgetNode s e
updateSizeReq :: WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e
newNode where
  (SizeReq
newReqW, SizeReq
newReqH) = Widget s e -> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
widgetGetSizeReq (WidgetNode s e
node WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
node
  newNode :: WidgetNode s e
newNode = WidgetNode s e
node
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((SizeReq -> Identity SizeReq)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (SizeReq -> Identity SizeReq)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Identity SizeReq)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW ((SizeReq -> Identity SizeReq)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> SizeReq -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqW
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((SizeReq -> Identity SizeReq)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (SizeReq -> Identity SizeReq)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Identity SizeReq)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH ((SizeReq -> Identity SizeReq)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> SizeReq -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqH

handleSizeReqChange
  :: WidgetModel a
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> Maybe SystemEvent
  -> Maybe (WidgetResult s e)
  -> Maybe (WidgetResult s e)
handleSizeReqChange :: Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node Maybe SystemEvent
evt Maybe (WidgetResult s e)
mResult = Maybe (WidgetResult s e)
result where
  baseResult :: WidgetResult s e
baseResult = WidgetResult s e -> Maybe (WidgetResult s e) -> WidgetResult s e
forall a. a -> Maybe a -> a
fromMaybe (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) Maybe (WidgetResult s e)
mResult
  baseNode :: WidgetNode s e
baseNode = WidgetResult s e
baseResult WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node
  resizeReq :: Bool
resizeReq = Maybe (WidgetResult s e) -> Bool
forall s e. Maybe (WidgetResult s e) -> Bool
isResizeAnyResult Maybe (WidgetResult s e)
mResult
  styleChanged :: Bool
styleChanged = Maybe SystemEvent -> Bool
forall a. Maybe a -> Bool
isJust Maybe SystemEvent
evt Bool -> Bool -> Bool
&& WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
styleStateChanged WidgetEnv s e
wenv WidgetNode s e
baseNode (Maybe SystemEvent -> SystemEvent
forall a. HasCallStack => Maybe a -> a
fromJust Maybe SystemEvent
evt)
  result :: Maybe (WidgetResult s e)
result
    | Bool
styleChanged Bool -> Bool -> Bool
|| Bool
resizeReq = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetResult s e
baseResult
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Identity (WidgetNode s e))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> WidgetNode s e -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv WidgetNode s e
baseNode
    | Bool
otherwise = Maybe (WidgetResult s e)
mResult

-- | Resize
defaultResize :: ContainerResizeHandler s e
defaultResize :: ContainerResizeHandler s e
defaultResize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Seq (WidgetNode s e)
children = (WidgetResult s e, Seq Rect)
resized where
  style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. ContainerGetCurrentStyle s e
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  contentArea :: Rect
contentArea = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
  childrenSizes :: Seq Rect
childrenSizes = Int -> Rect -> Seq Rect
forall a. Int -> a -> Seq a
Seq.replicate (Seq (WidgetNode s e) -> Int
forall a. Seq a -> Int
Seq.length Seq (WidgetNode s e)
children) Rect
contentArea
  resized :: (WidgetResult s e, Seq Rect)
resized = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq Rect
childrenSizes)

resizeWrapper
  :: WidgetModel a
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> Rect
  -> (Path -> Bool)
  -> WidgetResult s e
resizeWrapper :: Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
resizeWrapper Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Path -> Bool
resizeReq = WidgetResult s e
result where
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  useCustomSize :: Bool
useCustomSize = Container s e a -> Bool
forall s e a. Container s e a -> Bool
containerUseCustomSize Container s e a
container
  useChildSize :: Bool
useChildSize = Container s e a -> Bool
forall s e a. Container s e a -> Bool
containerUseChildrenSizes Container s e a
container
  handler :: ContainerResizeHandler s e
handler = Container s e a -> ContainerResizeHandler s e
forall s e a. Container s e a -> ContainerResizeHandler s e
containerResize Container s e a
container

  lensVp :: (Rect -> Const Rect Rect)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
lensVp = (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> (Rect -> Const Rect Rect)
-> WidgetNode s e
-> Const Rect (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
  vpChanged :: Bool
vpChanged = Rect
viewport Rect -> Rect -> Bool
forall a. Eq a => a -> a -> Bool
/= WidgetNode s e
node WidgetNode s e
-> ((Rect -> Const Rect Rect)
    -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> Rect
forall s a. s -> Getting a s a -> a
^. (Rect -> Const Rect Rect)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
lensVp
  path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children

  (WidgetResult s e
tempRes, Seq Rect
assigned) = ContainerResizeHandler s e
handler WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Seq (WidgetNode s e)
children
  resize :: Int -> (WidgetNode s e, Rect) -> WidgetResult s e
resize Int
idx (!WidgetNode s e
child, !Rect
vp) = WidgetResult s e
newChildRes where
    !cwenv :: WidgetEnv s e
cwenv = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
child Int
idx
    tempChildRes :: WidgetResult s e
tempChildRes = Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
cwenv WidgetNode s e
child Rect
vp Path -> Bool
resizeReq
    cvp :: Rect
cvp = WidgetResult s e
tempChildRes WidgetResult s e -> Getting Rect (WidgetResult s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNode s e -> Const Rect (WidgetNode s e))
-> WidgetResult s e -> Const Rect (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Const Rect (WidgetNode s e))
 -> WidgetResult s e -> Const Rect (WidgetResult s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> Getting Rect (WidgetResult s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> (Rect -> Const Rect Rect)
-> WidgetNode s e
-> Const Rect (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
    icvp :: Rect
icvp = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
vp (Rect -> Rect -> Maybe Rect
intersectRects Rect
vp Rect
cvp)
    !newChildRes :: WidgetResult s e
newChildRes = WidgetResult s e
tempChildRes
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Identity (WidgetNode s e))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> ((Rect -> Identity Rect)
    -> WidgetNode s e -> Identity (WidgetNode s e))
-> (Rect -> Identity Rect)
-> WidgetResult s e
-> Identity (WidgetResult s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Rect -> Identity Rect)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Rect -> Identity Rect)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Identity Rect)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Identity Rect)
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Rect -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if Bool
useChildSize then Rect
icvp else Rect
vp)

  newChildrenRes :: Seq (WidgetResult s e)
newChildrenRes = (Int -> (WidgetNode s e, Rect) -> WidgetResult s e)
-> Seq (WidgetNode s e, Rect) -> Seq (WidgetResult s e)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> (WidgetNode s e, Rect) -> WidgetResult s e
resize (Seq (WidgetNode s e) -> Seq Rect -> Seq (WidgetNode s e, Rect)
forall a b. Seq a -> Seq b -> Seq (a, b)
Seq.zip Seq (WidgetNode s e)
children Seq Rect
assigned)
  newChildren :: Seq (WidgetNode s e)
newChildren = (WidgetResult s e -> WidgetNode s e)
-> Seq (WidgetResult s e) -> Seq (WidgetNode s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WidgetResult s e -> WidgetNode s e
forall s e. WidgetResult s e -> WidgetNode s e
_wrNode Seq (WidgetResult s e)
newChildrenRes
  newChildrenReqs :: Seq (WidgetRequest s e)
newChildrenReqs = (WidgetResult s e -> Seq (WidgetRequest s e))
-> Seq (WidgetResult s e) -> Seq (WidgetRequest s e)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests Seq (WidgetResult s e)
newChildrenRes
  newVp :: Rect
newVp
    | Bool
useCustomSize = WidgetResult s e
tempRes WidgetResult s e -> Getting Rect (WidgetResult s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNode s e -> Const Rect (WidgetNode s e))
-> WidgetResult s e -> Const Rect (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Const Rect (WidgetNode s e))
 -> WidgetResult s e -> Const Rect (WidgetResult s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> Getting Rect (WidgetResult s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
lensVp
    | Bool
otherwise = Rect
viewport
  tmpResult :: Maybe (WidgetResult s e)
tmpResult
    | Bool
vpChanged Bool -> Bool -> Bool
|| Path -> Bool
resizeReq Path
path = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetResult s e
tempRes
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Identity (WidgetNode s e))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> ((Rect -> Identity Rect)
    -> WidgetNode s e -> Identity (WidgetNode s e))
-> (Rect -> Identity Rect)
-> WidgetResult s e
-> Identity (WidgetResult s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Rect -> Identity Rect)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Rect -> Identity Rect)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Identity Rect)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Identity Rect)
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Rect -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
newVp
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Identity (WidgetNode s e))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
    -> WidgetNode s e -> Identity (WidgetNode s e))
-> (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetResult s e
-> Identity (WidgetResult s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetNode s e) -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode s e)
newChildren
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Seq (WidgetRequest s e)
newChildrenReqs
    | Bool
otherwise = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
  result :: WidgetResult s e
result = Maybe (WidgetResult s e) -> WidgetResult s e
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (WidgetResult s e) -> WidgetResult s e)
-> Maybe (WidgetResult s e) -> WidgetResult s e
forall a b. (a -> b) -> a -> b
$
    Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
forall a s e.
WidgetModel a =>
Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Container s e a
container WidgetEnv s e
wenv (WidgetResult s e
tempRes WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node) Maybe SystemEvent
forall a. Maybe a
Nothing Maybe (WidgetResult s e)
tmpResult

-- | Rendering
defaultRender :: ContainerRenderHandler s e
defaultRender :: ContainerRenderHandler s e
defaultRender WidgetEnv s e
renderer WidgetNode s e
wenv Renderer
node = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

renderWrapper
  :: Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> Renderer
  -> IO ()
renderWrapper :: Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
renderWrapper Container s e a
container WidgetEnv s e
wenv !WidgetNode s e
node !Renderer
renderer =
  Renderer -> Bool -> Rect -> IO () -> IO ()
drawInScissor Renderer
renderer Bool
useScissor Rect
viewport (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Renderer -> Bool -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction_ Renderer
renderer Bool
drawDecorations Rect
viewport StyleState
style ((Rect -> IO ()) -> IO ()) -> (Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Rect
_ -> do
      WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
renderBefore WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer

      Renderer -> Bool -> Rect -> IO () -> IO ()
drawInScissor Renderer
renderer Bool
useChildrenScissor Rect
childrenScissorRect (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Point -> Bool
forall a. Maybe a -> Bool
isJust Maybe Point
offset) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Renderer -> IO ()
saveContext Renderer
renderer
          Renderer -> Point -> IO ()
setTranslation Renderer
renderer (Maybe Point -> Point
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Point
offset)

        Seq (Int, WidgetNode s e)
-> ((Int, WidgetNode s e) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq (Int, WidgetNode s e)
pairs (((Int, WidgetNode s e) -> IO ()) -> IO ())
-> ((Int, WidgetNode s e) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
idx, WidgetNode s e
child) ->
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isWidgetVisible (WidgetNode s e -> Int -> WidgetEnv s e
cwenv WidgetNode s e
child Int
idx) WidgetNode s e
child) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
child WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) (WidgetNode s e -> Int -> WidgetEnv s e
cwenv WidgetNode s e
child Int
idx) WidgetNode s e
child Renderer
renderer

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Point -> Bool
forall a. Maybe a -> Bool
isJust Maybe Point
offset) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Renderer -> IO ()
restoreContext Renderer
renderer

      -- Outside children scissor
      WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
renderAfter WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer
  where
    style :: StyleState
style = Container s e a -> ContainerGetCurrentStyle s e
forall s e a. Container s e a -> ContainerGetCurrentStyle s e
containerGetCurrentStyle Container s e a
container WidgetEnv s e
wenv WidgetNode s e
node
    updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = Container s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> Int
-> WidgetEnv s e
forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
    drawDecorations :: Bool
drawDecorations = Container s e a -> Bool
forall s e a. Container s e a -> Bool
containerDrawDecorations Container s e a
container
    useScissor :: Bool
useScissor = Container s e a -> Bool
forall s e a. Container s e a -> Bool
containerUseScissor Container s e a
container
    childrenScissor :: Maybe Rect
childrenScissor = Container s e a -> Maybe Rect
forall s e a. Container s e a -> Maybe Rect
containerChildrenScissor Container s e a
container
    offset :: Maybe Point
offset = Container s e a -> Maybe Point
forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container
    renderBefore :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
renderBefore = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
containerRender Container s e a
container
    renderAfter :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
renderAfter = Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
containerRenderAfter Container s e a
container

    children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
    viewport :: Rect
viewport = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
    useChildrenScissor :: Bool
useChildrenScissor = Maybe Rect -> Bool
forall a. Maybe a -> Bool
isJust Maybe Rect
childrenScissor
    childrenScissorRect :: Rect
childrenScissorRect = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
forall a. Default a => a
def Maybe Rect
childrenScissor
    pairs :: Seq (Int, WidgetNode s e)
pairs = (Int -> WidgetNode s e -> (Int, WidgetNode s e))
-> Seq (WidgetNode s e) -> Seq (Int, WidgetNode s e)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex (,) Seq (WidgetNode s e)
children
    cwenv :: WidgetNode s e -> Int -> WidgetEnv s e
cwenv !WidgetNode s e
child !Int
idx = WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv WidgetEnv s e
wenv WidgetNode s e
node WidgetNode s e
child Int
idx

-- | Event Handling Helpers
ignoreChildren :: WidgetResult s e -> Bool
ignoreChildren :: WidgetResult s e -> Bool
ignoreChildren WidgetResult s e
result = Bool -> Bool
not (Seq (WidgetRequest s e) -> Bool
forall a. Seq a -> Bool
Seq.null Seq (WidgetRequest s e)
ignoreReqs) where
  ignoreReqs :: Seq (WidgetRequest s e)
ignoreReqs = (WidgetRequest s e -> Bool)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter WidgetRequest s e -> Bool
forall s e. WidgetRequest s e -> Bool
isIgnoreChildrenEvents (WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
result)

ignoreParent :: WidgetResult s e -> Bool
ignoreParent :: WidgetResult s e -> Bool
ignoreParent WidgetResult s e
result = Bool -> Bool
not (Seq (WidgetRequest s e) -> Bool
forall a. Seq a -> Bool
Seq.null Seq (WidgetRequest s e)
ignoreReqs) where
  ignoreReqs :: Seq (WidgetRequest s e)
ignoreReqs = (WidgetRequest s e -> Bool)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter WidgetRequest s e -> Bool
forall s e. WidgetRequest s e -> Bool
isIgnoreParentEvents (WidgetResult s e -> Seq (WidgetRequest s e)
forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
result)

replaceChild
  :: WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild :: WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild !WidgetNode s e
parent !WidgetNode s e
child !Int
idx = WidgetNode s e
parent WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode s e)
newChildren where
  newChildren :: Seq (WidgetNode s e)
newChildren = Int
-> WidgetNode s e -> Seq (WidgetNode s e) -> Seq (WidgetNode s e)
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
idx WidgetNode s e
child (WidgetNode s e
parent WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children)

cascadeCtx
  :: WidgetEnv s e -> WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
cascadeCtx :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
cascadeCtx !WidgetEnv s e
wenv !WidgetNode s e
parent !WidgetNode s e
child !Int
idx = WidgetNode s e
newChild where
  pInfo :: WidgetNodeInfo
pInfo = WidgetNode s e
parent WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
  cInfo :: WidgetNodeInfo
cInfo = WidgetNode s e
child WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
  parentPath :: Path
parentPath = WidgetNodeInfo
pInfo WidgetNodeInfo
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Path
forall s a. s -> Getting a s a -> a
^. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
  parentVisible :: Bool
parentVisible = WidgetNodeInfo
pInfo WidgetNodeInfo
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasVisible s a => Lens' s a
L.visible
  parentEnabled :: Bool
parentEnabled = WidgetNodeInfo
pInfo WidgetNodeInfo
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasEnabled s a => Lens' s a
L.enabled
  !newPath :: Path
newPath = Path
parentPath Path -> Int -> Path
forall a. Seq a -> a -> Seq a
|> Int
idx
  !newChild :: WidgetNode s e
newChild = WidgetNode s e
child
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((WidgetId -> Identity WidgetId)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (WidgetId -> Identity WidgetId)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Identity WidgetId)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId ((WidgetId -> Identity WidgetId)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetId -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Millisecond -> Path -> WidgetId
WidgetId (WidgetEnv s e
wenv WidgetEnv s e
-> Getting Millisecond (WidgetEnv s e) Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond (WidgetEnv s e) Millisecond
forall s a. HasTimestamp s a => Lens' s a
L.timestamp) Path
newPath
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Path -> Identity Path)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Path -> Identity Path)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Identity Path)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path ((Path -> Identity Path)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Path -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Path
newPath
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasVisible s a => Lens' s a
L.visible ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (WidgetNodeInfo
cInfo WidgetNodeInfo
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasVisible s a => Lens' s a
L.visible Bool -> Bool -> Bool
&& Bool
parentVisible)
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasEnabled s a => Lens' s a
L.enabled ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (WidgetNodeInfo
cInfo WidgetNodeInfo
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasEnabled s a => Lens' s a
L.enabled Bool -> Bool -> Bool
&& Bool
parentEnabled)

buildLocalMap :: Seq (WidgetNode s e) -> Map WidgetKey (WidgetNode s e)
buildLocalMap :: Seq (WidgetNode s e) -> Map WidgetKey (WidgetNode s e)
buildLocalMap Seq (WidgetNode s e)
widgets = Map WidgetKey (WidgetNode s e)
newMap where
  addWidget :: Map k s -> s -> Map k s
addWidget Map k s
map s
widget
    | Maybe k -> Bool
forall a. Maybe a -> Bool
isJust Maybe k
key = k -> s -> Map k s -> Map k s
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Maybe k -> k
forall a. HasCallStack => Maybe a -> a
fromJust Maybe k
key) s
widget Map k s
map
    | Bool
otherwise = Map k s
map
    where
      key :: Maybe k
key = s
widget s -> Getting (Maybe k) s (Maybe k) -> Maybe k
forall s a. s -> Getting a s a -> a
^. (a -> Const (Maybe k) a) -> s -> Const (Maybe k) s
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const (Maybe k) a) -> s -> Const (Maybe k) s)
-> ((Maybe k -> Const (Maybe k) (Maybe k))
    -> a -> Const (Maybe k) a)
-> Getting (Maybe k) s (Maybe k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe k -> Const (Maybe k) (Maybe k)) -> a -> Const (Maybe k) a
forall s a. HasKey s a => Lens' s a
L.key
  newMap :: Map WidgetKey (WidgetNode s e)
newMap = (Map WidgetKey (WidgetNode s e)
 -> WidgetNode s e -> Map WidgetKey (WidgetNode s e))
-> Map WidgetKey (WidgetNode s e)
-> Seq (WidgetNode s e)
-> Map WidgetKey (WidgetNode s e)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map WidgetKey (WidgetNode s e)
-> WidgetNode s e -> Map WidgetKey (WidgetNode s e)
forall k s a.
(Ord k, HasInfo s a, HasKey a (Maybe k)) =>
Map k s -> s -> Map k s
addWidget Map WidgetKey (WidgetNode s e)
forall k a. Map k a
M.empty Seq (WidgetNode s e)
widgets