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

During init, a widget can return an arbitrary list of child widgets as part of
its result, even replacing those provided by the user. For this reason, child
widgets are initialized after this init function is complete. In case you need
to retrieve the 'WidgetId' of a child widget, you should use 'containerInitPost'
instead.

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.

During merge, a widget can return an arbitrary list of child widgets as part of
its result, even replacing those provided by the user. For this reason, new
child widgets are initialized after this merge function is complete. In case you
need to retrieve the 'WidgetId' of a child widget, you should use
'containerMergePost' instead.

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 in "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 in "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
stops the event propagation by returning Nothing.

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 overridden. 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.
  forall s e a. 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.
  forall s e a. 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
  forall s e a. 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.
  forall s e a. 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"
  forall s e a. 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.
  forall s e a. 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.
  forall s e a. 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.
  forall s e a. Container s e a -> Bool
containerUseCustomSize :: Bool,
  -- | If true, it will accept the size requested by children, restricted to the
  --   space already assigned.
  forall s e a. Container s e a -> Bool
containerUseChildrenSizes :: Bool,
  -- | True if automatic scissoring needs to be applied. Defaults to False.
  forall s e a. Container s e a -> Bool
containerUseScissor :: Bool,
  -- | Returns the base style for this type of widget.
  forall s e a. Container s e a -> ContainerGetBaseStyle s e
containerGetBaseStyle :: ContainerGetBaseStyle s e,
  -- | Returns an updated version of the Container instance.
  forall s e a.
Container s e a -> ContainerCreateContainerFromModel s e a
containerCreateContainerFromModel :: ContainerCreateContainerFromModel s e a,
  -- | Returns the current style, depending on the status of the widget.
  forall s e a. Container s e a -> ContainerGetCurrentStyle s e
containerGetCurrentStyle :: ContainerGetCurrentStyle s e,
  -- | Updates the widget environment before passing it down to children.
  forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
containerUpdateCWenv :: ContainerUpdateCWenvHandler s e,
  -- | Initializes the given node.
  forall s e a. Container s e a -> ContainerInitHandler s e
containerInit :: ContainerInitHandler s e,
  -- | Allow for extra steps after children are initialized.
  forall s e a. Container s e a -> ContainerInitPostHandler s e a
containerInitPost :: ContainerInitPostHandler s e a,
  -- | Returns whether merge is required for children.
  forall s e a.
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.
  forall s e a. Container s e a -> ContainerMergeHandler s e a
containerMerge :: ContainerMergeHandler s e a,
  -- | Allow for extra steps after children are merged.
  forall s e a. Container s e a -> ContainerMergePostHandler s e a
containerMergePost :: ContainerMergePostHandler s e a,
  -- | Disposes the current node.
  forall s e a. Container s e a -> ContainerInitHandler s e
containerDispose :: ContainerDisposeHandler s e,
  -- | Returns the next focusable node.
  forall s e a. Container s e a -> ContainerFindNextFocusHandler s e
containerFindNextFocus :: ContainerFindNextFocusHandler s e,
  -- | Returns the currently hovered widget, if any.
  forall s e a. Container s e a -> ContainerFindByPointHandler s e
containerFindByPoint :: ContainerFindByPointHandler s e,
  -- | Receives a System event and, optionally, filters/modifies it.
  forall s e a. Container s e a -> ContainerFilterHandler s e
containerFilterEvent :: ContainerFilterHandler s e,
  -- | Receives a System event and, optionally, returns a result.
  forall s e a. Container s e a -> ContainerEventHandler s e
containerHandleEvent :: ContainerEventHandler s e,
  -- | Receives a message and, optionally, returns a result.
  forall s e a. Container s e a -> ContainerMessageHandler s e
containerHandleMessage :: ContainerMessageHandler s e,
  -- | Returns the preferred size for the widget.
  forall s e a. Container s e a -> ContainerGetSizeReqHandler s e
containerGetSizeReq :: ContainerGetSizeReqHandler s e,
  -- | Resizes the widget to the provided size.
  forall s e a. Container s e a -> ContainerResizeHandler s e
containerResize :: ContainerResizeHandler s e,
  -- | Renders the widget's content. This runs before children's render.
  forall s e a. Container s e a -> ContainerRenderHandler s e
