{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Monomer.Widgets.Containers.SelectList (
SelectListCfg,
SelectListItem,
SelectListMessage(..),
SelectListMakeRow,
selectList,
selectList_,
selectListV,
selectListV_,
selectListD_
) where
import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (.~), (%~), at, ix)
import Data.Default
import Data.List (foldl')
import Data.Maybe
import Data.Sequence (Seq(..), (|>))
import Data.Typeable (Typeable, Proxy, cast, typeRep)
import TextShow
import qualified Data.Sequence as Seq
import Monomer.Widgets.Container
import Monomer.Widgets.Containers.Box
import Monomer.Widgets.Containers.Scroll
import Monomer.Widgets.Containers.Stack
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 {
forall s e a. SelectListCfg s e a -> Maybe Bool
_slcSelectOnBlur :: Maybe Bool,
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle :: Maybe Style,
forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemSelectedStyle :: Maybe Style,
forall s e a.
SelectListCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_slcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool),
forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnFocusReq :: [Path -> WidgetRequest s e],
forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnBlurReq :: [Path -> WidgetRequest s e],
forall s e a. SelectListCfg s e a -> [a -> WidgetRequest s e]
_slcOnChangeReq :: [a -> WidgetRequest s e],
forall s e a.
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 {
_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 (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_slcMergeRequired = Maybe (WidgetEnv s e -> 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 {
_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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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 (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_slcMergeRequired = SelectListCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall s e a.
SelectListCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_slcMergeRequired SelectListCfg s e a
t2 Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SelectListCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall s e a.
SelectListCfg s e a
-> Maybe (WidgetEnv s e -> 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 = [RaiseEvent . 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 = [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 = [RaiseEvent . 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 = [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 = [RaiseEvent . 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 = [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 = [(RaiseEvent .) . 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 = [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 = Just 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 = Just 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 = Just style
}
instance CmbMergeRequired (SelectListCfg s e a) (WidgetEnv s e) (Seq a) where
mergeRequired :: (WidgetEnv s e -> Seq a -> Seq a -> Bool) -> SelectListCfg s e a
mergeRequired WidgetEnv s e -> Seq a -> Seq a -> Bool
fn = SelectListCfg s e a
forall a. Default a => a
def {
_slcMergeRequired = Just fn
}
data SelectListState a = SelectListState {
forall a. SelectListState a -> Seq a
_prevItems :: Seq a,
forall a. SelectListState a -> Int
_slIdx :: Int,
forall a. 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
$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
/= :: 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
$cshowsPrec :: forall a. Show a => Int -> SelectListState a -> ShowS
showsPrec :: Int -> SelectListState a -> ShowS
$cshow :: forall a. Show a => SelectListState a -> String
show :: SelectListState a -> String
$cshowList :: forall a. Show a => [SelectListState a] -> ShowS
showList :: [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
$c== :: SelectListMessage -> SelectListMessage -> Bool
== :: SelectListMessage -> SelectListMessage -> Bool
$c/= :: SelectListMessage -> SelectListMessage -> Bool
/= :: 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
$cshowsPrec :: Int -> SelectListMessage -> ShowS
showsPrec :: Int -> SelectListMessage -> ShowS
$cshow :: SelectListMessage -> String
show :: SelectListMessage -> String
$cshowList :: [SelectListMessage] -> ShowS
showList :: [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 :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a) =>
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_ :: 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]
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 :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a) =>
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_ :: 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]
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_
:: 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_ :: 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
widgetData t a
items SelectListMakeRow s e a
makeRow [SelectListCfg s e a]
configs = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
makeNode WidgetType
wtype 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 b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
(|>) Seq a
forall a. Seq a
Empty t a
items
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
wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"selectList-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. TextShow a => a -> Text
showt (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall a. HasCallStack => a
undefined :: Proxy a)))
widget :: Widget s e
widget = WidgetData s a
-> Seq a
-> 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 :: WidgetType -> Widget s e -> WidgetNode s e
makeNode :: forall s e. WidgetType -> Widget s e -> WidgetNode s e
makeNode WidgetType
wtype 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
Lens' ThemeState StyleState
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
wtype Widget s e
widget
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
Lens' WidgetNodeInfo Bool
L.focusable ((Bool -> Identity Bool)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
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 :: 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
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 (SelectListState a)
forall a. Default a => a
def {
containerInit = init,
containerInitPost = initPost,
containerMergeChildrenReq = mergeChildrenReq,
containerMerge = merge,
containerMergePost = mergePost,
containerHandleEvent = handleEvent,
containerHandleMessage = 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 -> p -> Seq (WidgetNode s e)
createSelectListChildren WidgetEnv s e
wenv p
node = Seq (WidgetNode s e)
children where
widgetId :: WidgetId
widgetId = p
node p -> Getting WidgetId p WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (a -> Const WidgetId a) -> p -> Const WidgetId p
forall s a. HasInfo s a => Lens' s a
Lens' p a
L.info ((a -> Const WidgetId a) -> p -> Const WidgetId p)
-> ((WidgetId -> Const WidgetId WidgetId) -> a -> Const WidgetId a)
-> Getting WidgetId p 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
Lens' a WidgetId
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 :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
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 = newSl,
_hlIdx = 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
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> Seq a
-> 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
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s e -> WidgetNode s e -> Seq (WidgetNode s e)
forall {p} {a}.
(HasInfo p a, HasWidgetId a WidgetId) =>
WidgetEnv s e -> p -> 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 :: WidgetEnv s e -> p -> p -> SelectListState a -> Bool
mergeChildrenReq WidgetEnv s e
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
isReload :: Bool
isReload = WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isWidgetReload WidgetEnv s e
wenv
mergeRequiredFn :: WidgetEnv s e -> Seq a -> Seq a -> Bool
mergeRequiredFn = (WidgetEnv s e -> Seq a -> Seq a -> Bool)
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
-> WidgetEnv s e
-> Seq a
-> Seq a
-> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Seq a -> Seq a -> Bool) -> WidgetEnv s e -> Seq a -> Seq a -> Bool
forall a b. a -> b -> a
const Seq a -> Seq a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) (SelectListCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
forall s e a.
SelectListCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_slcMergeRequired SelectListCfg s e a
config)
result :: Bool
result = Bool
isReload Bool -> Bool -> Bool
|| WidgetEnv s e -> Seq a -> Seq a -> Bool
mergeRequiredFn WidgetEnv s e
wenv 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 = newSl,
_hlIdx = newHl,
_prevItems = 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
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> Seq a
-> 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
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s e -> WidgetNode s e -> Seq (WidgetNode s e)
forall {p} {a}.
(HasInfo p a, HasWidgetId a WidgetId) =>
WidgetEnv s e -> p -> 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
Lens' (WidgetEnv s e) Button
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
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId)]
Click Point
point Button
_ Int
_
| Point -> Bool
outsideVp Point
point -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
ignoreEvtResult
Move Point
point
| Point -> Bool
outsideVp Point
point -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
ignoreEvtResult
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
Lens' (WidgetEnv s e) InputStatus
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
Lens' InputStatus (Map KeyCode KeyStatus)
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 a. Seq a -> 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
where
outsideVp :: Point -> Bool
outsideVp Point
point = Bool -> Bool
not (Point -> Rect -> Bool
pointInRect Point
point (WidgetEnv s e
wenv WidgetEnv s e -> Getting Rect (WidgetEnv s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. Getting Rect (WidgetEnv s e) Rect
forall s a. HasViewport s a => Lens' s a
Lens' (WidgetEnv s e) Rect
L.viewport))
ignoreEvtResult :: WidgetResult s e
ignoreEvtResult = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreChildrenEvents]
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 a. 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 -> p -> Maybe (WidgetResult s e)
handleMessage WidgetEnv s e
wenv WidgetNode s e
node p
target p
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 = WidgetEnv s e -> WidgetNode s e -> WidgetResult 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectListMessage -> WidgetResult s e
handleSelect (p -> Maybe SelectListMessage
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
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
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
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
Lens' (WidgetResult s e) (Seq (WidgetRequest s e))
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetRequest s e
forall s e. WidgetRequest s e
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 = 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
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> Seq a
-> 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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> WidgetRequest s e) -> a -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ a
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int -> a -> WidgetRequest s e
fn -> Int -> a -> WidgetRequest s e
fn Int
idx a
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 = idx,
_hlIdx = 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
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> Seq a
-> 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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 {p} {a} {s} {e}.
(HasChildren p (Seq a), HasChildren a (Seq (WidgetNode s e))) =>
p -> 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
widgetIdFromPath 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 :: p -> Int -> Maybe Rect
itemViewport p
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
Lens' s (Seq a)
L.children)
viewport :: Maybe Rect
viewport = (WidgetNode s e -> Rect) -> Maybe (WidgetNode s e) -> Maybe Rect
forall a b. (a -> b) -> Maybe a -> Maybe b
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
$ p -> Maybe p
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure p
node
Maybe p -> (p -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> p -> Maybe a
forall {s} {a}. HasChildren s (Seq a) => Int -> s -> Maybe a
lookup Int
0
Maybe a -> (a -> Maybe (WidgetNode s e)) -> Maybe (WidgetNode s e)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> a -> 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 :: 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
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
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
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
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
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 ((IxValue (Seq (WidgetNode s e))
-> Const (Seq (WidgetNode s e)) (IxValue (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)))
-> IxValue (Seq (WidgetNode s e))
-> Const (Seq (WidgetNode s e)) (IxValue (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
. (Seq (WidgetNode s e)
-> Const (Seq (WidgetNode s e)) (Seq (WidgetNode s e)))
-> IxValue (Seq (WidgetNode s e))
-> Const (Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall s a. HasChildren s a => Lens' s a
Lens' (IxValue (Seq (WidgetNode s e))) (Seq (WidgetNode s e))
L.children
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
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Seq (WidgetNode s e) -> 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 ((IxValue (Seq (WidgetNode s e))
-> Identity (IxValue (Seq (WidgetNode s e))))
-> Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> IxValue (Seq (WidgetNode s e))
-> Identity (IxValue (Seq (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)))
-> IxValue (Seq (WidgetNode s e))
-> Identity (IxValue (Seq (WidgetNode s e)))
forall s a. HasChildren s a => Lens' s a
Lens' (IxValue (Seq (WidgetNode s e))) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e) -> 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 :: 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
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 :: forall s e.
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
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqW, 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
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqH)
(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
Lens' (WidgetNode s e) (Widget s e)
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
Lens' (WidgetNode s e) WidgetNodeInfo
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
Lens' WidgetNodeInfo SizeReq
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
Lens' (WidgetNode s e) WidgetNodeInfo
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
Lens' WidgetNodeInfo SizeReq
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 :: forall s e. 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
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((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 ((IxValue (Seq (WidgetNode s e))
-> Identity (IxValue (Seq (WidgetNode s e))))
-> Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> ((Style -> Identity Style)
-> IxValue (Seq (WidgetNode s e))
-> Identity (IxValue (Seq (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)
-> IxValue (Seq (WidgetNode s e))
-> Identity (IxValue (Seq (WidgetNode s e)))
forall s a. HasInfo s a => Lens' s a
Lens' (IxValue (Seq (WidgetNode s e))) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> IxValue (Seq (WidgetNode s e))
-> Identity (IxValue (Seq (WidgetNode s e))))
-> ((Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> IxValue (Seq (WidgetNode s e))
-> Identity (IxValue (Seq (WidgetNode s e)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
Lens' WidgetNodeInfo Style
L.style ((Style -> Identity Style)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
st
getSlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getSlStyle :: forall s e a. 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 (StyleState -> f StyleState) -> ThemeState -> f ThemeState
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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
L.focusHover
getSlHlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getSlHlStyle :: forall s e a. 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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
L.focusHover
getHlStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getHlStyle :: forall s e a. 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 (StyleState -> f StyleState) -> ThemeState -> f ThemeState
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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
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
Lens' Style (Maybe StyleState)
L.focusHover
getNormalStyle :: WidgetEnv s e -> SelectListCfg s e a -> Style
getNormalStyle :: forall s e a. 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 (StyleState -> f StyleState) -> ThemeState -> f ThemeState
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 :: 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 = 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
WidgetResult WidgetNode s e
prevNode Seq (WidgetRequest s e)
prevReqs = WidgetResult s e
result
(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
prevNode Int
slIdx Int
hlIdx
newResult :: WidgetResult s e
newResult = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode
WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
Lens' (WidgetResult s e) (Seq (WidgetRequest s e))
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetRequest s e)
prevReqs 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 [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 :: 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 = 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 (StyleState -> f StyleState) -> ThemeState -> f ThemeState
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
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
Lens' WidgetNodeInfo Style
L.style ((Style -> Identity Style)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
normalStyle
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
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