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

Dropdown widget, allowing selection of a single item from a collapsable list.
Both header and list content are customizable, and so is their styling.

In case only 'Text' content is needed, "Monomer.Widgets.Singles.TextDropdown" is
easier to use.

@
makeSelected username = hstack [
    label "Selected: ",
    spacer,
    label username
  ]
makeRow username = label username

customDropdown = dropdown userLens usernames makeSelected makeRow
@

Note: the content of the dropdown list will only be updated when the provided
items change, based on their 'Eq' instance. In case data external to the items
is used for building the row nodes, 'mergeRequired' may be needed to avoid stale
content.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Containers.Dropdown (
  -- * Configuration
  DropdownCfg,
  DropdownItem,
  -- * Constructors
  dropdown,
  dropdown_,
  dropdownV,
  dropdownV_,
  dropdownD_
) where

import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (^?!), (.~), (%~), (<>~), ix, non)
import Control.Monad
import Data.Default
import Data.List (foldl')
import Data.Maybe
import Data.Sequence (Seq(..), (|>))
import Data.Typeable (Proxy, cast, typeRep)
import GHC.Generics
import TextShow

import qualified Data.Sequence as Seq

import Monomer.Helper
import Monomer.Widgets.Container
import Monomer.Widgets.Containers.SelectList

import qualified Monomer.Lens as L

-- | Constraints for an item handled by dropdown.
type DropdownItem a = SelectListItem a

{-|
Configuration options for dropdown:

- 'onFocus': event to raise when focus is received.
- 'onFocusReq': 'WidgetRequest' to generate when focus is received.
- 'onBlur': event to raise when focus is lost.
- 'onBlurReq': 'WidgetRequest' to generate when focus is lost.
- 'onChange': event to raise when selected item changes.
- 'onChangeReq': 'WidgetRequest' to generate when selected item changes.
- 'onChangeIdx': event to raise when selected item changes. Includes index.
- 'onChangeIdxReq': 'WidgetRequest' to generate when selected item changes.
  Includes index.
- 'maxHeight': maximum height of the list when dropdown is expanded.
- 'itemBasicStyle': 'Style' of an item in the list when not selected.
- 'itemSelectedStyle': 'Style' of the selected item in the list.
- 'mergeRequired': whether merging the items in the list is required. Useful
  when the content displayed depends on external data, since changes to data
  outside the provided list cannot be detected. In general it is recommended to
  only depend on data contained in the list itself, making sure the 'Eq'
  instance of the item type is correct.
-}
data DropdownCfg s e a = DropdownCfg {
  forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight :: Maybe Double,
  forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle :: Maybe Style,
  forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle :: Maybe Style,
  forall s e a.
DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool),
  forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq :: [a -> WidgetRequest s e],
  forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
}

instance Default (DropdownCfg s e a) where
  def :: DropdownCfg s e a
def = DropdownCfg {
    _ddcMaxHeight :: Maybe Double
_ddcMaxHeight = Maybe Double
forall a. Maybe a
Nothing,
    _ddcItemStyle :: Maybe Style
_ddcItemStyle = Maybe Style
forall a. Maybe a
Nothing,
    _ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = Maybe Style
forall a. Maybe a
Nothing,
    _ddcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired = Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall a. Maybe a
Nothing,
    _ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = [],
    _ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = [],
    _ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = [],
    _ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = []
  }

instance Semigroup (DropdownCfg s e a) where
  <> :: DropdownCfg s e a -> DropdownCfg s e a -> DropdownCfg s e a
(<>) DropdownCfg s e a
t1 DropdownCfg s e a
t2 = DropdownCfg {
    _ddcMaxHeight :: Maybe Double
_ddcMaxHeight = DropdownCfg s e a -> Maybe Double
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
t2 Maybe Double -> Maybe Double -> Maybe Double
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Double
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
t1,
    _ddcItemStyle :: Maybe Style
_ddcItemStyle = DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
t2 Maybe Style -> Maybe Style -> Maybe Style
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
t1,
    _ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
t2 Maybe Style -> Maybe Style -> Maybe Style
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
t1,
    _ddcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired = DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall s e a.
DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired DropdownCfg s e a
t2 Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall s e a.
DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired DropdownCfg s e a
t1,
    _ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
t2,
    _ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
t2,
    _ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = DropdownCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
t1 [a -> WidgetRequest s e]
-> [a -> WidgetRequest s e] -> [a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
t2,
    _ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
t1 [Int -> a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
t2
  }

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

instance WidgetEvent e => CmbOnFocus (DropdownCfg s e a) e Path where
  onFocus :: (Path -> e) -> DropdownCfg s e a
onFocus Path -> e
fn = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcOnFocusReq = [RaiseEvent . fn]
  }

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

instance WidgetEvent e => CmbOnBlur (DropdownCfg s e a) e Path where
  onBlur :: (Path -> e) -> DropdownCfg s e a
onBlur Path -> e
fn = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcOnBlurReq = [RaiseEvent . fn]
  }

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

instance WidgetEvent e => CmbOnChange (DropdownCfg s e a) a e where
  onChange :: (a -> e) -> DropdownCfg s e a
onChange a -> e
fn = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcOnChangeReq = [RaiseEvent . fn]
  }

instance CmbOnChangeReq (DropdownCfg s e a) s e a where
  onChangeReq :: (a -> WidgetRequest s e) -> DropdownCfg s e a
onChangeReq a -> WidgetRequest s e
req = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcOnChangeReq = [req]
  }

instance WidgetEvent e => CmbOnChangeIdx (DropdownCfg s e a) e a where
  onChangeIdx :: (Int -> a -> e) -> DropdownCfg s e a
onChangeIdx Int -> a -> e
fn = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcOnChangeIdxReq = [(RaiseEvent .) . fn]
  }

instance CmbOnChangeIdxReq (DropdownCfg s e a) s e a where
  onChangeIdxReq :: (Int -> a -> WidgetRequest s e) -> DropdownCfg s e a