containerRender :: ContainerRenderHandler s e,
  -- | Renders the widget's content. This runs after children's render.
  forall s e a. 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 {
    containerAddStyleReq :: Bool
containerAddStyleReq = Bool
True,
    containerChildrenOffset :: Maybe Point
containerChildrenOffset = forall a. Maybe a
Nothing,
    containerChildrenScissor :: Maybe Rect
containerChildrenScissor = 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 = forall s e. ContainerGetBaseStyle s e
defaultGetBaseStyle,
    containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = forall s e. ContainerGetCurrentStyle s e
defaultGetCurrentStyle,
    containerCreateContainerFromModel :: ContainerCreateContainerFromModel s e a
containerCreateContainerFromModel = forall s e a. ContainerCreateContainerFromModel s e a
defaultCreateContainerFromModel,
    containerUpdateCWenv :: ContainerUpdateCWenvHandler s e
containerUpdateCWenv = forall s e. ContainerUpdateCWenvHandler s e
defaultUpdateCWenv,
    containerInit :: ContainerInitHandler s e
containerInit = forall s e. ContainerInitHandler s e
defaultInit,
    containerInitPost :: ContainerInitPostHandler s e a
containerInitPost = forall s e a. ContainerInitPostHandler s e a
defaultInitPost,
    containerMergeChildrenReq :: ContainerMergeChildrenReqHandler s e a
containerMergeChildrenReq = forall s e a. ContainerMergeChildrenReqHandler s e a
defaultMergeRequired,
    containerMerge :: ContainerMergeHandler s e a
containerMerge = forall s e a. ContainerMergeHandler s e a
defaultMerge,
    containerMergePost :: ContainerMergePostHandler s e a
containerMergePost = forall s e a. ContainerMergePostHandler s e a
defaultMergePost,
    containerDispose :: ContainerInitHandler s e
containerDispose = forall s e. ContainerInitHandler s e
defaultDispose,
    containerFindNextFocus :: ContainerFindNextFocusHandler s e
containerFindNextFocus = forall s e. ContainerFindNextFocusHandler s e
defaultFindNextFocus,
    containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = forall s e. ContainerFindByPointHandler s e
defaultFindByPoint,
    containerFilterEvent :: ContainerFilterHandler s e
containerFilterEvent = forall s e. ContainerFilterHandler s e
defaultFilterEvent,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = forall s e. ContainerEventHandler s e
defaultHandleEvent,
    containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = forall s e. ContainerMessageHandler s e
defaultHandleMessage,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = forall s e. ContainerGetSizeReqHandler s e
defaultGetSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = forall s e. ContainerResizeHandler s e
defaultResize,
    containerRender :: ContainerRenderHandler s e
containerRender = forall s e. ContainerRenderHandler s e
defaultRender,
    containerRenderAfter :: ContainerRenderHandler s e
containerRenderAfter = 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 :: forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer !a
state !Container s e a
container = Widget {
  widgetInit :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit = 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 = 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 = forall s e a. Container s e a -> ContainerInitHandler s e
disposeWrapper Container s e a
container,
  widgetGetState :: WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = forall s e a. Container s e a -> ContainerRenderHandler s e
renderWrapper Container s e a
container
}

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

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

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

defaultUpdateCWenv :: ContainerUpdateCWenvHandler s e
defaultUpdateCWenv :: forall s e. 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 :: forall s e a. Container s e a -> ContainerUpdateCWenvHandler 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 = forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container
  updateCWenv :: ContainerUpdateCWenvHandler s e
updateCWenv = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
containerUpdateCWenv Container s e a
container
  layoutDirection :: LayoutDirection
layoutDirection = forall s e a. Container s e a -> LayoutDirection
containerLayoutDirection Container s e a
container

  pViewport :: Rect
pViewport = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
  cViewport :: Rect
cViewport = WidgetNode s e
cnode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
  newViewport :: Rect
newViewport = forall a. a -> Maybe a -> a
fromMaybe 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
    | forall a. Maybe a -> Bool
isJust Maybe Point
cOffset = 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
    forall a b. a -> (a -> b) -> b
& forall s a. HasLayoutDirection s a => Lens' s a
L.layoutDirection forall s t a b. ASetter s t a b -> b -> s -> t
.~ LayoutDirection
layoutDirection

  !newWenv :: WidgetEnv s e
newWenv = ContainerUpdateCWenvHandler 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 :: 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
viewport = WidgetEnv s e
newWenv where
  cOffset :: Maybe Point
cOffset = forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container
  offset :: Point
offset = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def Maybe Point
cOffset

  updateMain :: (Path, Point) -> (Path, Point)
updateMain (Path
path, Point
point)
    | 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
    forall a b. a -> (a -> b) -> b
& forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point -> Rect -> Rect
moveRect (Point -> Point
negPoint Point
offset) Rect
viewport
    forall a b. a -> (a -> b) -> b
& forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point -> Point -> Point
addPoint (Point -> Point
negPoint Point
offset)
    forall a b. a -> (a -> b) -> b
& forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePosPrev s a => Lens' s a
L.mousePosPrev forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point -> Point -> Point
addPoint (Point -> Point
negPoint Point
offset)
    forall a b. a -> (a -> b) -> b
& forall s a. HasOffset s a => Lens' s a
L.offset forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point -> Point -> Point
addPoint Point
offset
    forall a b. a -> (a -> b) -> b
& forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ 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 :: forall s e. ContainerInitHandler s e
defaultInit WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

defaultInitPost :: ContainerInitPostHandler s e a
defaultInitPost :: forall s e a. 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 :: 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 WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
  initHandler :: ContainerInitHandler s e
initHandler = forall s e a. Container s e a -> ContainerInitHandler s e
containerInit Container s e a
container
  initPostHandler :: ContainerInitPostHandler s e a
initPostHandler = forall s e a. Container s e a -> ContainerInitPostHandler s e a
containerInitPost Container s e a
container
  getBaseStyle :: ContainerGetBaseStyle s e
getBaseStyle = 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 = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container

  styledNode :: WidgetNode s e
styledNode = 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 = ContainerInitHandler s e
initHandler WidgetEnv s e
wenv WidgetNode s e
styledNode
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
tempNode forall s a. s -> Getting a s a -> a
^. 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 = 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 = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  results :: Seq (WidgetResult s e)
results = 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 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests Seq (WidgetResult s e)
results
  newChildren :: Seq (WidgetNode s e)
newChildren = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s e. WidgetResult s e -> WidgetNode s e
_wrNode Seq (WidgetResult s e)
results
  newNode :: WidgetNode s e
newNode = forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv forall a b. (a -> b) -> a -> b
$ WidgetNode s e
tempNode
    forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode s e)
