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

Select list widget, allowing selection of a single item. List content (rows) is
customizable, plus its styling.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Containers.SelectList (
  -- * Configuration
  SelectListCfg,
  SelectListItem,
  SelectListMessage(..),
  SelectListMakeRow,
  -- * Constructors
  selectList,
  selectList_,
  selectListV,
  selectListV_,
  selectListD_
) where

import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (^?), (^?!), (.~), (%~), (?~), (<>~), at, ix, non, _Just)
import Control.Monad (when)
import Data.Default
import Data.List (foldl')
import Data.Maybe
import Data.Sequence (Seq(..), (<|), (|>))
import Data.Text (Text)
import Data.Typeable (Typeable, cast)

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

import Monomer.Graphics.Lens
import Monomer.Widgets.Container
import Monomer.Widgets.Containers.Box
import Monomer.Widgets.Containers.Scroll
import Monomer.Widgets.Containers.Stack
import Monomer.Widgets.Singles.Label
import Monomer.Widgets.Singles.Spacer

import qualified Monomer.Lens as L

-- | Constraints for an item handled by selectList.
type SelectListItem a = (Eq a, Show a, Typeable a)
-- | Creates a row from an item.
type SelectListMakeRow s e a = a -> WidgetNode s e

{-|
Configuration options for selectList:

- '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.
- 'selectOnBlur': whether to select the currently highlighted item when
  navigating away from the widget with tab key.
- 'itemBasicStyle': style of an item in the list when not selected.
- 'itemSelectedStyle': style of the selected item in the list.
- 'mergeRequired': whether merging children is required. Useful when select list
  is part of another widget such as dropdown.
-}
data SelectListCfg s e a = SelectListCfg {
  SelectListCfg s e a -> Maybe Bool
_slcSelectOnBlur :: Maybe Bool,
  SelectListCfg s e a -> Maybe Style
_slcItemStyle :: Maybe Style,
  SelectListCfg s e a -> Maybe Style
_slcItemSelectedStyle :: Maybe Style,
  SelectListCfg s e a -> Maybe (Seq a -> Seq a -> Bool)
_slcMergeRequired :: Maybe (Seq a -> Seq a -> Bool),
  SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnFocusReq :: [Path -> WidgetRequest s e],
  SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnBlurReq :: [Path -> WidgetRequest s e],
  SelectListCfg s e a -> [a -> WidgetRequest s e]
_slcOnChangeReq :: [a -> WidgetRequest s e],
  SelectListCfg s e a -> [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
}

instance Default (SelectListCfg s e a) where
  def :: SelectListCfg s e a
def = SelectListCfg :: forall s e a.
Maybe Bool
-> Maybe Style
-> Maybe Style
-> Maybe (Seq a -> Seq a -> Bool)
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> SelectListCfg s e a
SelectListCfg {
    _slcSelectOnBlur :: Maybe Bool
_slcSelectOnBlur = Maybe Bool
forall a. Maybe a
Nothing,
    _slcItemStyle :: Maybe Style
_slcItemStyle = Maybe Style
forall a. Maybe a
Nothing,
    _slcItemSelectedStyle :: Maybe Style
_slcItemSelectedStyle = Maybe Style
forall a. Maybe a
Nothing,
    _slcMergeRequired :: Maybe (Seq a -> Seq a -> Bool)
_slcMergeRequired = Maybe (Seq a -> Seq a -> Bool)
forall a. Maybe a
Nothing,
    _slcOnFocusReq :: [Path -> WidgetRequest s e]
_slcOnFocusReq = [],
    _slcOnBlurReq :: [Path -> WidgetRequest s e]
_slcOnBlurReq = [],
    _slcOnChangeReq :: [a -> WidgetRequest s e]
_slcOnChangeReq = [],
    _slcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq = []
  }

instance Semigroup (SelectListCfg s e a) where
  <> :: SelectListCfg s e a -> SelectListCfg s e a -> SelectListCfg s e a
(<>) SelectListCfg s e a
t1 SelectListCfg s e a
t2 = SelectListCfg :: forall s e a.
Maybe Bool
-> Maybe Style
-> Maybe Style
-> Maybe (Seq a -> Seq a -> Bool)
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> SelectListCfg s e a
SelectListCfg {
    _slcSelectOnBlur :: Maybe Bool
_slcSelectOnBlur = SelectListCfg s e a -> Maybe Bool
forall s e a. SelectListCfg s e a -> Maybe Bool
_slcSelectOnBlur SelectListCfg s e a
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SelectListCfg s e a -> Maybe Bool
forall s e a. SelectListCfg s e a -> Maybe Bool
_slcSelectOnBlur SelectListCfg s e a
t1,
    _slcItemStyle :: Maybe Style
_slcItemStyle = SelectListCfg s e a -> Maybe Style
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle SelectListCfg s e a
t2 Maybe Style -> Maybe Style -> Maybe Style
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SelectListCfg s e a -> Maybe Style
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle SelectListCfg s e a
t1,
    _slcItemSelectedStyle :: Maybe Style
_slcItemSelectedStyle = SelectListCfg s e a -> Maybe Style
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemSelectedStyle SelectListCfg s e a
t2 Maybe Style -> Maybe Style -> Maybe Style
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SelectListCfg s e a -> Maybe Style
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemSelectedStyle SelectListCfg s e a
t1,
    _slcMergeRequired :: Maybe (Seq a -> Seq a -> Bool)
_slcMergeRequired = SelectListCfg s e a -> Maybe (Seq a -> Seq a -> Bool)
forall s e a. SelectListCfg s e a -> Maybe (Seq a -> Seq a -> Bool)
_slcMergeRequired SelectListCfg s e a
t2 Maybe (Seq a -> Seq a -> Bool)
-> Maybe (Seq a -> Seq a -> Bool) -> Maybe (Seq a -> Seq a -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SelectListCfg s e a -> Maybe (Seq a -> Seq a -> Bool)
forall s e a. SelectListCfg s e a -> Maybe (Seq a -> Seq a -> Bool)
_slcMergeRequired SelectListCfg s e a
t1,
    _slcOnFocusReq :: [Path -> WidgetRequest s e]
_slcOnFocusReq = SelectListCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnFocusReq SelectListCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> SelectListCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnFocusReq SelectListCfg s e a
t2,
    _slcOnBlurReq :: [Path -> WidgetRequest s e]
_slcOnBlurReq = SelectListCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnBlurReq SelectListCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> SelectListCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnBlurReq SelectListCfg s e a
t2,
    _slcOnChangeReq :: [a -> WidgetRequest s e]
_slcOnChangeReq = SelectListCfg s e a -> [a -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [a -> WidgetRequest s e]
_slcOnChangeReq SelectListCfg s e a
t1 [a -> WidgetRequest s e]
-> [a -> WidgetRequest s e] -> [a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> SelectListCfg s e a -> [a -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [a -> WidgetRequest s e]
_slcOnChangeReq SelectListCfg s e a
t2,
    _slcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq = SelectListCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a.
SelectListCfg s e a -> [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq SelectListCfg 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
<> SelectListCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a.
SelectListCfg s e a -> [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq SelectListCfg s e a
t2
  }

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

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

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

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

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

instance WidgetEvent e => CmbOnChange (SelectListCfg s e a) a e where
  onChange :: (a -> e) -> SelectListCfg s e a
onChange a -> e
fn = SelectListCfg s e a
forall a. Default a => a
def {
    _slcOnChangeReq :: [a -> WidgetRequest s e]
_slcOnChangeReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> (a -> e) -> a -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
fn]
  }

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

instance WidgetEvent e => CmbOnChangeIdx (SelectListCfg s e a) e a where
  onChangeIdx :: (Int -> a -> e) -> SelectListCfg s e a
onChangeIdx Int -> a -> e
fn = SelectListCfg s e a
forall a. Default a => a
def {
    _slcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq = [(e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> (a -> e) -> a -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> e) -> a -> WidgetRequest s e)
-> (Int -> a -> e) -> Int -> a -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> e
fn]
  }

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

instance CmbSelectOnBlur (SelectListCfg s e a) where
  selectOnBlur_ :: Bool -> SelectListCfg s e a
selectOnBlur_ Bool
select = SelectListCfg s e a
forall a. Default a => a
def {
    _slcSelectOnBlur :: Maybe Bool
_slcSelectOnBlur = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
select
  }

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

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

instance CmbMergeRequired (SelectListCfg s e a) (Seq a) where
  mergeRequired :: (Seq a -> Seq a -> Bool) -> SelectListCfg s e a
mergeRequired Seq a -> Seq a -> Bool
fn = SelectListCfg s e a
forall a. Default a => a
def {
    _slcMergeRequired :: Maybe (Seq a -> Seq a -> Bool)
_slcMergeRequired = (Seq a -> Seq a -> Bool) -> Maybe (Seq a -> Seq a -> Bool)
forall a. a -> Maybe a
Just Seq a -> Seq a -> Bool
fn
  }

data SelectListState a = SelectListState {
  SelectListState a -> Seq a
_prevItems :: Seq a,
  SelectListState a -> Int
_slIdx :: Int,
  SelectListState a -> Int
_hlIdx :: Int
} deriving (SelectListState a -> SelectListState a -> Bool
(SelectListState a -> SelectListState a -> Bool)
-> (SelectListState a -> SelectListState a -> Bool)
-> Eq (SelectListState a)
forall a. Eq a => SelectListState a -> SelectListState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectListState a -> SelectListState a -> Bool
$c/= :: forall a. Eq a => SelectListState a -> SelectListState a -> Bool
== :: SelectListState a -> SelectListState a -> Bool
$c== :: forall a. Eq a => SelectListState a -> SelectListState a -> Bool
Eq, Int -> SelectListState a -> ShowS
[SelectListState a] -> ShowS
SelectListState a -> String
(Int -> SelectListState a -> ShowS)
-> (SelectListState a -> String)
-> ([SelectListState a] -> ShowS)
-> Show (SelectListState a)
forall a. Show a => Int -> SelectListState a -> ShowS
forall a. Show a => [SelectListState a] -> ShowS
forall a. Show a => SelectListState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectListState a] -> ShowS
$cshowList :: forall a. Show a => [SelectListState a] -> ShowS
show :: SelectListState a -> String
$cshow :: forall a. Show a => SelectListState a -> String
showsPrec :: Int -> SelectListState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SelectListState a -> ShowS
Show)

-- | Messages received by selectList. In general used internally.
data SelectListMessage
  = SelectListClickItem Int
  | SelectListShowSelected
  deriving (SelectListMessage -> SelectListMessage -> Bool
(SelectListMessage -> SelectListMessage -> Bool)
-> (SelectListMessage -> SelectListMessage -> Bool)
-> Eq SelectListMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectListMessage -> SelectListMessage -> Bool
$c/= :: SelectListMessage -> SelectListMessage -> Bool
== :: SelectListMessage -> SelectListMessage -> Bool
$c== :: SelectListMessage -> SelectListMessage -> Bool
Eq, Int -> SelectListMessage -> ShowS
[SelectListMessage] -> ShowS
SelectListMessage -> String
(Int -> SelectListMessage -> ShowS)
-> (SelectListMessage -> String)
-> ([SelectListMessage] -> ShowS)
-> Show SelectListMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectListMessage] -> ShowS
$cshowList :: [SelectListMessage] -> ShowS
show :: SelectListMessage -> String
$cshow :: SelectListMessage -> String
showsPrec :: Int -> SelectListMessage -> ShowS
$cshowsPrec :: Int -> SelectListMessage -> ShowS
Show)

-- | Creates a select list using the given lens.
selectList
  :: (WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a)
  => ALens' s a      -- ^ The lens into the model.
  -> t a             -- ^ The list of selectable items.
  -> SelectListMakeRow s e a  -- ^ Function to create the list items.
  -> WidgetNode s e  -- ^ The created dropdown.
selectList :: ALens' s a -> t a -> SelectListMakeRow s e a -> WidgetNode s e
selectList ALens' s a
field t a
items SelectListMakeRow s e a
makeRow = ALens' s a
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a) =>
ALens' s a
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
selectList_ ALens' s a
field t a
items SelectListMakeRow s e a
makeRow [SelectListCfg s e a]
forall a. Default a => a
def

-- | Creates a select list using the given lens. Accepts config.
selectList_
  :: (WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a)
  => ALens' s a             -- ^ The lens into the model.
  -> t a                    -- ^ The list of selectable items.
  -> SelectListMakeRow s e a  -- ^ Function to create the list items.
  -> [SelectListCfg s e a]  -- ^ The config options.
  -> WidgetNode s e         -- ^ The created dropdown.
selectList_ :: ALens' s a
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
selectList_ ALens' s a
field t a
items SelectListMakeRow s e a
makeRow [SelectListCfg s e a]
configs = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = WidgetData s a
-> t a
-> SelectListMakeRow s e a
-> [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_ (ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) t a
items SelectListMakeRow s e a
makeRow [SelectListCfg s e a]
configs

-- | Creates a select list using the given value and 'onChange' event handler.
selectListV
  :: (WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a)
  => a                -- ^ The event to raise on change.
  -> (Int -> a -> e)  -- ^ The list of selectable items.
  -> t a              -- ^ The list of selectable items.
  -> SelectListMakeRow s e a  -- ^ Function to create the list items.
  -> WidgetNode s e   -- ^ The created dropdown.
selectListV :: a
-> (Int -> a -> e)
-> t a
-> SelectListMakeRow s e a
-> WidgetNode s e
selectListV a
value Int -> a -> e
handler t a
items SelectListMakeRow s e a
makeRow = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = a
-> (Int -> a -> e)
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a) =>
a
-> (Int -> a -> e)
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
selectListV_ a
value Int -> a -> e
handler t a
items SelectListMakeRow s e a
makeRow [SelectListCfg s e a]
forall a. Default a => a
def

-- | Creates a select list using the given value and 'onChange' event handler.
--   Accepts config.
selectListV_
  :: (WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a)
  => a                      -- ^ The event to raise on change.
  -> (Int -> a -> e)        -- ^ The list of selectable items.
  -> t a                    -- ^ The list of selectable items.
  -> SelectListMakeRow s e a  -- ^ Function to create the list items.
  -> [SelectListCfg s e a]  -- ^ The config options.
  -> WidgetNode s e         -- ^ The created dropdown.
selectListV_ :: a
-> (Int -> a -> e)
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
selectListV_ a
value Int -> a -> e
handler t a
items SelectListMakeRow s e a
makeRow [SelectListCfg s e a]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s a
widgetData = a -> WidgetData s a
forall s a. a -> WidgetData s a
WidgetValue a
value
  newConfigs :: [SelectListCfg s e a]
newConfigs = (Int -> a -> e) -> SelectListCfg s e a
forall t e a. CmbOnChangeIdx t e a => (Int -> a -> e) -> t
onChangeIdx Int -> a -> e
handler SelectListCfg s e a
-> [SelectListCfg s e a] -> [SelectListCfg s e a]
forall a. a -> [a] -> [a]
: [SelectListCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = WidgetData s a
-> t a
-> SelectListMakeRow s e a
-> [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
forall s. WidgetData s a
widgetData t a
items SelectListMakeRow s e a
makeRow [SelectListCfg s e a]
newConfigs

-- | Creates a dropdown providing a 'WidgetData' instance and config.
selectListD_
  :: (WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a)
  => WidgetData s a         -- ^ The 'WidgetData' to retrieve the value from.
  -> t a                    -- ^ The list of selectable items.
  -> SelectListMakeRow s e a  -- ^ Function to create the list items.
  -> [SelectListCfg s e a]  -- ^ The config options.
  -> WidgetNode s e         -- ^ The created dropdown.
selectListD_ :: WidgetData s a
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
selectListD_ WidgetData s a
widgetData t a
items SelectListMakeRow s e a
makeRow [SelectListCfg s e a]
configs = Widget s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e
makeNode Widget s e
widget where
  config :: SelectListCfg s e a
config = [SelectListCfg s e a] -> SelectListCfg s e a
forall a. Monoid a => [a] -> a
mconcat [SelectListCfg s e a]
configs
  newItems :: Seq a
newItems = (Seq a -> a -> Seq a) -> Seq a -> t a -> Seq a
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
  newState :: SelectListState a
newState = Seq a -> Int -> Int -> SelectListState a
forall a. Seq a -> Int -> Int -> SelectListState a
SelectListState Seq a
newItems (-Int
1) Int
0
  widget :: Widget s e
widget = WidgetData s a
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, SelectListItem a) =>
WidgetData s a
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
makeSelectList WidgetData s a
widgetData Seq a
newItems SelectListMakeRow s e a
makeRow SelectListCfg s e a
config SelectListState a
newState

makeNode :: Widget s e -> WidgetNode s e
makeNode :: Widget s e -> WidgetNode s e
makeNode Widget s e
widget = [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [ALens' ThemeState StyleState -> ScrollCfg s e
forall s e. ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle ALens' ThemeState StyleState
forall s a. HasSelectListStyle s a => Lens' s a
L.selectListStyle] WidgetNode s e
childNode where
  childNode :: WidgetNode s e
childNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"selectList" 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
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
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

makeSelectList
  :: (WidgetModel s, WidgetEvent e, SelectListItem a)
  => WidgetData s a
  -> Seq a
  -> SelectListMakeRow s e a
  -> SelectListCfg s e a
  -> SelectListState a
  -> Widget s e
makeSelectList :: WidgetData s a
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
makeSelectList WidgetData s a
widgetData Seq a
items SelectListMakeRow s e a
makeRow SelectListCfg s e a
config SelectListState a
state = Widget s e
widget where
  widget :: Widget s e
widget = SelectListState a
-> Container s e (SelectListState a) -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer SelectListState a
state Container s e Any
forall a. Default a => a
def {
    containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
init,
    containerInitPost :: ContainerInitPostHandler s e (SelectListState a)
containerInitPost = ContainerInitPostHandler s e (SelectListState a)
forall p.
WidgetEnv s e
-> p -> SelectListState a -> WidgetResult s e -> WidgetResult s e
initPost,
    containerMergeChildrenReq :: ContainerMergeChildrenReqHandler s e (SelectListState a)
containerMergeChildrenReq = ContainerMergeChildrenReqHandler s e (SelectListState a)
forall p p p. p -> p -> p -> SelectListState a -> Bool
mergeChildrenReq,
    containerMerge :: ContainerMergeHandler s e (SelectListState a)
containerMerge = ContainerMergeHandler s e (SelectListState a)
forall p a.
WidgetEnv s e
-> WidgetNode s e -> p -> SelectListState a -> WidgetResult s e
merge,
    containerMergePost :: ContainerMergePostHandler s e (SelectListState a)
containerMergePost = ContainerMergePostHandler s e (SelectListState a)
forall p p.
WidgetEnv s e
-> p
-> p
-> SelectListState a
-> SelectListState a
-> WidgetResult s e
-> WidgetResult s e
mergePost,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = ContainerMessageHandler s e
forall a p.
Typeable a =>
WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage
  }

  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

  createSelectListChildren :: WidgetEnv s e -> s -> Seq (WidgetNode s e)
createSelectListChildren WidgetEnv s e
wenv s
node = Seq (WidgetNode s e)
children where
    widgetId :: WidgetId
widgetId = s
node s -> Getting WidgetId s WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (a -> Const WidgetId a) -> s -> Const WidgetId s
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const WidgetId a) -> s -> Const WidgetId s)
-> ((WidgetId -> Const WidgetId WidgetId) -> a -> Const WidgetId a)
-> Getting WidgetId s WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId) -> a -> Const WidgetId a
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    selected :: a
selected = WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
    itemsList :: WidgetNode s e
itemsList = WidgetEnv s e
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> WidgetId
-> SelectListMakeRow s e a
forall s e a.
(WidgetModel s, WidgetEvent e, Eq a) =>
WidgetEnv s e
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> WidgetId
-> SelectListMakeRow s e a
makeItemsList WidgetEnv s e
wenv Seq a
items SelectListMakeRow s e a
makeRow SelectListCfg s e a
config WidgetId
widgetId a
selected
    children :: Seq (WidgetNode s e)
children = WidgetNode s e -> Seq (WidgetNode s e)
forall a. a -> Seq a
Seq.singleton WidgetNode s e
itemsList

  init :: ContainerInitHandler 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
newNode where
    selected :: a
selected = WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
    newSl :: Int
newSl = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (a -> Seq a -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL a
selected Seq a
items)
    newHl :: Int
newHl = if Int
newSl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
0 else Int
newSl
    newState :: SelectListState a
newState = SelectListState a
state {
      _slIdx :: Int
_slIdx = Int
newSl,
      _hlIdx :: Int
_hlIdx = Int
newHl
    }
    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
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
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, SelectListItem a) =>
WidgetData s a
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
makeSelectList WidgetData s a
widgetData Seq a
items SelectListMakeRow s e a
makeRow SelectListCfg s e a
config SelectListState a
newState
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s e -> WidgetNode s e -> Seq (WidgetNode s e)
forall s a.
(HasInfo s a, HasWidgetId a WidgetId) =>
WidgetEnv s e -> s -> Seq (WidgetNode s e)
createSelectListChildren WidgetEnv s e
wenv WidgetNode s e
node

  initPost :: WidgetEnv s e
-> p -> SelectListState a -> WidgetResult s e -> WidgetResult s e
initPost WidgetEnv s e
wenv p
node SelectListState a
newState WidgetResult s e
result = WidgetResult s e
newResult where
    newResult :: WidgetResult s e
newResult = WidgetEnv s e
-> SelectListCfg s e a
-> WidgetResult s e
-> SelectListState a
-> SelectListState a
-> WidgetResult s e
forall s e a.
WidgetEnv s e
-> SelectListCfg s e a
-> WidgetResult s e
-> SelectListState a
-> SelectListState a
-> WidgetResult s e
updateResultStyle WidgetEnv s e
wenv SelectListCfg s e a
config WidgetResult s e
result SelectListState a
state SelectListState a
newState

  mergeChildrenReq :: p -> p -> p -> SelectListState a -> Bool
mergeChildrenReq p
wenv p
node p
oldNode SelectListState a
oldState = Bool
result where
    oldItems :: Seq a
oldItems = SelectListState a -> Seq a
forall a. SelectListState a -> Seq a
_prevItems SelectListState a
oldState
    mergeRequiredFn :: Seq a -> Seq a -> Bool
mergeRequiredFn = (Seq a -> Seq a -> Bool)
-> Maybe (Seq a -> Seq a -> Bool) -> Seq a -> Seq a -> Bool
forall a. a -> Maybe a -> a
fromMaybe Seq a -> Seq a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (SelectListCfg s e a -> Maybe (Seq a -> Seq a -> Bool)
forall s e a. SelectListCfg s e a -> Maybe (Seq a -> Seq a -> Bool)
_slcMergeRequired SelectListCfg s e a
config)
    result :: Bool
result = Seq a -> Seq a -> Bool
mergeRequiredFn Seq a
oldItems Seq a
items

  merge :: WidgetEnv s e
-> WidgetNode s e -> p -> SelectListState a -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
node p
oldNode SelectListState a
oldState = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    selected :: a
selected = WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
    newSl :: Int
newSl = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (a -> Seq a -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL a
selected Seq a
items)
    newHl :: Int
newHl
      | Int
newSl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= SelectListState a -> Int
forall a. SelectListState a -> Int
_slIdx SelectListState a
oldState = Int
newSl
      | Bool
otherwise = SelectListState a -> Int
forall a. SelectListState a -> Int
_hlIdx SelectListState a
oldState
    newState :: SelectListState a
newState = SelectListState a
oldState {
      _slIdx :: Int
_slIdx = Int
newSl,
      _hlIdx :: Int
_hlIdx = Int
newHl,
      _prevItems :: Seq a
_prevItems = Seq a
items
    }
    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
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
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, SelectListItem a) =>
WidgetData s a
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
makeSelectList WidgetData s a
widgetData Seq a
items SelectListMakeRow s e a
makeRow SelectListCfg s e a
config SelectListState a
newState
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s e -> WidgetNode s e -> Seq (WidgetNode s e)
forall s a.
(HasInfo s a, HasWidgetId a WidgetId) =>
WidgetEnv s e -> s -> Seq (WidgetNode s e)
createSelectListChildren WidgetEnv s e
wenv WidgetNode s e
node

  mergePost :: WidgetEnv s e
