{-# 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, 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, Proxy, cast, typeRep)
import TextShow
import qualified Data.Map as Map
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 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 {
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 = forall a. Maybe a
Nothing,
_slcItemStyle :: Maybe Style
_slcItemStyle = forall a. Maybe a
Nothing,
_slcItemSelectedStyle :: Maybe Style
_slcItemSelectedStyle = forall a. Maybe a
Nothing,
_slcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_slcMergeRequired = 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 = forall s e a. SelectListCfg s e a -> Maybe Bool
_slcSelectOnBlur SelectListCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. SelectListCfg s e a -> Maybe Bool
_slcSelectOnBlur SelectListCfg s e a
t1,
_slcItemStyle :: Maybe Style
_slcItemStyle = forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle SelectListCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle SelectListCfg s e a
t1,
_slcItemSelectedStyle :: Maybe Style
_slcItemSelectedStyle = forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemSelectedStyle SelectListCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 = forall s e a.
SelectListCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_slcMergeRequired SelectListCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 = forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnFocusReq SelectListCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnFocusReq SelectListCfg s e a
t2,
_slcOnBlurReq :: [Path -> WidgetRequest s e]
_slcOnBlurReq = forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnBlurReq SelectListCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. SelectListCfg s e a -> [Path -> WidgetRequest s e]
_slcOnBlurReq SelectListCfg s e a
t2,
_slcOnChangeReq :: [a -> WidgetRequest s e]
_slcOnChangeReq = forall s e a. SelectListCfg s e a -> [a -> WidgetRequest s e]
_slcOnChangeReq SelectListCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> 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 = forall s e a.
SelectListCfg s e a -> [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq SelectListCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> 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 = 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 = forall a. Default a => a
def {
_slcOnFocusReq :: [Path -> WidgetRequest s e]
_slcOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
_slcOnBlurReq :: [Path -> WidgetRequest s e]
_slcOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
_slcOnChangeReq :: [a -> WidgetRequest s e]
_slcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
_slcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_slcOnChangeIdxReq = [(forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = forall a. Default a => a
def {
_slcSelectOnBlur :: Maybe Bool
_slcSelectOnBlur = 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 = forall a. Default a => a
def {
_slcItemStyle :: Maybe Style
_slcItemStyle = 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 = forall a. Default a => a
def {
_slcItemSelectedStyle :: Maybe Style
_slcItemSelectedStyle = forall a. a -> Maybe a
Just Style
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 = forall a. Default a => a
def {
_slcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_slcMergeRequired = forall a. a -> Maybe a
Just WidgetEnv s e -> Seq a -> Seq a -> Bool
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
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
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
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
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 :: 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 = 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 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 = 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 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 = 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 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 = forall s a. a -> WidgetData s a
WidgetValue a
value
newConfigs :: [SelectListCfg s e a]
newConfigs = forall t e a. CmbOnChangeIdx t e a => (Int -> a -> e) -> t
onChangeIdx Int -> a -> e
handler forall a. a -> [a] -> [a]
: [SelectListCfg s e a]
configs
newNode :: WidgetNode s e
newNode = 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}. 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 = forall s e. WidgetType -> Widget s e -> WidgetNode s e
makeNode WidgetType
wtype Widget s e
widget where
config :: SelectListCfg s e a
config = forall a. Monoid a => [a] -> a
mconcat [SelectListCfg s e a]
configs
newItems :: Seq a
newItems = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Seq a -> a -> Seq a
(|>) forall a. Seq a
Empty t a
items
newState :: SelectListState a
newState = forall a. Seq a -> Int -> Int -> SelectListState a
SelectListState Seq a
newItems (-Int
1) Int
0
wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"selectList-" forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Text
showt (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall a. HasCallStack => a
undefined :: Proxy a)))
widget :: Widget s e
widget = 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 = forall s e. [ScrollCfg s e] -> WidgetNode s e -> WidgetNode s e
scroll_ [forall s e. ALens' ThemeState StyleState -> ScrollCfg s e
scrollStyle forall s a. HasSelectListStyle s a => Lens' s a
L.selectListStyle] WidgetNode s e
childNode where
childNode :: WidgetNode s e
childNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
wtype Widget s e
widget
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
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 = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer SelectListState a
state forall a. Default a => a
def {
containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
init,
containerInitPost :: ContainerInitPostHandler s e (SelectListState a)
containerInitPost = forall {p}.
WidgetEnv s e
-> p -> SelectListState a -> WidgetResult s e -> WidgetResult s e
initPost,
containerMergeChildrenReq :: ContainerMergeChildrenReqHandler s e (SelectListState a)
containerMergeChildrenReq = forall {p} {p}.
WidgetEnv s e -> p -> p -> SelectListState a -> Bool
mergeChildrenReq,
containerMerge :: ContainerMergeHandler s e (SelectListState a)
containerMerge = forall {p} {a}.
WidgetEnv s e
-> WidgetNode s e -> p -> SelectListState a -> WidgetResult s e
merge,
containerMergePost :: ContainerMergePostHandler s e (SelectListState a)
containerMergePost = forall {p} {p}.
WidgetEnv s e
-> p
-> p
-> SelectListState a
-> SelectListState a
-> WidgetResult s e
-> WidgetResult s e
mergePost,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = forall {p} {p}.
Typeable p =>
WidgetEnv s e
-> WidgetNode s e -> p -> p -> Maybe (WidgetResult s e)
handleMessage
}
currentValue :: WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv = forall s a. s -> WidgetData s a -> a
widgetDataGet (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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
selected :: a
selected = forall {e}. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
itemsList :: WidgetNode s e
itemsList = 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 = forall a. a -> Seq a
Seq.singleton WidgetNode s e
itemsList
init :: ContainerInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
selected :: a
selected = forall {e}. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
newSl :: Int
newSl = forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL a
selected Seq a
items)
newHl :: Int
newHl = if Int
newSl 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e 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
forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall {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 = 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 = forall a. SelectListState a -> Seq a
_prevItems SelectListState a
oldState
mergeRequiredFn :: WidgetEnv s e -> Seq a -> Seq a -> Bool
mergeRequiredFn = forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const forall a. Eq a => a -> 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 = 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 = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
selected :: a
selected = forall {e}. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
newSl :: Int
newSl = forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL a
selected Seq a
items)
newHl :: Int
newHl
| Int
newSl forall a. Eq a => a -> a -> Bool
/= forall a. SelectListState a -> Int
_slIdx SelectListState a
oldState = Int
newSl
| Bool
otherwise = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e 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
forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall {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 = 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 forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainButton s a => Lens' s a
L.mainButton -> Maybe (WidgetResult s e)
result where
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
SetFocus (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId)]
Focus Path
prev -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev (forall s e 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasKeys s a => Lens' s a
L.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at KeyCode
keyTab forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just KeyStatus
KeyPressed
changeReq :: Bool
changeReq = Bool
tabPressed Bool -> Bool -> Bool
&& forall s e a. SelectListCfg s e a -> Maybe Bool
_slcSelectOnBlur SelectListCfg s e a
config forall a. Eq a => a -> a -> 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 (forall a. SelectListState a -> Int
_hlIdx SelectListState a
state)
| Bool
otherwise = 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 forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> Seq a
Seq.fromList ((forall a b. (a -> b) -> a -> b
$ Path
next) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (WidgetRequest s e)
reqs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 = forall a. Maybe a
Nothing
KeyAction KeyMod
mode KeyCode
code KeyStatus
status
| KeyCode -> Bool
isKeyDown KeyCode
code Bool -> Bool -> Bool
&& KeyStatus
status 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 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 forall a. Eq a => a -> a -> Bool
== KeyStatus
KeyPressed -> Maybe (WidgetResult s e)
resultSelected
where
resultSelected :: Maybe (WidgetResult s e)
resultSelected = forall a. a -> Maybe a
Just 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 (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
_ -> 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 = forall a. SelectListState a -> Int
_hlIdx SelectListState a
state
nextIdx :: Int
nextIdx
| Int
tempIdx forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
items forall a. Num a => a -> a -> a
- Int
1 = Int
tempIdx 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 = forall a. SelectListState a -> Int
_hlIdx SelectListState a
state
nextIdx :: Int
nextIdx
| Int
tempIdx forall a. Ord a => a -> a -> Bool
> Int
0 = Int
tempIdx 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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectListMessage -> WidgetResult s e
handleSelect (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 = forall s e. WidgetId -> WidgetRequest s e
SetFocus forall a b. (a -> b) -> a -> b
$ WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. 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
| 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 forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
|> 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 = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs where
reqs :: [WidgetRequest s e]
reqs = 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 (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 = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e 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 = forall a. SelectListState a -> Int
_slIdx SelectListState a
state
(WidgetNode s e
newNode, [WidgetRequest s e]
resizeReq) = 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 = 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 forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
resizeReq
result :: WidgetResult s e
result = 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 = forall {e}. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
value :: a
value = forall a. a -> Maybe a -> a
fromMaybe a
selected (forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq a
items)
valueSetReq :: [WidgetRequest s e]
valueSetReq = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
widgetData a
value
scrollToReq :: [WidgetRequest s e]
scrollToReq = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
value) (forall s e a. SelectListCfg s e a -> [a -> WidgetRequest s e]
_slcOnChangeReq SelectListCfg s e a
config)
forall a. [a] -> [a] -> [a]
++ 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) (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) = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e 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 = forall {e}. [WidgetRequest s e]
valueSetReq forall a. [a] -> [a] -> [a]
++ forall {s} {e}. [WidgetRequest s e]
scrollToReq forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
changeReqs forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
resizeReq
result :: WidgetResult s e
result = 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 = forall a. Maybe a -> [a]
maybeToList (forall {s} {e}. WidgetId -> Rect -> WidgetRequest s e
scrollToReq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe WidgetId
mwid forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Rect
vp) where
vp :: Maybe Rect
vp = 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 = forall s e. WidgetEnv s e -> Path -> Maybe WidgetId
widgetIdFromPath WidgetEnv s e
wenv (forall s e. WidgetNode s e -> Path
parentPath WidgetNode s e
node)
scrollToReq :: WidgetId -> Rect -> WidgetRequest s e
scrollToReq WidgetId
wid Rect
rect = 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 = forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx (s
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children)
viewport :: Maybe Rect
viewport = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WidgetNodeInfo -> Rect
_wniViewport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure p
node
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {s} {a}. HasChildren s (Seq a) => Int -> s -> Maybe a
lookup Int
0
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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, forall {s} {e}. [WidgetRequest s e]
newReqs) where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
items :: Seq (WidgetNode s e)
items = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Seq (WidgetNode s e))
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasChildren s a => Lens' s a
L.children
normalStyle :: Style
normalStyle = 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 forall a. Eq a => a -> a -> Bool
== Int
newHlIdx
(Style
slStyle, Style
hlStyle)
| Bool
idxMatch = (forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getSlHlStyle WidgetEnv s e
wenv SelectListCfg s e a
config, forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getSlHlStyle WidgetEnv s e
wenv SelectListCfg s e a
config)
| Bool
otherwise = (forall s e a. WidgetEnv s e -> SelectListCfg s e a -> Style
getSlStyle WidgetEnv s e
wenv SelectListCfg s e a
config, 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)
forall a b. a -> (a -> b) -> b
& forall s e.
WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
updateItemStyle WidgetEnv s e
wenv (forall a. SelectListState a -> Int
_slIdx SelectListState a
state) (forall a. a -> Maybe a
Just Style
normalStyle)
forall a b. a -> (a -> b) -> b
& forall s e.
WidgetEnv s e
-> Int
-> Maybe Style
-> (Seq (WidgetNode s e), Bool)
-> (Seq (WidgetNode s e), Bool)
updateItemStyle WidgetEnv s e
wenv (forall a. SelectListState a -> Int
_hlIdx SelectListState a
state) (forall a. a -> Maybe a
Just Style
normalStyle)
forall a b. a -> (a -> b) -> b
& 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 (forall a. a -> Maybe a
Just Style
hlStyle)
forall a b. a -> (a -> b) -> b
& 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 (forall a. a -> Maybe a
Just Style
slStyle)
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Seq (WidgetNode s e))
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetNode s e)
newChildren
newReqs :: [WidgetRequest s e]
newReqs = [ 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 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 = 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) = 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 = 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
itemforall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW, WidgetNode s e
itemforall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)
(SizeReq
newReqW, SizeReq
newReqH) = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
widgetGetSizeReq (WidgetNode s e
item forall s a. s -> Getting a s a -> a
^. 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
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqW
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqH
resizeReq :: Bool
resizeReq = (SizeReq
oldReqW, SizeReq
oldReqH) 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
forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Seq (WidgetNode s e))
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style 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 = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasSelectListItemSelectedStyle s a => Lens' s a
L.selectListItemSelectedStyle
style :: Style
style = forall a. HasCallStack => Maybe a -> a
fromJust (forall a. a -> Maybe a
Just Style
theme forall a. Semigroup a => a -> a -> a
<> forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemSelectedStyle SelectListCfg s e a
config)
slStyle :: Style
slStyle = Style
style
forall a b. a -> (a -> b) -> b
& forall s a. HasBasic s a => Lens' s a
L.basic forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style forall s a. s -> Getting a s a -> a
^. forall s a. HasFocus s a => Lens' s a
L.focus
forall a b. a -> (a -> b) -> b
& forall s a. HasHover s a => Lens' s a
L.hover forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style forall s a. s -> Getting a s a -> a
^. forall s a. HasFocusHover s a => Lens' s a
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 = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasBasic s a => Lens' s a
L.basic forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style forall s a. s -> Getting a s a -> a
^. forall s a. HasFocus s a => Lens' s a
L.focus
forall a b. a -> (a -> b) -> b
& forall s a. HasHover s a => Lens' s a
L.hover forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style forall s a. s -> Getting a s a -> a
^. forall s a. HasFocusHover s a => Lens' s a
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 = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasSelectListItemStyle s a => Lens' s a
L.selectListItemStyle
style :: Style
style = forall a. HasCallStack => Maybe a -> a
fromJust (forall a. a -> Maybe a
Just Style
theme forall a. Semigroup a => a -> a -> a
<> forall s e a. SelectListCfg s e a -> Maybe Style
_slcItemStyle SelectListCfg s e a
config)
hlStyle :: Style
hlStyle = Style
style
forall a b. a -> (a -> b) -> b
& forall s a. HasBasic s a => Lens' s a
L.basic forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style forall s a. s -> Getting a s a -> a
^. forall s a. HasFocus s a => Lens' s a
L.focus
forall a b. a -> (a -> b) -> b
& forall s a. HasHover s a => Lens' s a
L.hover forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
style forall s a. s -> Getting a s a -> a
^. forall s a. HasFocusHover s a => Lens' s a
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 = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasSelectListItemStyle s a => Lens' s a
L.selectListItemStyle
style :: Style
style = forall a. HasCallStack => Maybe a -> a
fromJust (forall a. a -> Maybe a
Just Style
theme forall a. Semigroup a => a -> a -> a
<> 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 = forall a. SelectListState a -> Int
_slIdx SelectListState a
newState
hlIdx :: Int
hlIdx = 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) = 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 = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq (WidgetRequest s e)
prevReqs forall a. Semigroup a => a -> a -> a
<> 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 = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasSelectListItemStyle s a => Lens' s a
L.selectListItemStyle
normalStyle :: Style
normalStyle = forall a. HasCallStack => Maybe a -> a
fromJust (forall a. a -> Maybe a
Just Style
normalTheme forall a. Semigroup a => a -> a -> a
<> 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 = forall t s e. CmbOnClickReq t s e => WidgetRequest s e -> t
onClickReq forall a b. (a -> b) -> a -> b
$ forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
widgetId (Int -> SelectListMessage
SelectListClickItem Int
idx)
itemCfg :: [BoxCfg s e]
itemCfg = [forall s e. BoxCfg s e
expandContent, BoxCfg s e
clickCfg]
content :: WidgetNode s e
content = SelectListMakeRow s e a
makeRow a
item
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
normalStyle
newItem :: WidgetNode s e
newItem = 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 = forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
vstack forall a b. (a -> b) -> a -> b
$ forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> SelectListMakeRow s e a
makeItem Seq a
items