newChildren

  tmpResult :: WidgetResult s e
tmpResult = forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
newNode (Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
newReqs)
  newState :: Maybe WidgetState
newState = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
newNode forall s a. s -> Getting a s a -> a
^. 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 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 :: forall s e a. 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 :: forall s e a. ContainerMergeHandler s e a
defaultMerge WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode a
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode

defaultMergePost :: ContainerMergePostHandler s e a
defaultMergePost :: forall s e a. 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 :: 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 WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode = WidgetResult s e
newResult where
  getBaseStyle :: ContainerGetBaseStyle s e
getBaseStyle = forall s e a. Container s e a -> ContainerGetBaseStyle s e
containerGetBaseStyle Container s e a
container
  createContainerFromModel :: ContainerCreateContainerFromModel s e a
createContainerFromModel = forall s e a.
Container s e a -> ContainerCreateContainerFromModel s e a
containerCreateContainerFromModel Container s e a
container

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

  oldState :: Maybe WidgetState
oldState = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
oldNode forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
oldNode
  mergeRequired :: Bool
mergeRequired = case 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 = 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
  pResult :: WidgetResult s e
pResult = 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
  pNode :: WidgetNode s e
pNode = WidgetResult s e
pResult forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node

  -- Check if an updated container can be used for offset/layout direction.
  updateCWenv :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> Int -> WidgetEnv s e
updateCWenv = case forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
oldState 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 -> forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
newContainer
    Maybe (Container s e a)
_ -> 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

  cResult :: WidgetResult s e
cResult = 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
pNode WidgetNode s e
oldNode WidgetResult s e
pResult
  vResult :: WidgetResult s e
vResult = forall s e. WidgetNode s e -> WidgetResult s e -> WidgetResult s e
mergeChildrenCheckVisible WidgetNode s e
oldNode WidgetResult s e
cResult

  flagsChanged :: Bool
flagsChanged = forall s e. WidgetNode s e -> WidgetNode s e -> Bool
nodeFlagsChanged WidgetNode s e
oldNode WidgetNode s e
pNode
  themeChanged :: Bool
themeChanged = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. 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 forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNode s e
oldNode forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children

  mNode :: WidgetNode s e
mNode = WidgetResult s e
mResult forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node
  mState :: Maybe WidgetState