onChangeIdxReq Int -> a -> WidgetRequest s e
req = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcOnChangeIdxReq = [req]
  }

instance CmbMaxHeight (DropdownCfg s e a) where
  maxHeight :: Double -> DropdownCfg s e a
maxHeight Double
h = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcMaxHeight = Just h
  }

instance CmbItemBasicStyle (DropdownCfg s e a) Style where
  itemBasicStyle :: Style -> DropdownCfg s e a
itemBasicStyle Style
style = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcItemStyle = Just style
  }

instance CmbItemSelectedStyle (DropdownCfg s e a) Style where
  itemSelectedStyle :: Style -> DropdownCfg s e a
itemSelectedStyle Style
style = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcItemSelectedStyle = Just style
  }

instance CmbMergeRequired (DropdownCfg s e a) (WidgetEnv s e) (Seq a) where
  mergeRequired :: (WidgetEnv s e -> Seq a -> Seq a -> Bool) -> DropdownCfg s e a
mergeRequired WidgetEnv s e -> Seq a -> Seq a -> Bool
fn = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcMergeRequired = Just fn
  }

data DropdownState = DropdownState {
  DropdownState -> Bool
_ddsOpen :: Bool,
  DropdownState -> Point
_ddsOffset :: Point
} deriving (DropdownState -> DropdownState -> Bool
(DropdownState -> DropdownState -> Bool)
-> (DropdownState -> DropdownState -> Bool) -> Eq DropdownState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DropdownState -> DropdownState -> Bool
== :: DropdownState -> DropdownState -> Bool
$c/= :: DropdownState -> DropdownState -> Bool
/= :: DropdownState -> DropdownState -> Bool
Eq, Int -> DropdownState -> ShowS
[DropdownState] -> ShowS
DropdownState -> String
(Int -> DropdownState -> ShowS)
-> (DropdownState -> String)
-> ([DropdownState] -> ShowS)
-> Show DropdownState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DropdownState -> ShowS
showsPrec :: Int -> DropdownState -> ShowS
$cshow :: DropdownState -> String
show :: DropdownState -> String
$cshowList :: [DropdownState] -> ShowS
showList :: [DropdownState] -> ShowS
Show, (forall x. DropdownState -> Rep DropdownState x)
-> (forall x. Rep DropdownState x -> DropdownState)
-> Generic DropdownState
forall x. Rep DropdownState x -> DropdownState
forall x. DropdownState -> Rep DropdownState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DropdownState -> Rep DropdownState x
from :: forall x. DropdownState -> Rep DropdownState x
$cto :: forall x. Rep DropdownState x -> DropdownState
to :: forall x. Rep DropdownState x -> DropdownState
Generic)

data DropdownMessage
  = forall a . DropdownItem a => OnChangeMessage Int a
  | OnListBlur

-- | Creates a dropdown using the given lens.
dropdown
  :: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
  => ALens' s a             -- ^ The lens into the model.
  -> t a                    -- ^ The list of selectable items.
  -> (a -> WidgetNode s e)  -- ^ Function to create the header (always visible).
  -> (a -> WidgetNode s e)  -- ^ Function to create the list (collapsable).
  -> WidgetNode s e         -- ^ The created dropdown.
dropdown :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> WidgetNode s e
dropdown ALens' s a
field t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdown_ ALens' s a
field t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
forall a. Default a => a
def

-- | Creates a dropdown using the given lens. Accepts config.
dropdown_
  :: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
  => ALens' s a             -- ^ The lens into the model.
  -> t a                    -- ^ The list of selectable items.
  -> (a -> WidgetNode s e)  -- ^ Function to create the header (always visible).
  -> (a -> WidgetNode s e)  -- ^ Function to create the list (collapsable).
  -> [DropdownCfg s e a]    -- ^ The config options.
  -> WidgetNode s e         -- ^ The created dropdown.
dropdown_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdown_ ALens' s a
field t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s a
widgetData = ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field
  newNode :: WidgetNode s e
newNode = WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownD_ WidgetData s a
widgetData t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs

-- | Creates a dropdown using the given value and 'onChange' event handler.
dropdownV
  :: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
  => a                      -- ^ The current value.
  -> (Int -> a -> e)        -- ^ The event to raise on change.
  -> t a                    -- ^ The list of selectable items.
  -> (a -> WidgetNode s e)  -- ^ Function to create the header (always visible).
  -> (a -> WidgetNode s e)  -- ^ Function to create the list (collapsable).
  -> WidgetNode s e         -- ^ The created dropdown.
dropdownV :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> WidgetNode s e
dropdownV a
value Int -> a -> e
handler t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownV_ a
value Int -> a -> e
handler t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
forall a. Default a => a
def

-- | Creates a dropdown using the given value and 'onChange' event handler.
-- | Accepts config.
dropdownV_
  :: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
  => a                      -- ^ The current value.
  -> (Int -> a -> e)        -- ^ The event to raise on change.
  -> t a                    -- ^ The list of selectable items.
  -> (a -> WidgetNode s e)  -- ^ Function to create the header (always visible).
  -> (a -> WidgetNode s e)  -- ^ Function to create the list (collapsable).
  -> [DropdownCfg s e a]    -- ^ The config options.
  -> WidgetNode s e         -- ^ The created dropdown.