-> p
-> p
-> SelectListState a
-> SelectListState a
-> WidgetResult s e
-> WidgetResult s e
mergePost WidgetEnv s e
wenv p
node p
oldNode SelectListState a
oldState SelectListState a
newState WidgetResult s e
result = WidgetResult s e
newResult where
    newResult :: WidgetResult s e
newResult = WidgetEnv s e
-> SelectListCfg s e a
-> WidgetResult s e
-> SelectListState a
-> SelectListState a
-> WidgetResult s e
forall s e a.
WidgetEnv s e
-> SelectListCfg s e a
-> WidgetResult s e
-> SelectListState a
-> SelectListState a
-> WidgetResult s e
updateResultStyle WidgetEnv s e
wenv SelectListCfg s e a
config WidgetResult s e
result SelectListState a
oldState SelectListState a
newState

  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
    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
L.mainButton -> 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
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
L.widgetId)]

    Focus Path
prev -> 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 (SelectListCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnFocusReq SelectListCfg s e a
config)

    Blur Path
next -> Maybe (WidgetResult s e)
result where
      tabPressed :: Bool
tabPressed = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (Maybe KeyStatus) (WidgetEnv s e) (Maybe KeyStatus)
-> Maybe KeyStatus
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const (Maybe KeyStatus) InputStatus)
-> WidgetEnv s e -> Const (Maybe KeyStatus) (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Const (Maybe KeyStatus) InputStatus)
 -> WidgetEnv s e -> Const (Maybe KeyStatus) (WidgetEnv s e))