mState = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
mNode forall s a. s -> Getting a s a -> a
^. 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 (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
oldState forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> WidgetResult s e
mResult

  tmpResult :: WidgetResult s e
tmpResult = WidgetResult s e
postRes
    forall a b. a -> (a -> b) -> b
& forall s e.
WidgetEnv s e
-> WidgetNode s e -> WidgetResult s e -> WidgetResult s e
handleUserSizeReqChange WidgetEnv s e
wenv WidgetNode s e
oldNode
    forall a b. a -> (a -> b) -> b
& forall s e. WidgetNode s e -> WidgetResult s e -> WidgetResult s e
handleWidgetIdChange WidgetNode s e
oldNode

  newResult :: WidgetResult s e
newResult
    | forall s e. Maybe (WidgetResult s e) -> Bool
isResizeAnyResult (forall a. a -> Maybe a
Just WidgetResult s e
tmpResult) = WidgetResult s e
tmpResult
        forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv (WidgetResult s e
tmpResult forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node)
    | Bool
otherwise = 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 :: 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
newNode WidgetNode s e
oldNode Maybe WidgetState
oldState = WidgetResult s e
result where
  oldInfo :: WidgetNodeInfo
oldInfo = WidgetNode s e
oldNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
  tempNode :: WidgetNode s e
tempNode = WidgetNode s e
newNode
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
  result :: WidgetResult s e
result = case 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 -> 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 :: 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
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 forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
  oldIts :: Seq (Int, WidgetNode s e)
oldIts = 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 forall s a. s -> Getting a s a -> a
^. 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, 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 = 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 = 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 = forall s e. Seq (WidgetNode s e) -> Map WidgetKey (WidgetNode s e)
buildLocalMap (forall a b. (a, b) -> b
snd 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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s e. WidgetResult s e -> WidgetNode s e
_wrNode Seq (WidgetResult s e)
mergedResults
  mergedReqs :: Seq (WidgetRequest s e)
mergedReqs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests Seq (WidgetResult s e)
mergedResults
  removedReqs :: Seq (WidgetRequest s e)
removedReqs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap 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 forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children 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 forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
mergedReqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
removedReqs
  !newResult :: WidgetResult s e
newResult = 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 :: 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)
oldIts Seq (Int, WidgetNode s e)
Empty = forall {a}. (Seq a, Seq (WidgetResult s e))
res where
  isMember :: WidgetKey -> Bool
isMember = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasKey s a => Lens' s a
L.key of
    Just Bool
True -> forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
child forall a. Seq a
Empty
    Maybe Bool
_ -> forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetDispose (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. (a, WidgetNode s e) -> WidgetResult s e
dispose Seq (Int, WidgetNode s e)
oldIts
  !res :: (Seq a, Seq (WidgetResult s e))
res = (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 = 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) = WidgetResult s e
newWidget where
    newWidgetId :: WidgetId
newWidgetId = WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    newWidget :: WidgetResult s e
newWidget = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
child
      forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
|> forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
newWidgetId)

  !merged :: Seq (WidgetResult s e)
merged = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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, 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
  !newWidgetId :: WidgetId
newWidgetId = WidgetNode s e
newChild forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
  !newChildKey :: Maybe WidgetKey
newChildKey = WidgetNode s e
newChild forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WidgetKey
key -> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WidgetKey
key WidgetKeyMap s e
oldKeys
  oldMatch :: WidgetNode s e
oldMatch = forall a. a -> Maybe a -> a
fromMaybe WidgetNode s e
newNode Maybe (WidgetNode s e)
oldKeyMatch
  isMergeKey :: Bool
isMergeKey = forall a. Maybe a -> Bool
isJust Maybe (WidgetNode s e)
oldKeyMatch Bool -> Bool -> 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 = 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 = 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 = 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
    forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
|> forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
newWidgetId)

  (!WidgetResult s e
child, !Seq (Int, WidgetNode s e)
oldRest)
    | 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)
    = 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 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 :: forall s e. 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node
  widgetId :: WidgetId
widgetId = WidgetNode s e
newNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
  resizeRequired :: Bool