dropdownV_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownV_ a
value Int -> a -> e
handler t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  newConfigs :: [DropdownCfg s e a]
newConfigs = (Int -> a -> e) -> DropdownCfg s e a
forall t e a. CmbOnChangeIdx t e a => (Int -> a -> e) -> t
onChangeIdx Int -> a -> e
handler DropdownCfg s e a -> [DropdownCfg s e a] -> [DropdownCfg s e a]
forall a. a -> [a] -> [a]
: [DropdownCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownD_ (a -> WidgetData s a
forall s a. a -> WidgetData s a
WidgetValue a
value) t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
newConfigs

-- | Creates a dropdown providing a WidgetData instance and config.
dropdownD_
  :: forall s e t a . (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
  => WidgetData s a         -- ^ The 'WidgetData' to retrieve the value from.
  -> t a                    -- ^ The list of selectable items.
  -> (a -> WidgetNode s e)  -- ^ Function to create the header (always visible).
  -> (a -> WidgetNode s e)  -- ^ Function to create the list (collapsable).
  -> [DropdownCfg s e a]    -- ^ The config options.
  -> WidgetNode s e         -- ^ The created dropdown.
dropdownD_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownD_ WidgetData s a
widgetData t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  config :: DropdownCfg s e a
config = [DropdownCfg s e a] -> DropdownCfg s e a
forall a. Monoid a => [a] -> a
mconcat [DropdownCfg s e a]
configs
  newState :: DropdownState
newState = Bool -> Point -> DropdownState
DropdownState Bool
False Point
forall a. Default a => a
def
  newItems :: Seq a
newItems = (Seq a -> a -> Seq a) -> Seq a -> t a -> Seq a
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
(|>) Seq a
forall a. Seq a
Empty t a
items
  wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"dropdown-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. TextShow a => a -> Text
showt (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall a. HasCallStack => a
undefined :: Proxy a)))
  widget :: Widget s e
widget = WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
newItems a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
  newNode :: WidgetNode s e
newNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
wtype Widget s e
widget
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
Lens' WidgetNodeInfo Bool
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

makeDropdown
  :: forall s e a. (WidgetModel s, WidgetEvent e, DropdownItem a)
  => WidgetData s a
  -> Seq a
  -> (a -> WidgetNode s e)
  -> (a -> WidgetNode s e)
  -> DropdownCfg s e a
  -> DropdownState
  -> Widget s e
makeDropdown :: forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
state = Widget s e
widget where
  container :: Container s e DropdownState
container = Container s e DropdownState
forall a. Default a => a
def {
    containerAddStyleReq = False,
    containerChildrenOffset = Just (_ddsOffset state),
    containerGetBaseStyle = getBaseStyle,
    containerInit = init,
    containerFindNextFocus = findNextFocus,
    containerFindByPoint = findByPoint,
    containerMerge = merge,
    containerDispose = dispose,
    containerHandleEvent = handleEvent,
    containerHandleMessage = handleMessage,
    containerGetSizeReq = getSizeReq,
    containerResize = resize
  }
  baseWidget :: Widget s e
baseWidget = DropdownState -> Container s e DropdownState -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer DropdownState
state Container s e DropdownState
container
  widget :: Widget s e
widget = Widget s e
baseWidget {
    widgetRender = render
  }

  mainIdx :: Int
mainIdx = Int
0
  listIdx :: Int
listIdx = Int
1
  isOpen :: Bool
isOpen = DropdownState -> Bool
_ddsOpen DropdownState
state
  currentValue :: WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) WidgetData s a
widgetData

  createDropdown :: WidgetEnv s e -> WidgetNode s e -> DropdownState -> WidgetNode s e
createDropdown WidgetEnv s e
wenv WidgetNode s e
node DropdownState
newState = WidgetNode s e
newNode where
    selected :: a
selected = WidgetEnv s e -> a
forall {e}. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
    nodeStyle :: Style
nodeStyle = WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo WidgetNode s e
node WidgetNodeInfo -> Getting Style WidgetNodeInfo Style -> Style
forall s a. s -> Getting a s a -> a
^. Getting Style WidgetNodeInfo Style
forall s a. HasStyle s a => Lens' s a
Lens' WidgetNodeInfo Style
L.style
    mainNode :: WidgetNode s e
mainNode = a -> WidgetNode s e
makeMain a
selected
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
Lens' WidgetNodeInfo Style
L.style ((Style -> Identity Style)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
nodeStyle
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
    selectListNode :: WidgetNode s e
selectListNode = WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
makeSelectList WidgetEnv s e
wenv WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeRow DropdownCfg s e a
config WidgetId
widgetId
    newWidget :: Widget s e
newWidget = WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Widget s e
newWidget
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WidgetNode s e] -> Seq (WidgetNode s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetNode s e
mainNode, WidgetNode s e
selectListNode]

  getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style where
    style :: Style
style = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (StyleState -> f StyleState) -> ThemeState -> f ThemeState
forall s a. HasDropdownStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownStyle

  init :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> DropdownState -> WidgetNode s e
createDropdown WidgetEnv s e
wenv WidgetNode s e
node DropdownState
state

  merge :: WidgetEnv s e
-> WidgetNode s e -> p -> DropdownState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
newNode p
oldNode DropdownState
oldState = WidgetResult s e
result where
    result :: WidgetResult s e
result = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> DropdownState -> WidgetNode s e
createDropdown WidgetEnv s e
wenv WidgetNode s e
newNode DropdownState
oldState

  dispose :: p -> WidgetNode s e -> WidgetResult s e
dispose p
wenv WidgetNode s e
node = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
reqs where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
    reqs :: [WidgetRequest s e]
reqs = [ WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
widgetId | Bool
isOpen ]

  findNextFocus :: p -> s -> p -> p -> Seq a
findNextFocus p
wenv s
node p
direction p
start
    | Bool
isOpen = s
node s -> Getting (Seq a) s (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) s (Seq a)
forall s a. HasChildren s a => Lens' s a
Lens' s (Seq a)
L.children
    | Bool
otherwise = Seq a
forall a. Seq a
Empty

  findByPoint :: p -> p -> p -> Point -> Maybe Int
findByPoint p
wenv p
node p
start Point
point = Maybe Int
result where
    children :: Seq (WidgetNode s e)
