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

Container for a single item, providing functionalities that may not be available
in other widgets.

Useful in different layout situations, since it provides alignment options. This
allows for the inner widget to keep its size while being positioned more
explicitly, while the box takes up the complete space assigned by its parent (in
particular for containers which do not follow SizeReq restrictions, such as
Grid).

@
box_ [alignRight, alignBottom] $
  image "assets/test-image.jpg"
    \`styleBasic\` [width 100, height 100]
@

Can be used to add padding to an inner widget with a border. This is equivalent
to the margin property in CSS.

@
-- Padding is inside the border
content = label \"Message\"
  \`styleBasic\` [padding 5, border 1 black]
-- Padding in the wrapper box acts as margin
container = box content
  \`styleBasic\` [padding 5]
@

Also useful to handle click events in complex widget structures (for example, a
label with an image at its side).

@
content = vstack [
    label "All the content widget is clickable",
    spacer,
    image "assets/test-image.jpg"
  ]
clickableItem = box_ [onClick ItemClicked] content
  \`styleBasic\' [cursorHand]
@
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Containers.Box (
  -- * Configuration
  BoxCfg,
  -- * Constructors
  box,
  box_,
  expandContent,
  boxFilterEvent
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~))
import Data.Default
import Data.Maybe

import qualified Data.Sequence as Seq

import Monomer.Helper (applyFnList)
import Monomer.Widgets.Container
import Monomer.Widgets.Containers.Stack

import qualified Monomer.Lens as L

{-|
Configuration options for box:

- 'mergeRequired': function called during merge that receives the old and new
  model, returning True in case the child widget needs to be merged. Since by
  default merge is required, this function can be used to restrict merging when
  it would be expensive and it is not necessary. For example, a list of widgets
  representing search result only needs to be updated when the list of results
  changes, not while the user inputs new search criteria (which also triggers a
  model change and, hence, the merge process).
- 'ignoreEmptyArea': when the inner widget does not use all the available space,
  ignoring the unassigned space allows for mouse events to pass through. This is
  useful in zstack layers.
- 'sizeReqUpdater': allows modifying the 'SizeReq' generated by the inner
  widget.
- 'alignLeft': aligns the inner widget to the left.
- 'alignCenter': aligns the inner widget to the horizontal center.
- 'alignRight': aligns the inner widget to the right.
- 'alignTop': aligns the inner widget to the top.
- 'alignMiddle': aligns the inner widget to the left.
- 'alignBottom': aligns the inner widget to the bottom.
- 'onClick': click event.
- 'onClickReq': generates a WidgetRequest on click.
- 'onClickEmpty': click event on empty area.
- 'onClickEmptyReq': generates a WidgetRequest on click in empty area.
- 'expandContent': if the inner widget should use all the available space. To be
  able to use alignment options, this must be False (the default).
- 'boxFilterEvent': allows filtering or modifying a 'SystemEvent'.
-}
data BoxCfg s e = BoxCfg {
  forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent :: Maybe Bool,
  forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea :: Maybe Bool,
  forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater :: [SizeReqUpdater],
  forall s e. BoxCfg s e -> Maybe (ContainerFilterHandler s e)
_boxFilterEvent :: Maybe (ContainerFilterHandler s e),
  forall s e. BoxCfg s e -> Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool),
  forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH :: Maybe AlignH,
  forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV :: Maybe AlignV,
  forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq :: [WidgetRequest s e],
  forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq :: [WidgetRequest s e],
  forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq :: [WidgetRequest s e],
  forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq :: [WidgetRequest s e],
  forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e],
  forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
}

instance Default (BoxCfg s e) where
  def :: BoxCfg s e
def = BoxCfg {
    _boxExpandContent :: Maybe Bool
_boxExpandContent = forall a. Maybe a
Nothing,
    _boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = forall a. Maybe a
Nothing,
    _boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = [],
    _boxFilterEvent :: Maybe (ContainerFilterHandler s e)
_boxFilterEvent = forall a. Maybe a
Nothing,
    _boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired = forall a. Maybe a
Nothing,
    _boxAlignH :: Maybe AlignH
_boxAlignH = forall a. Maybe a
Nothing,
    _boxAlignV :: Maybe AlignV
_boxAlignV = forall a. Maybe a
Nothing,
    _boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [],
    _boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [],
    _boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [],
    _boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [],
    _boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [],
    _boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [],
    _boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [],
    _boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = []
  }

instance Semigroup (BoxCfg s e) where
  <> :: BoxCfg s e -> BoxCfg s e -> BoxCfg s e
(<>) BoxCfg s e
t1 BoxCfg s e
t2 = BoxCfg {
    _boxExpandContent :: Maybe Bool
_boxExpandContent = forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
t1,
    _boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
t1,
    _boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
t2,
    _boxFilterEvent :: Maybe (ContainerFilterHandler s e)
_boxFilterEvent = forall s e. BoxCfg s e -> Maybe (ContainerFilterHandler s e)
_boxFilterEvent BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe (ContainerFilterHandler s e)
_boxFilterEvent BoxCfg s e
t1,
    _boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired = forall s e. BoxCfg s e -> Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired BoxCfg s e
t1,
    _boxAlignH :: Maybe AlignH
_boxAlignH = forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
t1,
    _boxAlignV :: Maybe AlignV
_boxAlignV = forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
t1,
    _boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
t2,
    _boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
t2,
    _boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
t2,
    _boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
t2,
    _boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
t2,
    _boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
t2,
    _boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
t2,
    _boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
t2
  }

instance Monoid (BoxCfg s e) where
  mempty :: BoxCfg s e
mempty = forall a. Default a => a
def

instance CmbIgnoreEmptyArea (BoxCfg s e) where
  ignoreEmptyArea_ :: Bool -> BoxCfg s e
ignoreEmptyArea_ Bool
ignore = forall a. Default a => a
def {
    _boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = forall a. a -> Maybe a
Just Bool
ignore
  }

instance CmbSizeReqUpdater (BoxCfg s e) where
  sizeReqUpdater :: SizeReqUpdater -> BoxCfg s e
sizeReqUpdater SizeReqUpdater
updater = forall a. Default a => a
def {
    _boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = [SizeReqUpdater
updater]
  }

instance CmbMergeRequired (BoxCfg s e) (WidgetEnv s e) s where
  mergeRequired :: (WidgetEnv s e -> s -> s -> Bool) -> BoxCfg s e
mergeRequired WidgetEnv s e -> s -> s -> Bool
fn = forall a. Default a => a
def {
    _boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired = forall a. a -> Maybe a
Just WidgetEnv s e -> s -> s -> Bool
fn
  }

instance CmbAlignLeft (BoxCfg s e) where
  alignLeft_ :: Bool -> BoxCfg s e
alignLeft_ Bool
False = forall a. Default a => a
def
  alignLeft_ Bool
True = forall a. Default a => a
def {
    _boxAlignH :: Maybe AlignH
_boxAlignH = forall a. a -> Maybe a
Just AlignH
ALeft
  }

instance CmbAlignCenter (BoxCfg s e) where
  alignCenter_ :: Bool -> BoxCfg s e
alignCenter_ Bool
False = forall a. Default a => a
def
  alignCenter_ Bool
True = forall a. Default a => a
def {
    _boxAlignH :: Maybe AlignH
_boxAlignH = forall a. a -> Maybe a
Just AlignH
ACenter
  }

instance CmbAlignRight (BoxCfg s e) where
  alignRight_ :: Bool -> BoxCfg s e
alignRight_ Bool
False = forall a. Default a => a
def
  alignRight_ Bool
True = forall a. Default a => a
def {
    _boxAlignH :: Maybe AlignH
_boxAlignH = forall a. a -> Maybe a
Just AlignH
ARight
  }

instance CmbAlignTop (BoxCfg s e) where
  alignTop_ :: Bool -> BoxCfg s e
alignTop_ Bool
False = forall a. Default a => a
def
  alignTop_ Bool
True = forall a. Default a => a
def {
    _boxAlignV :: Maybe AlignV
_boxAlignV = forall a. a -> Maybe a
Just AlignV
ATop
  }

instance CmbAlignMiddle (BoxCfg s e) where
  alignMiddle_ :: Bool -> BoxCfg s e
alignMiddle_ Bool
False = forall a. Default a => a
def
  alignMiddle_ Bool
True = forall a. Default a => a
def {
    _boxAlignV :: Maybe AlignV
_boxAlignV = forall a. a -> Maybe a
Just AlignV
AMiddle
  }

instance CmbAlignBottom (BoxCfg s e) where
  alignBottom_ :: Bool -> BoxCfg s e
alignBottom_ Bool
False = forall a. Default a => a
def
  alignBottom_ Bool
True = forall a. Default a => a
def {
    _boxAlignV :: Maybe AlignV
_boxAlignV = forall a. a -> Maybe a
Just AlignV
ABottom
  }

instance WidgetEvent e => CmbOnFocus (BoxCfg s e) e Path where
  onFocus :: (Path -> e) -> BoxCfg s e
onFocus Path -> e
handler = forall a. Default a => a
def {
    _boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
handler]
  }

instance CmbOnFocusReq (BoxCfg s e) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> BoxCfg s e
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (BoxCfg s e) e Path where
  onBlur :: (Path -> e) -> BoxCfg s e
onBlur Path -> e
handler = forall a. Default a => a
def {
    _boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
handler]
  }

instance CmbOnBlurReq (BoxCfg s e) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> BoxCfg s e
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBtnPressed (BoxCfg s e) e where
  onBtnPressed :: (Button -> Int -> e) -> BoxCfg s e
onBtnPressed Button -> Int -> e
handler = forall a. Default a => a
def {
    _boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [(forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Button -> Int -> e
handler]
  }

instance CmbOnBtnPressedReq (BoxCfg s e) s e where
  onBtnPressedReq :: (Button -> Int -> WidgetRequest s e) -> BoxCfg s e
onBtnPressedReq Button -> Int -> WidgetRequest s e
req = forall a. Default a => a
def {
    _boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [Button -> Int -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBtnReleased (BoxCfg s e) e where
  onBtnReleased :: (Button -> Int -> e) -> BoxCfg s e
onBtnReleased Button -> Int -> e
handler = forall a. Default a => a
def {
    _boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = [(forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Button -> Int -> e
handler]
  }

instance CmbOnBtnReleasedReq (BoxCfg s e) s e where
  onBtnReleasedReq :: (Button -> Int -> WidgetRequest s e) -> BoxCfg s e
onBtnReleasedReq Button -> Int -> WidgetRequest s e
req = forall a. Default a => a
def {
    _boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = [Button -> Int -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnClick (BoxCfg s e) e where
  onClick :: e -> BoxCfg s e
onClick e
handler = forall a. Default a => a
def {
    _boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnClickReq (BoxCfg s e) s e where
  onClickReq :: WidgetRequest s e -> BoxCfg s e
onClickReq WidgetRequest s e
req = forall a. Default a => a
def {
    _boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnClickEmpty (BoxCfg s e) e where
  onClickEmpty :: e -> BoxCfg s e
onClickEmpty e
handler = forall a. Default a => a
def {
    _boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnClickEmptyReq (BoxCfg s e) s e where
  onClickEmptyReq :: WidgetRequest s e -> BoxCfg s e
onClickEmptyReq WidgetRequest s e
req = forall a. Default a => a
def {
    _boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnEnter (BoxCfg s e) e where
  onEnter :: e -> BoxCfg s e
onEnter e
handler = forall a. Default a => a
def {
    _boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnEnterReq (BoxCfg s e) s e where
  onEnterReq :: WidgetRequest s e -> BoxCfg s e
onEnterReq WidgetRequest s e
req = forall a. Default a => a
def {
    _boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnLeave (BoxCfg s e) e where
  onLeave :: e -> BoxCfg s e
onLeave e
handler = forall a. Default a => a
def {
    _boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnLeaveReq (BoxCfg s e) s e where
  onLeaveReq :: WidgetRequest s e -> BoxCfg s e
onLeaveReq WidgetRequest s e
req = forall a. Default a => a
def {
    _boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [WidgetRequest s e
req]
  }

-- | Assigns all the available space to its contained child.
expandContent :: BoxCfg s e
expandContent :: forall s e. BoxCfg s e
expandContent = forall a. Default a => a
def {
  _boxExpandContent :: Maybe Bool
_boxExpandContent = forall a. a -> Maybe a
Just Bool
True
}

{-|
Receives a System event and, optionally, modifies the event, its target, or
stops the event propagation by returning Nothing.
-}
boxFilterEvent :: ContainerFilterHandler s e -> BoxCfg  s e
boxFilterEvent :: forall s e. ContainerFilterHandler s e -> BoxCfg s e
boxFilterEvent ContainerFilterHandler s e
handler = forall a. Default a => a
def {
  _boxFilterEvent :: Maybe (ContainerFilterHandler s e)
_boxFilterEvent = forall a. a -> Maybe a
Just ContainerFilterHandler s e
handler
}

newtype BoxState s = BoxState {
  forall s. BoxState s -> Maybe s
_bxsModel :: Maybe s
}

-- | Creates a box widget with a single node as child.
box :: (WidgetModel s, WidgetEvent e) => WidgetNode s e -> WidgetNode s e
box :: forall s e.
(WidgetModel s, WidgetEvent e) =>
WidgetNode s e -> WidgetNode s e
box WidgetNode s e
managed = forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ forall a. Default a => a
def WidgetNode s e
managed

-- | Creates a box widget with a single node as child. Accepts config.
box_
  :: (WidgetModel s, WidgetEvent e)
  => [BoxCfg s e]
  -> WidgetNode s e
  -> WidgetNode s e
box_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [BoxCfg s e]
configs WidgetNode s e
managed = forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config forall {s}. BoxState s
state) WidgetNode s e
managed where
  config :: BoxCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [BoxCfg s e]
configs
  state :: BoxState s
state = forall s. Maybe s -> BoxState s
BoxState forall a. Maybe a
Nothing

makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
managedWidget = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"box" Widget s e
widget
  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. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
  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
.~ forall a. a -> Seq a
Seq.singleton WidgetNode s e
managedWidget

makeBox
  :: (WidgetModel s, WidgetEvent e)
  => BoxCfg s e
  -> BoxState s
  -> Widget s e
makeBox :: forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
state = Widget s e
widget where
  widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer BoxState s
state forall a. Default a => a
def {
    containerIgnoreEmptyArea :: Bool
containerIgnoreEmptyArea = Bool
ignoreEmptyArea Bool -> Bool -> Bool
&& Int
emptyHandlersCount forall a. Eq a => a -> a -> Bool
== Int
0,
    containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle,
    containerInit :: ContainerInitHandler s e
containerInit = forall {p}. HasModel p s => p -> WidgetNode s e -> WidgetResult s e
init,
    containerMergeChildrenReq :: ContainerMergeChildrenReqHandler s e (BoxState s)
containerMergeChildrenReq = forall {p} {p}. WidgetEnv s e -> p -> p -> BoxState s -> Bool
mergeRequired,
    containerMerge :: ContainerMergeHandler s e (BoxState s)
containerMerge = forall {p} {p} {p}.
HasModel p s =>
p -> WidgetNode s e -> p -> p -> WidgetResult s e
merge,
    containerFilterEvent :: ContainerFilterHandler s e
containerFilterEvent = ContainerFilterHandler s e
filterEvent,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = forall {p} {p}.
p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = forall {s} {e} {s} {e}.
WidgetEnv s e
-> WidgetNode s e
-> Rect
-> Seq (WidgetNode s e)
-> (WidgetResult s e, Seq Rect)
resize
  }

  ignoreEmptyArea :: Bool
ignoreEmptyArea = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
config
  emptyHandlersCount :: Int
emptyHandlersCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config)

  init :: p -> WidgetNode s e -> WidgetResult s e
init p
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newState :: BoxState s
newState = forall s. Maybe s -> BoxState s
BoxState (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model)
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
newState

  mergeRequired :: WidgetEnv s e -> p -> p -> BoxState s -> Bool
mergeRequired WidgetEnv s e
wenv p
node p
oldNode BoxState s
oldState = Bool
required where
    newModel :: s
newModel = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model
    required :: Bool
required = case (forall s e. BoxCfg s e -> Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired BoxCfg s e
config, forall s. BoxState s -> Maybe s
_bxsModel BoxState s
oldState) of
      (Just WidgetEnv s e -> s -> s -> Bool
mergeReqFn, Just s
oldModel) -> WidgetEnv s e -> s -> s -> Bool
mergeReqFn WidgetEnv s e
wenv s
oldModel s
newModel
      (Maybe (WidgetEnv s e -> s -> s -> Bool), Maybe s)
_ -> Bool
True

  merge :: p -> WidgetNode s e -> p -> p -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode p
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newState :: BoxState s
newState = forall s. Maybe s -> BoxState s
BoxState (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model)
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
newState

  getCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle = forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ CurrentStyleCfg s e
currentStyleConfig where
    currentStyleConfig :: CurrentStyleCfg s e
currentStyleConfig = forall a. Default a => a
def
      forall a b. a -> (a -> b) -> b
& forall s a. HasIsActive s a => Lens' s a
L.isActive forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTreeActive

  filterEvent :: ContainerFilterHandler s e
filterEvent = case forall s e. BoxCfg s e -> Maybe (ContainerFilterHandler s e)
_boxFilterEvent BoxCfg s e
config of
    Just ContainerFilterHandler s e
handler -> ContainerFilterHandler s e
handler
    Maybe (ContainerFilterHandler s e)
_ -> \WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt -> forall a. a -> Maybe a
Just (Path
target, SystemEvent
evt)

  handleEvent :: p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent p
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    Focus Path
prev -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev (forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
config)
    Blur Path
next -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
config)

    Enter Point
point
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    Leave Point
point
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    Click Point
point Button
btn Int
_
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    Click Point
point Button
btn Int
_
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
inChildVp Point
point) -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
config forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
config forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqsA :: [WidgetRequest s e]
reqsA = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
config
        reqsB :: [WidgetRequest s e]
reqsB = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
config forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
        reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
reqsA forall a. Semigroup a => a -> a -> a
<> [WidgetRequest s e]
reqsB
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
inChildVp Point
point) -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    SystemEvent
_ -> forall a. Maybe a
Nothing
    where
      child :: WidgetNode s e
child = forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
0
      inChildVp :: Point -> Bool
inChildVp Point
point  = Point -> Rect -> Bool
pointInRect Point
point (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. HasViewport s a => Lens' s a
L.viewport)

  getSizeReq :: ContainerGetSizeReqHandler s e
  getSizeReq :: forall s e. ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq, SizeReq)
newSizeReq where
    sizeReqFns :: [SizeReqUpdater]
sizeReqFns = forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
config
    child :: WidgetNode s e
child = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    newReqW :: SizeReq
newReqW = 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
    newReqH :: SizeReq
newReqH = 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
    newSizeReq :: (SizeReq, SizeReq)
newSizeReq = forall a. [a -> a] -> a -> a
applyFnList [SizeReqUpdater]
sizeReqFns (SizeReq
newReqW, SizeReq
newReqH)

  resize :: WidgetEnv s e
-> WidgetNode s e
-> Rect
-> Seq (WidgetNode s e)
-> (WidgetResult s e, Seq Rect)
resize 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}. WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
    child :: WidgetNode s e
child = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    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)
    Rect Double
cx Double
cy Double
cw Double
ch = Rect
contentArea

    contentW :: Double
contentW = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall s e.
Bool
-> Rect -> Double -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
True Rect
contentArea Double
0 Seq (WidgetNode s e)
children
    contentH :: Double
contentH = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall s e.
Bool
-> Rect -> Double -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
False Rect
contentArea Double
0 Seq (WidgetNode s e)
children

    raChild :: Rect
raChild = Double -> Double -> Double -> Double -> Rect
Rect Double
cx Double
cy (forall a. Ord a => a -> a -> a
min Double
cw Double
contentW) (forall a. Ord a => a -> a -> a
min Double
ch Double
contentH)
    ah :: AlignH
ah = forall a. a -> Maybe a -> a
fromMaybe AlignH
ACenter (forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
config)
    av :: AlignV
av = forall a. a -> Maybe a -> a
fromMaybe AlignV
AMiddle (forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
config)
    raAligned :: Rect
raAligned = Rect -> Rect -> AlignH -> AlignV -> Rect
alignInRect Rect
contentArea Rect
raChild AlignH
ah AlignV
av

    expand :: Bool
expand = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
config)
    resized :: (WidgetResult s e, Seq Rect)
resized
      | Bool
expand = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, forall a. a -> Seq a
Seq.singleton Rect
contentArea)
      | Bool
otherwise = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, forall a. a -> Seq a
Seq.singleton Rect
raAligned)