resizeRequired = 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 forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
|> 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 :: forall a s e.
WidgetModel a =>
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 = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  instNode :: WidgetInstanceNode
instNode = WidgetInstanceNode {
    _winInfo :: WidgetNodeInfo
_winInfo = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info,
    _winState :: Maybe WidgetState
_winState = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
node,
    _winChildren :: Seq WidgetInstanceNode
_winChildren = forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> WidgetNode s e -> WidgetInstanceNode
getChildTree (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. 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 = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
widgetGetInstanceTree (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. 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 :: forall s e. ContainerInitHandler s e
defaultDispose WidgetEnv s e
wenv WidgetNode s e
node = 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 :: forall s e a. Container s e a -> ContainerInitHandler 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 = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  disposeHandler :: ContainerDisposeHandler s e
disposeHandler = forall s e a. Container s e a -> ContainerInitHandler s e
containerDispose Container s e a
container

  WidgetResult WidgetNode s e
tempNode Seq (WidgetRequest s e)
reqs = ContainerDisposeHandler s e
disposeHandler WidgetEnv s e
wenv WidgetNode s e
node
  widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
tempNode forall s a. s -> Getting a s a -> a
^. 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 = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetDispose (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. 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 = 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 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests Seq (WidgetResult s e)
results forall a. Seq a -> a -> Seq a
|> forall s e. WidgetId -> WidgetRequest s e
ResetWidgetPath WidgetId
widgetId
  !result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
node (Seq (WidgetRequest s e)
reqs forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
newReqs)

-- | Find next focusable item
defaultFindNextFocus :: ContainerFindNextFocusHandler s e
defaultFindNextFocus :: forall s e. 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 = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible) (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. 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 :: forall s e a.
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 = 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 forall a. Eq a => a -> a -> Bool
== FocusDirection
FocusBwd = forall a. Seq a -> Seq a
Seq.reverse Seq (WidgetNode s e)
handlerResult
    | Bool
otherwise = Seq (WidgetNode s e)
handlerResult
  !nextFocus :: Maybe WidgetNodeInfo
nextFocus
    | forall s e. WidgetNode s e -> Path -> FocusDirection -> Bool
isFocusCandidate WidgetNode s e
node Path
start FocusDirection
dir = forall a. a -> Maybe a
Just (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
    | Bool
otherwise = 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 :: 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
_ WidgetEnv s e
_ FocusDirection
_ Path
_ WidgetNode s e
_ Seq (WidgetNode s e)
Empty = 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 = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  !path :: Path
path = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
  !idx :: Int
idx = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Int -> Seq a -> Maybe a
Seq.lookup (forall (t :: * -> *) a. Foldable t => t a -> Int
length Path
path 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 forall a. Eq a => a -> a -> Bool
== FocusDirection
FocusBwd = forall s e. WidgetNode s e -> Path -> Bool
isNodeBeforePath WidgetNode s e
ch Path
start
    | Bool
otherwise = forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath WidgetNode s e
ch Path
start Bool -> Bool -> Bool
|| forall s e. WidgetNode s e -> Path -> Bool
isNodeAfterPath WidgetNode s e
ch Path
start

  candidate :: Maybe WidgetNodeInfo
candidate = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
widgetFindNextFocus (WidgetNode s e
ch forall s a. s -> Getting a s a -> a
^. 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
&& forall a. Maybe a -> Bool
isJust Maybe WidgetNodeInfo
candidate = Maybe WidgetNodeInfo
candidate
    | Bool
otherwise = 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 :: forall s e. 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
  pointInWidget :: s -> Bool
pointInWidget s
wi = s
wi forall s a. s -> Getting a s a -> a
^. forall s a. HasVisible s a => Lens' s a
L.visible Bool -> Bool -> Bool
&& Point -> Rect -> Bool
pointInRect Point
point (s
wi forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport)
  result :: Maybe Int
result = forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL (forall {s}. (HasVisible s Bool, HasViewport s Rect) => s -> Bool
pointInWidget forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall s e a.
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 = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (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 = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  ignoreEmpty :: Bool
ignoreEmpty = forall s e a. Container s e a -> Bool
containerIgnoreEmptyArea Container s e a
container
  handler :: ContainerFindByPointHandler s e
handler = forall s e a. Container s e a -> ContainerFindByPointHandler s e
containerFindByPoint Container s e a
container

  isVisible :: Bool
isVisible = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible
  inVp :: Bool
inVp = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
  childIdx :: Maybe Int
childIdx = forall s e. WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
node Path
start 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
    | forall a. Seq a -> Int
Seq.length Seq (WidgetNode s e)
children forall a. Ord a => a -> a -> Bool
> Int
p Bool -> Bool -> Bool
&& Int
p forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a. a -> Maybe a
Just Int
p
    | Bool
otherwise = forall a. Maybe a
Nothing

  win :: Maybe WidgetNodeInfo
win = case Maybe Int
childIdx 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 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
idx
      childWidget :: Widget s e
childWidget = WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
      childWni :: Maybe WidgetNodeInfo
childWni = 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
      | Bool
otherwise -> forall a. Maybe a
Nothing
  result :: Maybe WidgetNodeInfo
result
    | Bool
isVisible Bool -> Bool -> Bool
&& (Bool
inVp Bool -> Bool -> Bool
|| forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) Maybe WidgetNodeInfo
win forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Path
path) = Maybe WidgetNodeInfo
win
    | Bool
otherwise = forall a. Maybe a
Nothing

containerFindBranchByPath
  :: WidgetEnv s e
  -> WidgetNode s e
  -> Path
  -> Seq WidgetNodeInfo
containerFindBranchByPath :: forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
containerFindBranchByPath !WidgetEnv s e
wenv !WidgetNode s e
node !Path
path
  | WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path forall a. Eq a => a -> a -> Bool
== Path
path = forall a. a -> Seq a
Seq.singleton WidgetNodeInfo
info
  | forall a. Maybe a -> Bool
isJust Maybe (WidgetNode s e)
nextChild = WidgetNodeInfo
info forall a. a -> Seq a -> Seq a
<| WidgetNode s e -> Seq WidgetNodeInfo
nextInst (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetNode s e)
nextChild)
  | Bool
otherwise = forall a. Seq a
Seq.empty
  where
    children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
    info :: WidgetNodeInfo
info = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
    nextStep :: Maybe Int
nextStep = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall s e.
Widget s e
-> WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
widgetFindBranchByPath (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. 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 :: forall s e. ContainerFilterHandler s e
defaultFilterEvent WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt = forall a. a -> Maybe a
Just (Path
target, SystemEvent
evt)

defaultHandleEvent :: ContainerEventHandler s e
defaultHandleEvent :: forall s e. ContainerEventHandler s e
defaultHandleEvent WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt = 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 :: 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 !WidgetEnv s e
wenv !WidgetNode s e
node !Path
baseTarget !SystemEvent
baseEvt
  | Bool -> Bool
not (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing Maybe (Path, SystemEvent)
filteredEvt = forall a. Maybe a
Nothing
  | Bool
targetReached Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
targetValid = Maybe (WidgetResult s e)
pResultStyled
  | Bool
otherwise = forall s e. WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
pNode Path
target 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 = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container)
    !style :: StyleState
style = 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 (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 = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
    filterHandler :: ContainerFilterHandler s e
filterHandler = forall s e a. Container s e a -> ContainerFilterHandler s e
containerFilterEvent Container s e a
container
    eventHandler :: ContainerEventHandler s e
eventHandler = forall s e a. Container s e a -> ContainerEventHandler s e
containerHandleEvent Container s e a
container

    !targetReached :: Bool
targetReached = forall s e. WidgetNode s e -> Path -> Bool
isTargetReached WidgetNode s e
node Path
target
    !targetValid :: Bool
targetValid = 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) = 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 = ContainerEventHandler s e
eventHandler WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt
    pResultStyled :: Maybe (WidgetResult s e)
pResultStyled = 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
      forall a b. (a -> b) -> a -> b
$ 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 (forall a. a -> Maybe a
Just SystemEvent
evt) Maybe (WidgetResult s e)
pResult
    pNode :: WidgetNode s e
pNode = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetNode s e
node (forall s a. s -> Getting a s a -> a
^. 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
      child :: WidgetNode s e
child = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
childIdx
      childWidget :: Widget s e
childWidget = WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. 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 = forall a. Maybe a -> Bool
isJust Maybe (WidgetResult s e)
pResult Bool -> Bool -> Bool
&& forall s e. WidgetResult s e -> Bool
ignoreChildren (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetResult s e)
pResult)
      parentIgnored :: Bool
parentIgnored = forall a. Maybe a -> Bool
isJust Maybe (WidgetResult s e)
cResult Bool -> Bool -> Bool
&& forall s e. WidgetResult s e -> Bool
ignoreParent (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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEnabled s a => Lens' s a
L.enabled) = forall a. Maybe a
Nothing
        | Bool
otherwise = 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 = forall s e.
WidgetNode s e
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
-> Int
-> Maybe (WidgetResult s e)
mergeParentChildEvts WidgetNode s e
node forall a. Maybe a
Nothing Maybe (WidgetResult s e)
cResult Int
childIdx
        | Bool
otherwise = 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 = 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
        forall a b. (a -> b) -> a -> b
$ 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 (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 :: forall s e.
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
_ = 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
cResponse {
    _wrNode :: WidgetNode s e
_wrNode = forall s e.
WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild WidgetNode s e
original (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
  | forall s e. WidgetResult s e -> Bool
ignoreChildren WidgetResult s e
pResponse = forall a. a -> Maybe a
Just WidgetResult s e
pResponse
  | forall s e. WidgetResult s e -> Bool
ignoreParent WidgetResult s e
cResponse = forall a. a -> Maybe a
Just WidgetResult s e
newChildResponse
  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 = forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
pResponse
    cWidget :: WidgetNode s e
cWidget = forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
cResponse
    requests :: Seq (WidgetRequest s e)
requests = forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
pResponse forall a. Semigroup a => a -> a -> a
<> forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
cResponse
    newWidget :: WidgetNode s e
newWidget = 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 = forall s e.
WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild WidgetNode s e
original (forall s e. WidgetResult s e -> WidgetNode s e
_wrNode WidgetResult s e
cResponse) Int
idx
    }

-- | Message Handling
defaultHandleMessage :: ContainerMessageHandler s e
defaultHandleMessage :: forall s e. ContainerMessageHandler s e
defaultHandleMessage WidgetEnv s e
wenv WidgetNode s e
node Path
target i
message = 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 :: 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 !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 = forall a. Maybe a
Nothing
  | Bool
otherwise = 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 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 = 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 = forall s e a. Container s e a -> ContainerMessageHandler s e
containerHandleMessage Container s e a
container

    targetReached :: Bool
targetReached = forall s e. WidgetNode s e -> Path -> Bool
isTargetReached WidgetNode s e
node Path
target
    targetValid :: Bool
targetValid = 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 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
      child :: WidgetNode s e
child = 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 = 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 forall s a. s -> Getting a s a -> a
^. 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 = forall s e.
WidgetNode s e -> WidgetNode s e -> Int -> WidgetNode s e
replaceChild WidgetNode s e
node (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 = forall s e. WidgetNode s e -> Path -> Maybe Int
nextTargetStep WidgetNode s e
node Path
target 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 :: forall s e. 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 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW, WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)
    Maybe (WidgetNode s e)
_ -> forall a. Default a => a
def

getSizeReqWrapper
  :: WidgetModel a
  => Container s e a
  -> WidgetEnv s e
  -> WidgetNode s e
  -> (SizeReq, SizeReq)
getSizeReqWrapper :: forall a s e.
WidgetModel a =>
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 = forall s e a. Container s e a -> Bool
containerAddStyleReq Container s e a
container
  handler :: ContainerGetSizeReqHandler s e
handler = forall s e a. Container s e a -> ContainerGetSizeReqHandler s e
containerGetSizeReq Container s e a
container
  style :: StyleState
style = 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 forall s a. s -> Getting a s a -> a
^. 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 = forall a. a -> Maybe a -> a
fromMaybe SizeReq
tmpReqW (StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW)
  newReqH :: SizeReq
newReqH = forall a. a -> Maybe a -> a
fromMaybe SizeReq
tmpReqH (StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)

updateSizeReq
  :: WidgetEnv s e
  -> WidgetNode s e
  -> WidgetNode s e
updateSizeReq :: forall s e. 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) = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
widgetGetSizeReq (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. 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
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqW
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH 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 :: 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
evt Maybe (WidgetResult s e)
mResult = Maybe (WidgetResult s e)
result where
  baseResult :: WidgetResult s e
baseResult = forall a. a -> Maybe a -> a
fromMaybe (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 forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node
  resizeReq :: Bool
resizeReq = forall s e. Maybe (WidgetResult s e) -> Bool
isResizeAnyResult Maybe (WidgetResult s e)
mResult
  styleChanged :: Bool
styleChanged = forall a. Maybe a -> Bool
isJust Maybe SystemEvent
evt Bool -> Bool -> Bool
&& forall s e. WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
styleStateChanged WidgetEnv s e
wenv WidgetNode s e
baseNode (forall a. HasCallStack => Maybe a -> a
fromJust Maybe SystemEvent
evt)
  result :: Maybe (WidgetResult s e)
result
    | Bool
styleChanged Bool -> Bool -> Bool
|| Bool
resizeReq = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
baseResult
      forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 :: forall s e. 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 = forall s e. ContainerGetCurrentStyle s e
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  contentArea :: Rect
contentArea = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
  childrenSizes :: Seq Rect
childrenSizes = forall a. Int -> a -> Seq a
Seq.replicate (forall a. Seq a -> Int
Seq.length Seq (WidgetNode s e)
children) Rect
contentArea
  resized :: (WidgetResult s e, Seq Rect)
resized = (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 :: 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 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 = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
  useCustomSize :: Bool
useCustomSize = forall s e a. Container s e a -> Bool
containerUseCustomSize Container s e a
container
  useChildSize :: Bool
useChildSize = forall s e a. Container s e a -> Bool
containerUseChildrenSizes Container s e a
container
  handler :: ContainerResizeHandler s e
handler = 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 = forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
  vpChanged :: Bool
vpChanged = Rect
viewport forall a. Eq a => a -> a -> Bool
/= WidgetNode s e
node 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
  children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. 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 = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
    icvp :: Rect
icvp = 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
      forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport 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 = forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> (WidgetNode s e, Rect) -> WidgetResult s e
resize (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s e. WidgetResult s e -> WidgetNode s e
_wrNode Seq (WidgetResult s e)
newChildrenRes
  newChildrenReqs :: Seq (WidgetRequest s e)
newChildrenReqs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
tempRes
      forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
newVp
      forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode s e)
newChildren
      forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Seq (WidgetRequest s e)
newChildrenReqs
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
  result :: WidgetResult s e
result = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$
    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 forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node) forall a. Maybe a
Nothing Maybe (WidgetResult s e)
tmpResult

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

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

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

          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq (Int, WidgetNode s e)
pairs forall a b. (a -> b) -> a -> b
$ \(Int
idx, WidgetNode s e
child) ->
            forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. 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

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

        -- Outside children scissor
        ContainerRenderHandler s e
renderAfter WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer
  where
    style :: StyleState
style = 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 = forall s e a. Container s e a -> ContainerUpdateCWenvHandler s e
getUpdateCWenv Container s e a
container
    drawDecorations :: Bool
drawDecorations = forall s e a. Container s e a -> Bool
containerDrawDecorations Container s e a
container
    useScissor :: Bool
useScissor = forall s e a. Container s e a -> Bool
containerUseScissor Container s e a
container
    childrenScissor :: Maybe Rect
childrenScissor = forall s e a. Container s e a -> Maybe Rect
containerChildrenScissor Container s e a
container
    offset :: Maybe Point
offset = forall s e a. Container s e a -> Maybe Point
containerChildrenOffset Container s e a
container
    renderBefore :: ContainerRenderHandler s e
renderBefore = forall s e a. Container s e a -> ContainerRenderHandler s e
containerRender Container s e a
container
    renderAfter :: ContainerRenderHandler s e
renderAfter = forall s e a. Container s e a -> ContainerRenderHandler s e
containerRenderAfter Container s e a
container

    children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
    viewport :: Rect
viewport = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
    useChildrenScissor :: Bool
useChildrenScissor = forall a. Maybe a -> Bool
isJust Maybe Rect
childrenScissor
    childrenScissorRect :: Rect
childrenScissorRect = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def Maybe Rect
childrenScissor
    pairs :: Seq (Int, WidgetNode s e)
pairs = 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 :: forall s e. WidgetResult s e -> Bool
ignoreChildren WidgetResult s e
result = Bool -> Bool
not (forall a. Seq a -> Bool
Seq.null Seq (WidgetRequest s e)
ignoreReqs) where
  ignoreReqs :: Seq (WidgetRequest s e)
ignoreReqs = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter forall s e. WidgetRequest s e -> Bool
isIgnoreChildrenEvents (forall s e. WidgetResult s e -> Seq (WidgetRequest s e)
_wrRequests WidgetResult s e
result)

ignoreParent :: WidgetResult s e -> Bool
ignoreParent :: forall s e. WidgetResult s e -> Bool
ignoreParent WidgetResult s e
result = Bool -> Bool
not (forall a. Seq a -> Bool
Seq.null Seq (WidgetRequest s e)
ignoreReqs) where
  ignoreReqs :: Seq (WidgetRequest s e)
ignoreReqs = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter forall s e. WidgetRequest s e -> Bool
isIgnoreParentEvents (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 :: forall s e.
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 forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children 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 = forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
idx WidgetNode s e
child (WidgetNode s e
parent forall s a. s -> Getting a s a -> a
^. 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 :: forall s e.
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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
  cInfo :: WidgetNodeInfo
cInfo = WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
  parentPath :: Path
parentPath = WidgetNodeInfo
pInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path
  parentVisible :: Bool
parentVisible = WidgetNodeInfo
pInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasVisible s a => Lens' s a
L.visible
  parentEnabled :: Bool
parentEnabled = WidgetNodeInfo
pInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasEnabled s a => Lens' s a
L.enabled
  !newPath :: Path
newPath = Path
parentPath forall a. Seq a -> a -> Seq a
|> Int
idx
  !newChild :: WidgetNode s e
newChild = WidgetNode s e
child
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId forall s t a b. ASetter s t a b -> b -> s -> t
.~ Millisecond -> Path -> WidgetId
WidgetId (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp) Path
newPath
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path forall s t a b. ASetter s t a b -> b -> s -> t
.~ Path
newPath
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible forall s t a b. ASetter s t a b -> b -> s -> t
.~ (WidgetNodeInfo
cInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasVisible s a => Lens' s a
L.visible Bool -> Bool -> Bool
&& Bool
parentVisible)
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEnabled s a => Lens' s a
L.enabled forall s t a b. ASetter s t a b -> b -> s -> t
.~ (WidgetNodeInfo
cInfo forall s a. s -> Getting a s a -> a
^. 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 :: forall s e. 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 a -> a -> Map k a
addWidget Map k a
map a
widget
    | forall a. Maybe a -> Bool
isJust Maybe k
key = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. HasCallStack => Maybe a -> a
fromJust Maybe k
key) a
widget Map k a
map
    | Bool
otherwise = Map k a
map
    where
      key :: Maybe k
key = a
widget forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasKey s a => Lens' s a
L.key
  newMap :: Map WidgetKey (WidgetNode s e)
newMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {k} {a} {a}.
(Ord k, HasInfo a a, HasKey a (Maybe k)) =>
Map k a -> a -> Map k a
addWidget forall k a. Map k a
M.empty Seq (WidgetNode s e)
widgets