children = p
node p
-> Getting (Seq (WidgetNode s e)) p (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting (Seq (WidgetNode s e)) p (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' p (Seq (WidgetNode s e))
L.children
    mainNode :: WidgetNode s e
mainNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
mainIdx
    listNode :: WidgetNode s e
listNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
listIdx
    result :: Maybe Int
result
      | Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
listNode Point
point = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
listIdx
      | Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
mainNode Point
point = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
mainIdx
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing

  ddFocusChange :: WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
prev [Path -> WidgetRequest s e]
reqs = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
newResult where
    tmpResult :: Maybe (WidgetResult s e)
tmpResult = WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev [Path -> WidgetRequest s e]
reqs
    newResult :: WidgetResult s e
newResult = WidgetResult s e -> Maybe (WidgetResult s e) -> WidgetResult s e
forall a. a -> Maybe a -> a
fromMaybe (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) Maybe (WidgetResult s e)
tmpResult
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
Lens' (WidgetResult s e) (Seq (WidgetRequest s e))
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreChildrenEvents)

  handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    Focus Path
prev
      | Bool -> Bool
not Bool
isOpen -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
prev (DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
config)

    Blur Path
next
      | Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& Bool -> Bool
not (Path -> Path -> Bool
forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
path Path
focusedPath)
        -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
next (DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
config)

    Move Point
point -> Maybe (WidgetResult s e)
result where
      mainNode :: WidgetNode s e
mainNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
mainIdx
      listNode :: WidgetNode s e
listNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
listIdx
      slPoint :: Point
slPoint = Point -> Point -> Point
addPoint (Point -> Point
negPoint (DropdownState -> Point
_ddsOffset DropdownState
state)) Point
point

      validMainPos :: Bool
validMainPos = Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
mainNode Point
point
      validListPos :: Bool
validListPos = Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
listNode Point
slPoint
      validPos :: Bool
validPos = Bool
validMainPos Bool -> Bool -> Bool
|| Bool
validListPos

      isArrow :: Bool
isArrow = CursorIcon -> Maybe CursorIcon
forall a. a -> Maybe a
Just CursorIcon
CursorArrow Maybe CursorIcon -> Maybe CursorIcon -> Bool
forall a. Eq a => a -> a -> Bool
== ((Path, CursorIcon) -> CursorIcon
forall a b. (a, b) -> b
snd ((Path, CursorIcon) -> CursorIcon)
-> Maybe (Path, CursorIcon) -> Maybe CursorIcon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Maybe (Path, CursorIcon))
     (WidgetEnv s e)
     (Maybe (Path, CursorIcon))
-> Maybe (Path, CursorIcon)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Path, CursorIcon))
  (WidgetEnv s e)
  (Maybe (Path, CursorIcon))
forall s a. HasCursor s a => Lens' s a
Lens' (WidgetEnv s e) (Maybe (Path, CursorIcon))
L.cursor)
      resetRes :: WidgetResult s e
resetRes = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
CursorArrow]
      result :: Maybe (WidgetResult s e)
result
        | Bool -> Bool
not Bool
validPos Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isArrow = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resetRes
        | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    ButtonAction Point
_ Button
btn ButtonState
BtnPressed Int
_
      | Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
Lens' (WidgetEnv s e) Button
L.mainButton Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isOpen -> Maybe (WidgetResult s e)
result where
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus (WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId)]

    Click Point
point Button
_ Int
_
      | Point -> WidgetNode s e -> Bool
forall {p} {a}.
(HasInfo p a, HasViewport a Rect) =>
Point -> p -> Bool
openRequired Point
point WidgetNode s e
node -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultOpen
      | Point -> WidgetNode s e -> Bool
forall {p} {a} {a}.
(HasChildren p (Seq a), HasInfo a a, HasViewport a Rect) =>
Point -> p -> Bool
closeRequired Point
point WidgetNode s e
node -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultClose
      where
        inVp :: Bool
inVp = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
point
        resultOpen :: WidgetResult s e
resultOpen = WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node
          WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
Lens' (WidgetResult s e) (Seq (WidgetRequest s e))
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
CursorArrow]
        resultClose :: WidgetResult s e
resultClose = WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall {p}. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
          WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
Lens' (WidgetResult s e) (Seq (WidgetRequest s e))
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetCursorIcon WidgetId
widgetId | Bool -> Bool
not Bool
inVp]

    KeyAction KeyMod
mode KeyCode
code KeyStatus
KeyPressed
      | Bool
isKeyOpenDropdown Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isOpen -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node
      | KeyCode -> Bool
isKeyEscape KeyCode
code Bool -> Bool -> Bool
&& Bool
isOpen -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall {p}. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
      where
        activationKeys :: [KeyCode -> Bool]
activationKeys = [KeyCode -> Bool
isKeyDown, KeyCode -> Bool
isKeyUp, KeyCode -> Bool
isKeySpace, KeyCode -> Bool
isKeyReturn]
        isKeyOpenDropdown :: Bool
isKeyOpenDropdown = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (((KeyCode -> Bool) -> Bool) -> [KeyCode -> Bool] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KeyCode -> Bool) -> KeyCode -> Bool
forall a b. (a -> b) -> a -> b
$ KeyCode
code) [KeyCode -> Bool]
activationKeys)

    SystemEvent
_
      | Bool -> Bool
not Bool
isOpen -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreChildrenEvents]
      | Bool
otherwise -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
    where
      style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
      path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
Lens' WidgetNodeInfo Path
L.path
      focusedPath :: Path
focusedPath = WidgetEnv s e
wenv WidgetEnv s e -> Getting Path (WidgetEnv s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path (WidgetEnv s e) Path
forall s a. HasFocusedPath s a => Lens' s a
Lens' (WidgetEnv s e) Path
L.focusedPath
      overlayPath :: Maybe Path
overlayPath = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (Maybe Path) (WidgetEnv s e) (Maybe Path) -> Maybe Path
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Path) (WidgetEnv s e) (Maybe Path)
forall s a. HasOverlayPath s a => Lens' s a
Lens' (WidgetEnv s e) (Maybe Path)
L.overlayPath

      overlayParent :: Bool