-> ((Maybe KeyStatus -> Const (Maybe KeyStatus) (Maybe KeyStatus))
    -> InputStatus -> Const (Maybe KeyStatus) InputStatus)
-> Getting (Maybe KeyStatus) (WidgetEnv s e) (Maybe KeyStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map KeyCode KeyStatus
 -> Const (Maybe KeyStatus) (Map KeyCode KeyStatus))
-> InputStatus -> Const (Maybe KeyStatus) InputStatus
forall s a. HasKeys s a => Lens' s a
L.keys ((Map KeyCode KeyStatus
  -> Const (Maybe KeyStatus) (Map KeyCode KeyStatus))
 -> InputStatus -> Const (Maybe KeyStatus) InputStatus)
-> ((Maybe KeyStatus -> Const (Maybe KeyStatus) (Maybe KeyStatus))
    -> Map KeyCode KeyStatus
    -> Const (Maybe KeyStatus) (Map KeyCode KeyStatus))
-> (Maybe KeyStatus -> Const (Maybe KeyStatus) (Maybe KeyStatus))
-> InputStatus
-> Const (Maybe KeyStatus) InputStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map KeyCode KeyStatus)
-> Lens'
     (Map KeyCode KeyStatus) (Maybe (IxValue (Map KeyCode KeyStatus)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map KeyCode KeyStatus)
KeyCode
keyTab Maybe KeyStatus -> Maybe KeyStatus -> Bool
forall a. Eq a => a -> a -> Bool
== KeyStatus -> Maybe KeyStatus
forall a. a -> Maybe a
Just KeyStatus
KeyPressed
      changeReq :: Bool
changeReq = Bool
tabPressed Bool -> Bool -> Bool
&& SelectListCfg s e a -> Maybe Bool
forall s e a. SelectListCfg s e a -> Maybe Bool
_slcSelectOnBlur SelectListCfg s e a
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      WidgetResult WidgetNode s e
tempNode Seq (WidgetRequest s e)
tempReqs
        | Bool
changeReq = WidgetEnv s e -> WidgetNode s e -> Int -> WidgetResult s e
selectItem WidgetEnv s e
wenv WidgetNode s e
node (SelectListState a -> Int
forall a. SelectListState a -> Int
_hlIdx SelectListState a
state)
        | Bool
otherwise = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
      reqs :: Seq (WidgetRequest s e)
reqs = Seq (WidgetRequest s e)
tempReqs Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList (((Path -> WidgetRequest s e) -> Path -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ Path
next) ((Path -> WidgetRequest s e) -> WidgetRequest s e)
-> [Path -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectListCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnBlurReq SelectListCfg s e a
config)
      result :: Maybe (WidgetResult s e)
result
        | Bool
changeReq Bool -> Bool -> Bool
|| Bool -> Bool
not (Seq (WidgetRequest s e) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (WidgetRequest s e)
reqs) = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
tempNode Seq (WidgetRequest s e)
reqs
        | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    KeyAction KeyMod
mode KeyCode
code KeyStatus
status
      | KeyCode -> Bool
isKeyDown KeyCode
code Bool -> Bool -> Bool
&& KeyStatus
status KeyStatus -> KeyStatus -> Bool
forall a. Eq a => a -> a -> Bool
== KeyStatus
KeyPressed -> WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
highlightNext WidgetEnv s e
wenv WidgetNode s e
node
      | KeyCode -> Bool
isKeyUp KeyCode
code Bool -> Bool -> Bool
&& KeyStatus
status KeyStatus -> KeyStatus -> Bool
forall a. Eq a => a -> a -> Bool
== KeyStatus
KeyPressed -> WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
highlightPrev WidgetEnv s e
wenv WidgetNode s e
node
      | KeyCode -> Bool
isSelectKey KeyCode
code Bool -> Bool -> Bool
&& KeyStatus
status KeyStatus -> KeyStatus -> Bool
forall a. Eq a => a -> a -> Bool
== KeyStatus
KeyPressed -> Maybe (WidgetResult s e)
resultSelected
      where
        resultSelected :: Maybe (WidgetResult s e)
resultSelected = 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 -> WidgetResult s e
selectItem WidgetEnv s e
wenv WidgetNode s e
node (SelectListState a -> Int
forall a. SelectListState a -> Int
_hlIdx SelectListState a
state)
        isSelectKey :: KeyCode -> Bool
isSelectKey KeyCode
code = KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
|| KeyCode -> Bool
isKeySpace KeyCode
code
    SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

  highlightNext :: WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
highlightNext WidgetEnv s e
wenv WidgetNode s e
node = WidgetEnv s e -> WidgetNode s e -> Int -> Maybe (WidgetResult s e)
highlightItem WidgetEnv s e
wenv WidgetNode s e
node Int
nextIdx where
    tempIdx :: Int
tempIdx = SelectListState a -> Int
forall a. SelectListState a -> Int
_hlIdx SelectListState a
state
    nextIdx :: Int
nextIdx
      | Int
tempIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
items Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Int
tempIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      | Bool
otherwise = Int
tempIdx

  highlightPrev :: WidgetEnv s e -> WidgetNode s e -> Maybe (WidgetResult s e)
highlightPrev WidgetEnv s e
wenv WidgetNode s e
node = WidgetEnv s e -> WidgetNode s e -> Int -> Maybe (WidgetResult s e)
highlightItem WidgetEnv s e
wenv WidgetNode s e
node Int
nextIdx where
    tempIdx :: Int
tempIdx = SelectListState a -> Int
forall a. SelectListState a -> Int
_hlIdx SelectListState a
state
    nextIdx :: Int
nextIdx
      | Int
tempIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int
tempIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      | Bool
otherwise = Int
tempIdx

  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
message = Maybe (WidgetResult s e)
result where
    handleSelect :: SelectListMessage -> WidgetResult s e
handleSelect (SelectListClickItem Int
idx) = WidgetEnv s e -> WidgetNode s e -> Int -> WidgetResult s e
handleItemClick WidgetEnv s e
wenv WidgetNode s e
node Int
idx
    handleSelect SelectListMessage
SelectListShowSelected = ContainerInitHandler s e
forall s e s e. WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
handleItemShow WidgetEnv s e
wenv WidgetNode s e
node
    result :: Maybe (WidgetResult s e)
result = (SelectListMessage -> WidgetResult s e)
-> Maybe SelectListMessage -> Maybe (WidgetResult s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectListMessage -> WidgetResult s e
handleSelect (a -> Maybe SelectListMessage
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
message)

  handleItemClick :: WidgetEnv s e -> WidgetNode s e -> Int -> WidgetResult s e
handleItemClick WidgetEnv s e
wenv WidgetNode s e
node Int
idx = WidgetResult s e
result where
    focusReq :: WidgetRequest s e
focusReq = WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus (WidgetId -> WidgetRequest s e) -> WidgetId -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((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
L.widgetId
    tempResult :: WidgetResult s e
tempResult = WidgetEnv s e -> WidgetNode s e -> Int -> WidgetResult s e
selectItem WidgetEnv s e
wenv WidgetNode s e
node Int
idx
    result :: WidgetResult s e
result
      | WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
tempResult
      | Bool
otherwise = 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
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
focusReq)

  handleItemShow :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
handleItemShow 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
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs where
    reqs :: [WidgetRequest s e]
reqs = WidgetEnv s e -> WidgetNode s e -> Int -> [WidgetRequest s e]
forall s e s e s e.
WidgetEnv s e -> WidgetNode s e -> Int -> [WidgetRequest s e]
itemScrollTo WidgetEnv s e
wenv WidgetNode s e
node (SelectListState a -> Int
forall a. SelectListState a -> Int
_slIdx SelectListState a
state)

  highlightItem :: WidgetEnv s e -> WidgetNode s e -> Int -> Maybe (WidgetResult s e)
highlightItem WidgetEnv s e
wenv WidgetNode s e
node Int
nextIdx = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
    newState :: SelectListState a
newState = SelectListState a
state {
      _hlIdx :: Int
_hlIdx = Int
nextIdx
    }
    tmpNode :: WidgetNode s e
tmpNode = 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
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
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, SelectListItem a) =>
WidgetData s a
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
makeSelectList WidgetData s a
widgetData Seq a
items SelectListMakeRow s e a
makeRow SelectListCfg s e a
config SelectListState a
newState
    slIdx :: Int
slIdx = SelectListState a -> Int
forall a. SelectListState a -> Int
_slIdx SelectListState a
state

    (WidgetNode s e
newNode, [WidgetRequest s e]
resizeReq) = WidgetEnv s e
-> SelectListCfg s e a
-> SelectListState a
-> WidgetNode s e
-> Int
-> Int
-> (WidgetNode s e, [WidgetRequest s e])
forall s e a.
WidgetEnv s e
-> SelectListCfg s e a
-> SelectListState a
-> WidgetNode s e
-> Int
-> Int
-> (WidgetNode s e, [WidgetRequest s e])
updateStyles WidgetEnv s e
wenv SelectListCfg s e a
config SelectListState a
state WidgetNode s e
tmpNode Int
slIdx Int
nextIdx
    reqs :: [WidgetRequest s e]
reqs = WidgetEnv s e -> WidgetNode s e -> Int -> [WidgetRequest s e]
forall s e s e s e.
WidgetEnv s e -> WidgetNode s e -> Int -> [WidgetRequest s e]
itemScrollTo WidgetEnv s e
wenv WidgetNode s e
newNode Int
nextIdx [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
resizeReq
    result :: WidgetResult s e
result = 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]
reqs

  selectItem :: WidgetEnv s e -> WidgetNode s e -> Int -> WidgetResult s e
selectItem WidgetEnv s e
wenv WidgetNode s e
node Int
idx = WidgetResult s e
result where
    selected :: a
selected = WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
    value :: a
value = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
selected (Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq a
items)
    valueSetReq :: [WidgetRequest s e]
valueSetReq = WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
widgetData a
value
    scrollToReq :: [WidgetRequest s e]
scrollToReq = WidgetEnv s e -> WidgetNode s e -> Int -> [WidgetRequest s e]
forall s e s e s e.
WidgetEnv s e -> WidgetNode s e -> Int -> [WidgetRequest s e]
itemScrollTo WidgetEnv s e
wenv WidgetNode s e
node Int
idx
    changeReqs :: [WidgetRequest s e]
changeReqs = ((a -> WidgetRequest s e) -> WidgetRequest s e)
-> [a -> WidgetRequest s e] -> [WidgetRequest s e]
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
value) (SelectListCfg s e a -> [a -> WidgetRequest s e]
forall s e a. SelectListCfg s e a -> [a -> WidgetRequest s e]
_slcOnChangeReq SelectListCfg 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 (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
value) (SelectListCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a.
SelectListCfg s e a -> [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq SelectListCfg s e a
config)
    (WidgetNode s e
styledNode, [WidgetRequest s e]
resizeReq) = WidgetEnv s e
-> SelectListCfg s e a
-> SelectListState a
-> WidgetNode s e
-> Int
-> Int
-> (WidgetNode s e, [WidgetRequest s e])
forall s e a.
WidgetEnv s e
-> SelectListCfg s e a
-> SelectListState a
-> WidgetNode s e
-> Int
-> Int
-> (WidgetNode s e, [WidgetRequest s e])
updateStyles WidgetEnv s e
wenv SelectListCfg s e a
config SelectListState a
state WidgetNode s e
node Int
idx Int
idx

    newState :: SelectListState a
newState = SelectListState a
state {
      _slIdx :: Int
_slIdx = Int
idx,
      _hlIdx :: Int
_hlIdx = Int
idx
    }
    newNode :: WidgetNode s e
newNode = WidgetNode s e
styledNode
      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
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
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, SelectListItem a) =>
WidgetData s a
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> SelectListState a
-> Widget s e
makeSelectList WidgetData s a
widgetData Seq a
items SelectListMakeRow s e a
makeRow SelectListCfg s e a
config SelectListState a
newState
    reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
forall e. [WidgetRequest s e]
valueSetReq [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
forall s e. [WidgetRequest s e]
scrollToReq [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
changeReqs [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
resizeReq
    result :: WidgetResult s e
result = 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]
reqs

  itemScrollTo :: WidgetEnv s e -> WidgetNode s e -> Int -> [WidgetRequest s e]
itemScrollTo WidgetEnv s e
wenv WidgetNode s e
node Int
idx = Maybe (WidgetRequest s e) -> [WidgetRequest s e]
forall a. Maybe a -> [a]
maybeToList (WidgetId -> Rect -> WidgetRequest s e
forall s e. WidgetId -> Rect -> WidgetRequest s e
scrollToReq (WidgetId -> Rect -> WidgetRequest s e)
-> Maybe WidgetId -> Maybe (Rect -> WidgetRequest s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe WidgetId
mwid Maybe (Rect -> WidgetRequest s e)
-> Maybe Rect -> Maybe (WidgetRequest s e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Rect
vp) where
    vp :: Maybe Rect
vp = WidgetNode s e -> Int -> Maybe Rect
forall s s s e.
(HasChildren s (Seq s), HasChildren s (Seq (WidgetNode s e))) =>
s -> Int -> Maybe Rect
itemViewport WidgetNode s e
node Int
idx
    mwid :: Maybe WidgetId
mwid = WidgetEnv s e -> Path -> Maybe WidgetId
forall s e. WidgetEnv s e -> Path -> Maybe WidgetId
findWidgetIdFromPath WidgetEnv s e
wenv (WidgetNode s e -> Path
forall s e. WidgetNode s e -> Path
parentPath WidgetNode s e
node)
    scrollToReq :: WidgetId -> Rect -> WidgetRequest s e
scrollToReq WidgetId
wid Rect
rect = WidgetId -> ScrollMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
wid (Rect -> ScrollMessage
ScrollTo Rect
rect)

  itemViewport :: s -> Int -> Maybe Rect
itemViewport s
node Int
idx = Maybe Rect
viewport where
    lookup :: Int -> s -> Maybe a
lookup Int
idx s
node = Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx (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
L.children)
    viewport :: Maybe Rect
viewport = (WidgetNode s e -> Rect) -> Maybe (WidgetNode s e) -> Maybe Rect
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WidgetNodeInfo -> Rect
_wniViewport (WidgetNodeInfo -> Rect)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) (Maybe (WidgetNode s e) -> Maybe Rect)
-> Maybe (WidgetNode s e) -> Maybe Rect
forall a b. (a -> b) -> a -> b
$ s -> Maybe s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
node
      Maybe s -> (s -> Maybe s) -> Maybe s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> s -> Maybe s
forall s a. HasChildren s (Seq a) => Int -> s -> Maybe a
lookup Int
0 -- vstack
      Maybe s -> (s -> Maybe (WidgetNode s e)) -> Maybe (WidgetNode s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> s -> Maybe (WidgetNode s e)
forall s a. HasChildren s (Seq a) => Int -> s -> Maybe a
lookup Int
idx -- item

updateStyles
  :: WidgetEnv s e
  -> SelectListCfg s e a
  -> SelectListState a
  -> WidgetNode s e
  -> Int
  -> Int
  -> (WidgetNode s e, [WidgetRequest s e])
updateStyles :: WidgetEnv s e
-> SelectListCfg s e a
-> SelectListState a
-> WidgetNode s e
-> Int
-> Int
-> (WidgetNode s e, [WidgetRequest s e])
updateStyles WidgetEnv s e
wenv SelectListCfg s e a
config SelectListState a
state WidgetNode s e
node Int
newSlIdx Int
newHlIdx = (WidgetNode s e
newNode, [WidgetRequest s e]
forall s e. [WidgetRequest s e]
newReqs) 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
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
L.widgetId
  items :: Seq (WidgetNode s e)
items = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> ((Seq (WidgetNode s e)
     -> Const (Seq (WidgetNode s e)) (Seq (WidgetNode s e)))
    -> Seq (WidgetNode s e)
    -> Const (Seq (WidgetNode s e)) (Seq (WidgetNode s e)))
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (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 ((WidgetNode s e -> Const (Seq (WidgetNode s e)) (WidgetNode s e))
 -> Seq (WidgetNode s e)
 -> Const (Seq (WidgetNode s e)) (Seq (WidgetNode s e)))
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> (Seq (WidgetNode s e)
    -> Const (Seq (WidgetNode s e)) (Seq (WidgetNode s e)))
-> Seq (WidgetNode s e)
-> Const (Seq (WidgetNode s e)) (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
  normalStyle :: Style
normalStyle = WidgetEnv s e -> SelectListCfg s e a -> Style
forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getNormalStyle WidgetEnv s e
wenv SelectListCfg s e a
config
  idxMatch :: Bool
idxMatch = Int
newSlIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
newHlIdx

  (Style
slStyle, Style
hlStyle)
    | Bool
idxMatch = (WidgetEnv s e -> SelectListCfg s e a -> Style
forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getSlHlStyle WidgetEnv s e
wenv SelectListCfg s e a
config, WidgetEnv s e -> SelectListCfg s e a -> Style
forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getSlHlStyle WidgetEnv s e
wenv SelectListCfg s e a
config)
    | Bool
otherwise = (WidgetEnv s e -> SelectListCfg s e a -> Style
forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getSlStyle WidgetEnv s e
wenv SelectListCfg s e a
config, WidgetEnv s e -> SelectListCfg s e a -> Style
forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getHlStyle WidgetEnv s e
wenv SelectListCfg s e a
config)

  (Seq (WidgetNode s e)
newChildren, Bool
resizeReq) = (Seq (WidgetNode s e)
items, Bool
False)
    (Seq (WidgetNode s e), Bool)
-> ((Seq (WidgetNode s e), Bool) -> (Seq (WidgetNode s e), Bool))
-> (Seq (WidgetNode s e), Bool)
forall a b. a -> (a -> b) -> b
& WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
forall s e.
WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
updateItemStyle WidgetEnv s e
wenv (SelectListState a -> Int
forall a. SelectListState a -> Int
_slIdx SelectListState a
state) (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
normalStyle)
    (Seq (WidgetNode s e), Bool)
-> ((Seq (WidgetNode s e), Bool) -> (Seq (WidgetNode s e), Bool))
-> (Seq (WidgetNode s e), Bool)
forall a b. a -> (a -> b) -> b
& WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
forall s e.
WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
updateItemStyle WidgetEnv s e
wenv (SelectListState a -> Int
forall a. SelectListState a -> Int
_hlIdx SelectListState a
state) (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
normalStyle)
    (Seq (WidgetNode s e), Bool)
-> ((Seq (WidgetNode s e), Bool) -> (Seq (WidgetNode s e), Bool))
-> (Seq (WidgetNode s e), Bool)
forall a b. a -> (a -> b) -> b
& WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
forall s e.
WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
updateItemStyle WidgetEnv s e
wenv Int
newHlIdx (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
hlStyle)
    (Seq (WidgetNode s e), Bool)
-> ((Seq (WidgetNode s e), Bool) -> (Seq (WidgetNode s e), Bool))
-> (Seq (WidgetNode s e), Bool)
forall a b. a -> (a -> b) -> b
& WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
forall s e.
WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
updateItemStyle WidgetEnv s e
wenv Int
newSlIdx (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
slStyle)

  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
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
    -> Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e
-> Identity (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 ((WidgetNode s e -> Identity (WidgetNode s e))
 -> Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
    -> WidgetNode s e -> Identity (WidgetNode s e))
-> (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> Seq (WidgetNode s e)
-> Identity (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode s e)
newChildren
  newReqs :: [WidgetRequest s e]
newReqs = [ WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId | Bool
resizeReq ]

updateItemStyle
  :: WidgetEnv s e
  -> Int
  -> Maybe Style
  -> (Seq (WidgetNode s e), Bool)
  -> (Seq (WidgetNode s e), Bool)
updateItemStyle :: WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
updateItemStyle WidgetEnv s e
wenv Int
idx Maybe Style
mstyle (Seq (WidgetNode s e)
items, Bool
resizeReq) = (Seq (WidgetNode s e), Bool)
result where
  result :: (Seq (WidgetNode s e), Bool)
result = case Int -> Seq (WidgetNode s e) -> Maybe (WidgetNode s e)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq (WidgetNode s e)
items of
    Just WidgetNode s e
item -> (Seq (WidgetNode s e)
newItems, Bool
resizeReq Bool -> Bool -> Bool
|| Bool
newResizeReq) where
      tmpItem :: WidgetNode s e
tmpItem = WidgetNode s e -> Maybe Style -> WidgetNode s e
forall s e. WidgetNode s e -> Maybe Style -> WidgetNode s e
setItemStyle WidgetNode s e
item Maybe Style
mstyle
      (WidgetNode s e
newItem, Bool
newResizeReq) = WidgetEnv s e -> WidgetNode s e -> (WidgetNode s e, Bool)
forall s e.
WidgetEnv s e -> WidgetNode s e -> (WidgetNode s e, Bool)
updateItemSizeReq WidgetEnv s e
wenv WidgetNode s e
tmpItem
      newItems :: Seq (WidgetNode s e)
newItems = Int
-> WidgetNode s e -> Seq (WidgetNode s e) -> Seq (WidgetNode s e)
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
idx WidgetNode s e
newItem Seq (WidgetNode s e)
items
    Maybe (WidgetNode s e)
Nothing -> (Seq (WidgetNode s e)
items, Bool
resizeReq)

updateItemSizeReq :: WidgetEnv s e -> WidgetNode s e -> (WidgetNode s e, Bool)
updateItemSizeReq :: WidgetEnv s e -> WidgetNode s e -> (WidgetNode s e, Bool)
updateItemSizeReq WidgetEnv s e
wenv WidgetNode s e
item = (WidgetNode s e
newItem, Bool
resizeReq) where
  (SizeReq
oldReqW, SizeReq
oldReqH) = (WidgetNode s e
itemWidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((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
L.sizeReqW, WidgetNode s e
itemWidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((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
L.sizeReqH)
  (SizeReq
newReqW, SizeReq
newReqH) = Widget s e -> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
widgetGetSizeReq (WidgetNode s e
item WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
item
  newItem :: WidgetNode s e
newItem = WidgetNode s e
item
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((SizeReq -> Identity SizeReq)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (SizeReq -> Identity SizeReq)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Identity SizeReq)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW ((SizeReq -> Identity SizeReq)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> SizeReq -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqW
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((SizeReq -> Identity SizeReq)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (SizeReq -> Identity SizeReq)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Identity SizeReq)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH ((SizeReq -> Identity SizeReq)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> SizeReq -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqH
  resizeReq :: Bool
resizeReq = (SizeReq
oldReqW, SizeReq
oldReqH) (SizeReq, SizeReq) -> (SizeReq, SizeReq) -> Bool
forall a. Eq a => a -> a -> Bool
/= (SizeReq
newReqW, SizeReq
newReqH)

setItemStyle :: WidgetNode s e -> Maybe Style -> WidgetNode s e
setItemStyle :: WidgetNode s e -> Maybe Style -> WidgetNode s e
setItemStyle WidgetNode s e
item Maybe Style
Nothing = WidgetNode s e
item
setItemStyle WidgetNode s e
item (Just Style
st) = WidgetNode s e
item
  WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
    -> Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (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 ((WidgetNode s e -> Identity (WidgetNode s e))
 -> Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> ((Style -> Identity Style)
    -> WidgetNode s e -> Identity (WidgetNode s e))
-> (Style -> Identity Style)
-> Seq (WidgetNode s e)
-> Identity (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((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
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
st

getSlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getSlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getSlStyle WidgetEnv s e
wenv SelectListCfg s e a
config = Style
style where
  theme :: Style
theme = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasSelectListItemSelectedStyle s a => Lens' s a
Lens' ThemeState StyleState
L.selectListItemSelectedStyle
  style :: Style
style = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
theme Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> SelectListCfg s e a -> Maybe Style
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemSelectedStyle SelectListCfg s e a
config)
  slStyle :: Style
slStyle = Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasBasic s a => Lens' s a
L.basic ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> Maybe StyleState -> Style -> Style
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style Style
-> Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
forall s a. s -> Getting a s a -> a
^. Getting (Maybe StyleState) Style (Maybe StyleState)
forall s a. HasFocus s a => Lens' s a
L.focus
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasHover s a => Lens' s a
L.hover ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> Maybe StyleState -> Style -> Style
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style Style
-> Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
forall s a. s -> Getting a s a -> a
^. Getting (Maybe StyleState) Style (Maybe StyleState)
forall s a. HasFocusHover s a => Lens' s a
L.focusHover

getSlHlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getSlHlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getSlHlStyle WidgetEnv s e
wenv SelectListCfg s e a
config = Style
slStyle where
  style :: Style
style = WidgetEnv s e -> SelectListCfg s e a -> Style
forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getSlStyle WidgetEnv s e
wenv SelectListCfg s e a
config
  slStyle :: Style
slStyle = Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasBasic s a => Lens' s a
L.basic ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> Maybe StyleState -> Style -> Style
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style Style
-> Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
forall s a. s -> Getting a s a -> a
^. Getting (Maybe StyleState) Style (Maybe StyleState)
forall s a. HasFocus s a => Lens' s a
L.focus
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasHover s a => Lens' s a
L.hover ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> Maybe StyleState -> Style -> Style
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style Style
-> Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
forall s a. s -> Getting a s a -> a
^. Getting (Maybe StyleState) Style (Maybe StyleState)
forall s a. HasFocusHover s a => Lens' s a
L.focusHover

getHlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getHlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getHlStyle WidgetEnv s e
wenv SelectListCfg s e a
config = Style
hlStyle where
  theme :: Style
theme = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasSelectListItemStyle s a => Lens' s a
Lens' ThemeState StyleState
L.selectListItemStyle
  style :: Style
style = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
theme Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> SelectListCfg s e a -> Maybe Style
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle SelectListCfg s e a
config)
  hlStyle :: Style
hlStyle = Style
style
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasBasic s a => Lens' s a
L.basic ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> Maybe StyleState -> Style -> Style
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style Style
-> Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
forall s a. s -> Getting a s a -> a
^. Getting (Maybe StyleState) Style (Maybe StyleState)
forall s a. HasFocus s a => Lens' s a
L.focus
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& (Maybe StyleState -> Identity (Maybe StyleState))
-> Style -> Identity Style
forall s a. HasHover s a => Lens' s a
L.hover ((Maybe StyleState -> Identity (Maybe StyleState))
 -> Style -> Identity Style)
-> Maybe StyleState -> Style -> Style
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style Style
-> Getting (Maybe StyleState) Style (Maybe StyleState)
-> Maybe StyleState
forall s a. s -> Getting a s a -> a
^. Getting (Maybe StyleState) Style (Maybe StyleState)
forall s a. HasFocusHover s a => Lens' s a
L.focusHover

getNormalStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getNormalStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getNormalStyle WidgetEnv s e
wenv SelectListCfg s e a
config = Style
style where
  theme :: Style
theme = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasSelectListItemStyle s a => Lens' s a
Lens' ThemeState StyleState
L.selectListItemStyle
  style :: Style
style = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
theme Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> SelectListCfg s e a -> Maybe Style
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle SelectListCfg s e a
config)

updateResultStyle
  :: WidgetEnv s e
  -> SelectListCfg s e a
  -> WidgetResult s e
  -> SelectListState a
  -> SelectListState a
  -> WidgetResult s e
updateResultStyle :: WidgetEnv s e
-> SelectListCfg s e a
-> WidgetResult s e
-> SelectListState a
-> SelectListState a
-> WidgetResult s e
updateResultStyle WidgetEnv s e
wenv SelectListCfg s e a
config WidgetResult s e
result SelectListState a
oldState SelectListState a
newState = WidgetResult s e
newResult where
  slIdx :: Int
slIdx = SelectListState a -> Int
forall a. SelectListState a -> Int
_slIdx SelectListState a
newState
  hlIdx :: Int
hlIdx = SelectListState a -> Int
forall a. SelectListState a -> Int
_hlIdx SelectListState a
newState
  tmpNode :: WidgetNode s e
tmpNode = WidgetResult s e
result WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
L.node
  (WidgetNode s e
newNode, [WidgetRequest s e]
reqs) = WidgetEnv s e
-> SelectListCfg s e a
-> SelectListState a
-> WidgetNode s e
-> Int
-> Int
-> (WidgetNode s e, [WidgetRequest s e])
forall s e a.
WidgetEnv s e
-> SelectListCfg s e a
-> SelectListState a
-> WidgetNode s e
-> Int
-> Int
-> (WidgetNode s e, [WidgetRequest s e])
updateStyles WidgetEnv s e
wenv SelectListCfg s e a
config SelectListState a
oldState WidgetNode s e
tmpNode Int
slIdx Int
hlIdx
  newResult :: WidgetResult s e
newResult = 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]
reqs

makeItemsList
  :: (WidgetModel s, WidgetEvent e, Eq a)
  => WidgetEnv s e
  -> Seq a
  -> SelectListMakeRow s e a
  -> SelectListCfg s e a
  -> WidgetId
  -> a
  -> WidgetNode s e
makeItemsList :: WidgetEnv s e
-> Seq a
-> SelectListMakeRow s e a
-> SelectListCfg s e a
-> WidgetId
-> SelectListMakeRow s e a
makeItemsList WidgetEnv s e
wenv Seq a
items SelectListMakeRow s e a
makeRow SelectListCfg s e a
config WidgetId
widgetId a
selected = WidgetNode s e
itemsList 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 forall s a. HasSelectListItemStyle s a => Lens' s a
Lens' ThemeState StyleState
L.selectListItemStyle
  normalStyle :: Style
normalStyle = 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
<> SelectListCfg s e a -> Maybe Style
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle SelectListCfg s e a
config)

  makeItem :: Int -> SelectListMakeRow s e a
makeItem Int
idx a
item = WidgetNode s e
newItem where
    clickCfg :: BoxCfg s e
clickCfg = WidgetRequest s e -> BoxCfg s e
forall t s e. CmbOnClickReq t s e => WidgetRequest s e -> t
onClickReq (WidgetRequest s e -> BoxCfg s e)
-> WidgetRequest s e -> BoxCfg s e
forall a b. (a -> b) -> a -> b
$ WidgetId -> SelectListMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
widgetId (Int -> SelectListMessage
SelectListClickItem Int
idx)
    itemCfg :: [BoxCfg s e]
itemCfg = [BoxCfg s e
forall s e. BoxCfg s e
expandContent, BoxCfg s e
clickCfg]
    content :: WidgetNode s e
content = SelectListMakeRow s e a
makeRow a
item
    newItem :: WidgetNode s e
newItem = [BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [BoxCfg s e]
itemCfg (WidgetNode s e
content WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((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
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
normalStyle)
  itemsList :: WidgetNode s e
itemsList = Seq (WidgetNode s e) -> WidgetNode s e
forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
vstack (Seq (WidgetNode s e) -> WidgetNode s e)
-> Seq (WidgetNode s e) -> WidgetNode s e
forall a b. (a -> b) -> a -> b
$ (Int -> SelectListMakeRow s e a) -> Seq a -> Seq (WidgetNode s e)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> SelectListMakeRow s e a
makeItem Seq a
items