{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Containers.SelectList (
SelectListCfg,
SelectListItem,
SelectListMessage(..),
SelectListMakeRow,
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
type SelectListItem a = (Eq a, Show a, Typeable a)
type SelectListMakeRow s e a = a -> WidgetNode s e
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)
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)
selectList
:: (WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a)
=> ALens' s a
-> t a
-> SelectListMakeRow s e a
-> WidgetNode s e
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
selectList_
:: (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
-> 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
selectListV
:: (WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a)
=> a
-> (Int -> a -> e)
-> t a
-> SelectListMakeRow s e a
-> WidgetNode s e
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
selectListV_
:: (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
-> (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
selectListD_
:: (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
-> 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
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
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