overlayParent = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath WidgetNode s e
node (Maybe Path -> Path
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Path
overlayPath)
      nodeValid :: Bool
nodeValid = Maybe Path -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Path
overlayPath Bool -> Bool -> Bool
|| Bool
overlayParent

  openRequired :: Point -> p -> Bool
openRequired Point
point p
node = Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& Bool
inViewport where
    inViewport :: Bool
inViewport = Point -> Rect -> Bool
pointInRect Point
point (p
node p -> Getting Rect p Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (a -> Const Rect a) -> p -> Const Rect p
forall s a. HasInfo s a => Lens' s a
Lens' p a
L.info ((a -> Const Rect a) -> p -> Const Rect p)
-> ((Rect -> Const Rect Rect) -> a -> Const Rect a)
-> Getting Rect p Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect) -> a -> Const Rect a
forall s a. HasViewport s a => Lens' s a
Lens' a Rect
L.viewport)

  closeRequired :: Point -> p -> Bool
closeRequired Point
point p
node = Bool
isOpen Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inOverlay where
    offset :: Point
offset = DropdownState -> Point
_ddsOffset DropdownState
state
    listNode :: a
listNode = Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index (p
node p -> Getting (Seq a) p (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) p (Seq a)
forall s a. HasChildren s a => Lens' s a
Lens' p (Seq a)
L.children) Int
listIdx
    listVp :: Rect
listVp = Point -> Rect -> Rect
moveRect Point
offset (a
listNode a -> Getting Rect a Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (a -> Const Rect a) -> a -> Const Rect a
forall s a. HasInfo s a => Lens' s a
Lens' a a
L.info ((a -> Const Rect a) -> a -> Const Rect a)
-> ((Rect -> Const Rect Rect) -> a -> Const Rect a)
-> Getting Rect a Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect) -> a -> Const Rect a
forall s a. HasViewport s a => Lens' s a
Lens' a Rect
L.viewport)
    inOverlay :: Bool
inOverlay = Point -> Rect -> Bool
pointInRect Point
point Rect
listVp

  openDropdown :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
requests where
    newState :: DropdownState
newState = DropdownState
state {
      _ddsOpen = True,
      _ddsOffset = listOffset wenv node
    }
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
    -- selectList is wrapped by a scroll widget
    (WidgetId
slWid, Path
slPath) = WidgetNode s e -> (WidgetId, Path)
scrollListInfo WidgetNode s e
node
    (WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node
    scrollMsg :: WidgetRequest s e
scrollMsg = WidgetId -> SelectListMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
listWid SelectListMessage
SelectListShowSelected
    requests :: [WidgetRequest s e]
requests = [WidgetId -> Path -> WidgetRequest s e
forall s e. WidgetId -> Path -> WidgetRequest s e
SetOverlay WidgetId
slWid Path
slPath, WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
listWid, WidgetRequest s e
forall s e. WidgetRequest s e
scrollMsg]

  closeDropdown :: p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
requests where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
    (WidgetId
slWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
scrollListInfo WidgetNode s e
node
    (WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node
    newState :: DropdownState
newState = DropdownState
state {
      _ddsOpen = False,
      _ddsOffset = def
    }
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
    requests :: [WidgetRequest s e]
requests = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
slWid, WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId]

  scrollListInfo :: WidgetNode s e -> (WidgetId, Path)
  scrollListInfo :: WidgetNode s e -> (WidgetId, Path)
scrollListInfo WidgetNode s e
node = (WidgetNodeInfo
scrollInfo WidgetNodeInfo
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId, WidgetNodeInfo
scrollInfo WidgetNodeInfo
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Path
forall s a. s -> Getting a s a -> a
^. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
Lens' WidgetNodeInfo Path
L.path) where
    scrollInfo :: WidgetNodeInfo
scrollInfo = WidgetNode s e
node WidgetNode s e
-> Getting (Endo WidgetNodeInfo) (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Seq (WidgetNode s e)
 -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> WidgetNode s e -> Const (Endo WidgetNodeInfo) (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e)
  -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Const (Endo WidgetNodeInfo) (WidgetNode s e))
-> ((WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
    -> Seq (WidgetNode s e)
    -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> Getting (Endo WidgetNodeInfo) (WidgetNode s e) WidgetNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq (WidgetNode s e))
-> Traversal'
     (Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq (WidgetNode s e))
listIdx ((IxValue (Seq (WidgetNode s e))
  -> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e))))
 -> Seq (WidgetNode s e)
 -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> ((WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
    -> IxValue (Seq (WidgetNode s e))
    -> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e))))
-> (WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
-> Seq (WidgetNode s e)
-> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e)))
forall s a. HasInfo s a => Lens' s a
Lens' (IxValue (Seq (WidgetNode s e))) WidgetNodeInfo
L.info

  selectListInfo :: WidgetNode s e -> (WidgetId, Path)
  selectListInfo :: WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node = (WidgetNodeInfo
listInfo WidgetNodeInfo
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId, WidgetNodeInfo
listInfo WidgetNodeInfo
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Path
forall s a. s -> Getting a s a -> a
^. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
Lens' WidgetNodeInfo Path
L.path) where
    listInfo :: WidgetNodeInfo
listInfo = WidgetNode s e
node WidgetNode s e
-> Getting (Endo WidgetNodeInfo) (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Seq (WidgetNode s e)
 -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> WidgetNode s e -> Const (Endo WidgetNodeInfo) (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e)
  -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Const (Endo WidgetNodeInfo) (WidgetNode s e))
-> ((WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
    -> Seq (WidgetNode s e)
    -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> Getting (Endo WidgetNodeInfo) (WidgetNode s e) WidgetNodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq (WidgetNode s e))
-> Traversal'
     (Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq (WidgetNode s e))
listIdx ((IxValue (Seq (WidgetNode s e))
  -> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e))))
 -> Seq (WidgetNode s e)
 -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> ((WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
    -> IxValue (Seq (WidgetNode s e))
    -> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e))))
-> (WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
-> Seq (WidgetNode s e)
-> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq (WidgetNode s e)
 -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e)))
forall s a. HasChildren s a => Lens' s a
Lens' (IxValue (Seq (WidgetNode s e))) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e)
  -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
 -> IxValue (Seq (WidgetNode s e))
 -> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e))))
-> ((WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
    -> Seq (WidgetNode s e)
    -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> (WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq (WidgetNode s e))
-> Traversal'
     (Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Seq (WidgetNode s e))
0 ((IxValue (Seq (WidgetNode s e))
  -> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e))))
 -> Seq (WidgetNode s e)
 -> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e)))
-> ((WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
    -> IxValue (Seq (WidgetNode s e))
    -> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e))))
-> (WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
-> Seq (WidgetNode s e)
-> Const (Endo WidgetNodeInfo) (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetNodeInfo -> Const (Endo WidgetNodeInfo) WidgetNodeInfo)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo WidgetNodeInfo) (IxValue (Seq (WidgetNode s e)))
forall s a. HasInfo s a => Lens' s a
Lens' (IxValue (Seq (WidgetNode s e))) WidgetNodeInfo
L.info

  handleMessage :: WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage WidgetEnv s e
wenv WidgetNode s e
node p
target a
msg =
    a -> Maybe DropdownMessage
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
msg Maybe DropdownMessage
-> (DropdownMessage -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WidgetEnv s e
-> WidgetNode s e -> DropdownMessage -> Maybe (WidgetResult s e)
handleLvMsg WidgetEnv s e
wenv WidgetNode s e
node

  handleLvMsg :: WidgetEnv s e
-> WidgetNode s e -> DropdownMessage -> Maybe (WidgetResult s e)
handleLvMsg WidgetEnv s e
wenv WidgetNode s e
node (OnChangeMessage Int
idx a
_) =
    Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq a
items Maybe a
-> (a -> Maybe (WidgetResult s e)) -> Maybe (WidgetResult s e)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
value -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> Int -> a -> WidgetResult s e
forall {p}. p -> WidgetNode s e -> Int -> a -> WidgetResult s e
onChange WidgetEnv s e
wenv WidgetNode s e
node Int
idx a
value
  handleLvMsg WidgetEnv s e
wenv WidgetNode s e
node DropdownMessage
OnListBlur = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
    tempResult :: WidgetResult s e
tempResult = WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
forall {p}. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
    result :: WidgetResult s e
result = WidgetResult s e
tempResult WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
Lens' (WidgetResult s e) (Seq (WidgetRequest s e))
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetEnv s e -> WidgetRequest s e
forall s e. WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq WidgetEnv s e
wenv)

  onChange :: p -> WidgetNode s e -> Int -> a -> WidgetResult s e
onChange p
wenv WidgetNode s e
node Int
idx a
item = WidgetResult s e
result where
    WidgetResult WidgetNode s e
newNode Seq (WidgetRequest s e)
reqs = p -> WidgetNode s e -> WidgetResult s e
forall {p}. p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node
    newReqs :: Seq (WidgetRequest s e)
newReqs = [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList ([WidgetRequest s e] -> Seq (WidgetRequest s e))
-> [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a b. (a -> b) -> a -> b
$ WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
widgetData a
item
      [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ ((a -> WidgetRequest s e) -> WidgetRequest s e)
-> [a -> WidgetRequest s e] -> [WidgetRequest s e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> WidgetRequest s e) -> a -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ a
item) (DropdownCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
config)
      [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ ((Int -> a -> WidgetRequest s e) -> WidgetRequest s e)
-> [Int -> a -> WidgetRequest s e] -> [WidgetRequest s e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int -> a -> WidgetRequest s e
fn -> Int -> a -> WidgetRequest s e
fn Int
idx a
item) (DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
config)
    result :: WidgetResult s e
result = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
newNode (Seq (WidgetRequest s e)
reqs Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
newReqs)

  getSizeReq :: ContainerGetSizeReqHandler s e
  getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq
newReqW, SizeReq
newReqH) where
    -- Main section reqs
    mainC :: WidgetNode s e
mainC = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    mainReqW :: SizeReq
mainReqW = WidgetNode s e
mainC WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqW
    mainReqH :: SizeReq
mainReqH = WidgetNode s e
mainC WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqH
    -- List items reqs
    listC :: WidgetNode s e
listC = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
    listReqW :: SizeReq
listReqW = WidgetNode s e
listC WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqW
    -- Items other than main could be wider
    -- Height only matters for the selected item, since the rest is in a scroll
    newReqW :: SizeReq
newReqW = SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax SizeReq
mainReqW SizeReq
listReqW
    newReqH :: SizeReq
newReqH = SizeReq
mainReqH

  listHeight :: WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node = Double
maxHeight where
    Size Double
_ Double
winH = WidgetEnv s e -> Size
forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv
    theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
    maxHeightTheme :: Double
maxHeightTheme = ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasDropdownMaxHeight s a => Lens' s a
Lens' ThemeState Double
L.dropdownMaxHeight
    cfgMaxHeight :: Maybe Double
cfgMaxHeight = DropdownCfg s e a -> Maybe Double
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
config
    -- Avoid having an invisible list if style/theme is not set
    maxHeightStyle :: Double
maxHeightStyle = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
20 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
maxHeightTheme Maybe Double
cfgMaxHeight
    reqHeight :: Double
reqHeight = case Int -> Seq (WidgetNode s e) -> Maybe (WidgetNode s e)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
1 (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) of
      Just WidgetNode s e
child -> SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqH
      Maybe (WidgetNode s e)
_ -> Double
0
    maxHeight :: Double
maxHeight = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
winH (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
reqHeight Double
maxHeightStyle)

  listOffset :: WidgetEnv s e -> WidgetNode s e -> Point
listOffset WidgetEnv s e
wenv WidgetNode s e
node = Double -> Double -> Point
Point Double
0 Double
newOffset where
    Size Double
_ Double
winH = WidgetEnv s e -> Size
forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv
    viewport :: Rect
viewport = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
Lens' WidgetNodeInfo Rect
L.viewport
    scOffset :: Point
scOffset = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point (WidgetEnv s e) Point
forall s a. HasOffset s a => Lens' s a
Lens' (WidgetEnv s e) Point
L.offset
    Rect Double
rx Double
ry Double
rw Double
rh = Point -> Rect -> Rect
moveRect Point
scOffset Rect
viewport
    lh :: Double
lh = WidgetEnv s e -> WidgetNode s e -> Double
forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node
    newOffset :: Double
newOffset
      | Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lh Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
winH = - (Double
rh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lh)
      | Bool
otherwise = Double
0

  resize :: WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport p
children = (WidgetResult s e, Seq Rect)
resized where
    style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    Rect Double
rx Double
ry Double
rw Double
rh = Rect
viewport
    !mainArea :: Rect
mainArea = Rect
viewport
    !listArea :: Rect
listArea = Rect
viewport {
      _rY = ry + rh,
      _rH = listHeight wenv node
    }
    assignedAreas :: Seq Rect
assignedAreas = [Rect] -> Seq Rect
forall a. [a] -> Seq a
Seq.fromList [Rect
mainArea, Rect
listArea]
    resized :: (WidgetResult s e, Seq Rect)
resized = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq Rect
assignedAreas)

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    Renderer -> Bool -> Rect -> IO () -> IO ()
drawInScissor Renderer
renderer Bool
True Rect
viewport (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction Renderer
renderer Rect
viewport StyleState
style ((Rect -> IO ()) -> IO ()) -> (Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Rect
contentArea -> do
        Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
mainNode WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget) WidgetEnv s e
wenv WidgetNode s e
mainNode Renderer
renderer
        Renderer -> StyleState -> Rect -> IO ()
renderArrow Renderer
renderer StyleState
style Rect
contentArea

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isOpen (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> IO () -> IO ()
createOverlay Renderer
renderer (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer Point
totalOffset (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Renderer -> WidgetEnv s e -> WidgetNode s e -> IO ()
forall {s} {e}.
Renderer -> WidgetEnv s e -> WidgetNode s e -> IO ()
renderOverlay Renderer
renderer WidgetEnv s e
cwenv WidgetNode s e
listOverlay
    where
      style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      viewport :: Rect
viewport = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
Lens' WidgetNodeInfo Rect
L.viewport
      mainNode :: WidgetNode s e
mainNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
mainIdx
      -- List view is rendered with an offset to accommodate for window height
      listOverlay :: WidgetNode s e
listOverlay = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
listIdx
      listOverlayVp :: Rect
listOverlayVp = WidgetNode s e
listOverlay WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
Lens' WidgetNodeInfo Rect
L.viewport
      scOffset :: Point
scOffset = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point (WidgetEnv s e) Point
forall s a. HasOffset s a => Lens' s a
Lens' (WidgetEnv s e) Point
L.offset
      offset :: Point
offset = DropdownState -> Point
_ddsOffset DropdownState
state
      totalOffset :: Point
totalOffset = Point -> Point -> Point
addPoint Point
scOffset Point
offset
      cwenv :: WidgetEnv s e
cwenv = Container s e DropdownState
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
updateWenvOffset Container s e DropdownState
container WidgetEnv s e
wenv WidgetNode s e
node Rect
listOverlayVp
        WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasViewport s a => Lens' s a
Lens' (WidgetEnv s e) Rect
L.viewport ((Rect -> Identity Rect)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> Rect -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
listOverlayVp

  renderArrow :: Renderer -> StyleState -> Rect -> IO ()
renderArrow Renderer
renderer StyleState
style Rect
contentArea =
    Renderer -> Rect -> Maybe Color -> IO ()
drawArrowDown Renderer
renderer Rect
arrowRect (StyleState -> Maybe Color
_sstFgColor StyleState
style)
    where
      Rect Double
x Double
y Double
w Double
h = Rect
contentArea
      size :: FontSize
size = StyleState
style StyleState -> Getting FontSize StyleState FontSize -> FontSize
forall s a. s -> Getting a s a -> a
^. (Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> StyleState -> Const FontSize StyleState
forall s a. HasText s a => Lens' s a
Lens' StyleState (Maybe TextStyle)
L.text ((Maybe TextStyle -> Const FontSize (Maybe TextStyle))
 -> StyleState -> Const FontSize StyleState)
-> ((FontSize -> Const FontSize FontSize)
    -> Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> Getting FontSize StyleState FontSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Const FontSize TextStyle)
 -> Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> ((FontSize -> Const FontSize FontSize)
    -> TextStyle -> Const FontSize TextStyle)
-> (FontSize -> Const FontSize FontSize)
-> Maybe TextStyle
-> Const FontSize (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FontSize -> Const FontSize (Maybe FontSize))
-> TextStyle -> Const FontSize TextStyle
forall s a. HasFontSize s a => Lens' s a
Lens' TextStyle (Maybe FontSize)
L.fontSize ((Maybe FontSize -> Const FontSize (Maybe FontSize))
 -> TextStyle -> Const FontSize TextStyle)
-> ((FontSize -> Const FontSize FontSize)
    -> Maybe FontSize -> Const FontSize (Maybe FontSize))
-> (FontSize -> Const FontSize FontSize)
-> TextStyle
-> Const FontSize TextStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSize -> Iso' (Maybe FontSize) FontSize
forall a. Eq a => a -> Iso' (Maybe a) a
non FontSize
forall a. Default a => a
def
      arrowW :: Double
arrowW = FontSize -> Double
unFontSize FontSize
size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
      arrowRect :: Rect
arrowRect = Double -> Double -> Double -> Double -> Rect
Rect (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
arrowW) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
arrowW Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3) Double
arrowW (Double
arrowW Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)

  renderOverlay :: Renderer -> WidgetEnv s e -> WidgetNode s e -> IO ()
renderOverlay Renderer
renderer WidgetEnv s e
wenv WidgetNode s e
overlayNode = IO ()
renderAction where
    widget :: Widget s e
widget = WidgetNode s e
overlayNode WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget
    renderAction :: IO ()
renderAction = Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
overlayNode Renderer
renderer

makeSelectList
  :: (WidgetModel s, WidgetEvent e, DropdownItem a)
  => WidgetEnv s e
  -> WidgetData s a
  -> Seq a
  -> (a -> WidgetNode s e)
  -> DropdownCfg s e a
  -> WidgetId
  -> WidgetNode s e
makeSelectList :: forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
makeSelectList WidgetEnv s e
wenv WidgetData s a
value Seq a
items a -> WidgetNode s e
makeRow DropdownCfg s e a
config WidgetId
widgetId = WidgetNode s e
selectListNode where
  normalTheme :: Style
normalTheme = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (StyleState -> f StyleState) -> ThemeState -> f ThemeState
forall s a. HasDropdownItemStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownItemStyle
  selectedTheme :: Style
selectedTheme = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (StyleState -> f StyleState) -> ThemeState -> f ThemeState
forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownItemSelectedStyle

  itemStyle :: Style
itemStyle = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
normalTheme Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
config)
  itemSelStyle :: Style
itemSelStyle = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
selectedTheme Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
config)

  mergeReqFn :: SelectListCfg s e a
mergeReqFn = SelectListCfg s e a
-> ((WidgetEnv s e -> Seq a -> Seq a -> Bool)
    -> SelectListCfg s e a)
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
-> SelectListCfg s e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SelectListCfg s e a
forall a. Default a => a
def (WidgetEnv s e -> Seq a -> Seq a -> Bool) -> SelectListCfg s e a
forall t w s. CmbMergeRequired t w s => (w -> s -> s -> Bool) -> t
mergeRequired (DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall s e a.
DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired DropdownCfg s e a
config)

  slConfig :: [SelectListCfg s e a]
slConfig = [
      SelectListCfg s e a
forall t. CmbSelectOnBlur t => t
selectOnBlur,
      (Path -> WidgetRequest s e) -> SelectListCfg s e a
forall t s e a.
CmbOnBlurReq t s e a =>
(a -> WidgetRequest s e) -> t
onBlurReq (WidgetRequest s e -> Path -> WidgetRequest s e
forall a b. a -> b -> a
const (WidgetRequest s e -> Path -> WidgetRequest s e)
-> WidgetRequest s e -> Path -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ WidgetId -> DropdownMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
widgetId DropdownMessage
OnListBlur),
      (Int -> a -> WidgetRequest s e) -> SelectListCfg s e a
forall t s e a.
CmbOnChangeIdxReq t s e a =>
(Int -> a -> WidgetRequest s e) -> t
onChangeIdxReq (\Int
idx a
it -> WidgetId -> DropdownMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
widgetId (Int -> a -> DropdownMessage
forall a. DropdownItem a => Int -> a -> DropdownMessage
OnChangeMessage Int
idx a
it)),
      Style -> SelectListCfg s e a
forall t s. CmbItemBasicStyle t s => s -> t
itemBasicStyle Style
itemStyle,
      Style -> SelectListCfg s e a
forall t s. CmbItemSelectedStyle t s => s -> t
itemSelectedStyle Style
itemSelStyle,
      SelectListCfg s e a
mergeReqFn
    ]
  slStyle :: Style
slStyle = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv (StyleState -> f StyleState) -> ThemeState -> f ThemeState
forall s a. HasDropdownListStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownListStyle
  selectListNode :: WidgetNode s e
selectListNode = WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> [SelectListCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a) =>
WidgetData s a
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
selectListD_ WidgetData s a
value Seq a
items a -> WidgetNode s e
makeRow [SelectListCfg s e a]
slConfig
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
Lens' WidgetNodeInfo Style
L.style ((Style -> Identity Style)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
slStyle

createMoveFocusReq :: WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq :: forall s e. WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq WidgetEnv s e
wenv = Maybe WidgetId -> FocusDirection -> WidgetRequest s e
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus Maybe WidgetId
forall a. Maybe a
Nothing FocusDirection
direction where
  direction :: FocusDirection
direction
    | WidgetEnv s e
wenv WidgetEnv s e -> Getting Bool (WidgetEnv s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Bool InputStatus)
-> WidgetEnv s e -> Const Bool (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
Lens' (WidgetEnv s e) InputStatus
L.inputStatus ((InputStatus -> Const Bool InputStatus)
 -> WidgetEnv s e -> Const Bool (WidgetEnv s e))
-> ((Bool -> Const Bool Bool)
    -> InputStatus -> Const Bool InputStatus)
-> Getting Bool (WidgetEnv s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyMod -> Const Bool KeyMod)
-> InputStatus -> Const Bool InputStatus
forall s a. HasKeyMod s a => Lens' s a
Lens' InputStatus KeyMod
L.keyMod ((KeyMod -> Const Bool KeyMod)
 -> InputStatus -> Const Bool InputStatus)
-> ((Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod)
-> (Bool -> Const Bool Bool)
-> InputStatus
-> Const Bool InputStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod
forall s a. HasLeftShift s a => Lens' s a
Lens' KeyMod Bool
L.leftShift = FocusDirection
FocusBwd
    | Bool
otherwise = FocusDirection
FocusFwd