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

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

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

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

customDropdown = dropdown userLens usernames makeSelected makeRow
@

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

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

import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (^?), (^?!), (.~), (%~), (<>~), _Just, ix, non)
import Control.Monad
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 GHC.Generics
import TextShow

import qualified Data.Sequence as Seq

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

import qualified Monomer.Lens as L

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

{-|
Configuration options for dropdown:

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

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

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

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

instance WidgetEvent e => CmbOnFocus (DropdownCfg s e a) e Path where
  onFocus :: (Path -> e) -> DropdownCfg s e a
onFocus Path -> e
fn = forall a. Default a => a
def {
    _ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = [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 (DropdownCfg s e a) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> DropdownCfg s e a
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (DropdownCfg s e a) e Path where
  onBlur :: (Path -> e) -> DropdownCfg s e a
onBlur Path -> e
fn = forall a. Default a => a
def {
    _ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = [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 (DropdownCfg s e a) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> DropdownCfg s e a
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnChange (DropdownCfg s e a) a e where
  onChange :: (a -> e) -> DropdownCfg s e a
onChange a -> e
fn = forall a. Default a => a
def {
    _ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = [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 (DropdownCfg s e a) s e a where
  onChangeReq :: (a -> WidgetRequest s e) -> DropdownCfg s e a
onChangeReq a -> WidgetRequest s e
req = forall a. Default a => a
def {
    _ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = [a -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnChangeIdx (DropdownCfg s e a) e a where
  onChangeIdx :: (Int -> a -> e) -> DropdownCfg s e a
onChangeIdx Int -> a -> e
fn = forall a. Default a => a
def {
    _ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = [(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 (DropdownCfg s e a) s e a where
  onChangeIdxReq :: (Int -> a -> WidgetRequest s e) -> DropdownCfg s e a
onChangeIdxReq Int -> a -> WidgetRequest s e
req = forall a. Default a => a
def {
    _ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = [Int -> a -> WidgetRequest s e
req]
  }

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

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

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

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

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

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

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

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

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

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

-- | Creates a dropdown providing a WidgetData instance and config.
dropdownD_
  :: forall s e t a . (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
  => WidgetData s a         -- ^ The 'WidgetData' to retrieve the value from.
  -> t a                    -- ^ The list of selectable items.
  -> (a -> WidgetNode s e)  -- ^ Function to create the header (always visible).
  -> (a -> WidgetNode s e)  -- ^ Function to create the list (collapsable).
  -> [DropdownCfg s e a]    -- ^ The config options.
  -> WidgetNode s e         -- ^ The created dropdown.
dropdownD_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownD_ WidgetData s a
widgetData t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  config :: DropdownCfg s e a
config = forall a. Monoid a => [a] -> a
mconcat [DropdownCfg s e a]
configs
  newState :: DropdownState
newState = Bool -> Point -> DropdownState
DropdownState Bool
False forall a. Default a => a
def
  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
  wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"dropdown-" 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, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
newItems a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
  newNode :: WidgetNode s e
newNode = 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

makeDropdown
  :: forall s e a. (WidgetModel s, WidgetEvent e, DropdownItem a)
  => WidgetData s a
  -> Seq a
  -> (a -> WidgetNode s e)
  -> (a -> WidgetNode s e)
  -> DropdownCfg s e a
  -> DropdownState
  -> Widget s e
makeDropdown :: forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
state = Widget s e
widget where
  container :: Container s e DropdownState
container = forall a. Default a => a
def {
    containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
    containerChildrenOffset :: Maybe Point
containerChildrenOffset = forall a. a -> Maybe a
Just (DropdownState -> Point
_ddsOffset DropdownState
state),
    containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = forall {s} {e} {p}. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
    containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
init,
    containerFindNextFocus :: ContainerFindNextFocusHandler s e
containerFindNextFocus = forall {s} {a} {p} {p} {p}.
HasChildren s (Seq a) =>
p -> s -> p -> p -> Seq a
findNextFocus,
    containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = forall {p} {s} {e} {p} {p}.
HasChildren p (Seq (WidgetNode s e)) =>
p -> p -> p -> Point -> Maybe Int
findByPoint,
    containerMerge :: ContainerMergeHandler s e DropdownState
containerMerge = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> DropdownState -> WidgetResult s e
merge,
    containerDispose :: ContainerInitHandler s e
containerDispose = forall {p} {s} {e}. p -> WidgetNode s e -> WidgetResult s e
dispose,
    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 {a} {p}.
Typeable a =>
WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = forall {s} {e} {p}.
WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize
  }
  baseWidget :: Widget s e
baseWidget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer DropdownState
state Container s e DropdownState
container
  widget :: Widget s e
widget = Widget s e
baseWidget {
    widgetRender :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender = WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
  }

  mainIdx :: Int
mainIdx = Int
0
  listIdx :: Int
listIdx = Int
1
  isOpen :: Bool
isOpen = DropdownState -> Bool
_ddsOpen DropdownState
state
  currentValue :: WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv = 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

  createDropdown :: WidgetEnv s e -> WidgetNode s e -> DropdownState -> WidgetNode s e
createDropdown WidgetEnv s e
wenv WidgetNode s e
node DropdownState
newState = WidgetNode s e
newNode where
    selected :: a
selected = forall {e}. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
    nodeStyle :: Style
nodeStyle = forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasStyle s a => Lens' s a
L.style
    mainNode :: WidgetNode s e
mainNode = a -> WidgetNode s e
makeMain a
selected
      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
nodeStyle
    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
    selectListNode :: WidgetNode s e
selectListNode = forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
makeSelectList WidgetEnv s e
wenv WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeRow DropdownCfg s e a
config WidgetId
widgetId
    newWidget :: Widget s e
newWidget = forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      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
.~ Widget s e
newWidget
      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 a. [a] -> Seq a
Seq.fromList [WidgetNode s e
mainNode, WidgetNode s e
selectListNode]

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

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

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

  dispose :: p -> WidgetNode s e -> WidgetResult s e
dispose p
wenv WidgetNode s e
node = 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
    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
    reqs :: [WidgetRequest s e]
reqs = [ forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
widgetId | Bool
isOpen ]

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

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

  ddFocusChange :: WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
prev [Path -> WidgetRequest s e]
reqs = forall a. a -> Maybe a
Just WidgetResult s e
newResult where
    tmpResult :: Maybe (WidgetResult s e)
tmpResult = forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev [Path -> WidgetRequest s e]
reqs
    newResult :: WidgetResult s e
newResult = forall a. a -> Maybe a -> a
fromMaybe (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) Maybe (WidgetResult s e)
tmpResult
      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
IgnoreChildrenEvents)

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

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

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

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

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

    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 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isOpen -> 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)]

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

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

    SystemEvent
_
      | Bool -> Bool
not Bool
isOpen -> 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. WidgetRequest s e
IgnoreChildrenEvents]
      | Bool
otherwise -> forall a. Maybe a
Nothing
    where
      style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      widgetId :: WidgetId
widgetId = WidgetNode s e
node 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
      path :: Path
path = 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. HasPath s a => Lens' s a
L.path
      focusedPath :: Path
focusedPath = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath
      overlayPath :: Maybe Path
overlayPath = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath

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

  openRequired :: Point -> p -> Bool
openRequired Point
point p
node = Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& Bool
inViewport where
    inViewport :: Bool
inViewport = Point -> Rect -> Bool
pointInRect Point
point (p
node 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. HasViewport s a => Lens' s a
L.viewport)

  closeRequired :: Point -> p -> Bool
closeRequired Point
point p
node = Bool
isOpen Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inOverlay where
    offset :: Point
offset = DropdownState -> Point
_ddsOffset DropdownState
state
    listNode :: a
listNode = forall a. Seq a -> Int -> a
Seq.index (p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
listIdx
    listVp :: Rect
listVp = Point -> Rect -> Rect
moveRect Point
offset (a
listNode 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. HasViewport s a => Lens' s a
L.viewport)
    inOverlay :: Bool
inOverlay = Point -> Rect -> Bool
pointInRect Point
point Rect
listVp

  openDropdown :: ContainerInitHandler s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
requests where
    newState :: DropdownState
newState = DropdownState
state {
      _ddsOpen :: Bool
_ddsOpen = Bool
True,
      _ddsOffset :: Point
_ddsOffset = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> Point
listOffset WidgetEnv s e
wenv WidgetNode s e
node
    }
    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, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
    -- selectList is wrapped by a scroll widget
    (WidgetId
slWid, Path
slPath) = WidgetNode s e -> (WidgetId, Path)
scrollListInfo WidgetNode s e
node
    (WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node
    scrollMsg :: WidgetRequest s e
scrollMsg = forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
listWid SelectListMessage
SelectListShowSelected
    requests :: [WidgetRequest s e]
requests = [forall s e. WidgetId -> Path -> WidgetRequest s e
SetOverlay WidgetId
slWid Path
slPath, forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
listWid, forall s e. WidgetRequest s e
scrollMsg]

  closeDropdown :: p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
requests 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
    (WidgetId
slWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
scrollListInfo WidgetNode s e
node
    (WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node
    newState :: DropdownState
newState = DropdownState
state {
      _ddsOpen :: Bool
_ddsOpen = Bool
False,
      _ddsOffset :: Point
_ddsOffset = forall a. Default a => a
def
    }
    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, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
    requests :: [WidgetRequest s e]
requests = [forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
slWid, forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId]

  scrollListInfo :: WidgetNode s e -> (WidgetId, Path)
  scrollListInfo :: WidgetNode s e -> (WidgetId, Path)
scrollListInfo WidgetNode s e
node = (WidgetNodeInfo
scrollInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId, WidgetNodeInfo
scrollInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) where
    scrollInfo :: WidgetNodeInfo
scrollInfo = WidgetNode s e
node forall s a. HasCallStack => s -> Getting (Endo 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 Int
listIdx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info

  selectListInfo :: WidgetNode s e -> (WidgetId, Path)
  selectListInfo :: WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node = (WidgetNodeInfo
listInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId, WidgetNodeInfo
listInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) where
    listInfo :: WidgetNodeInfo
listInfo = WidgetNode s e
node forall s a. HasCallStack => s -> Getting (Endo 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 Int
listIdx forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

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

  handleLvMsg :: WidgetEnv s e
-> WidgetNode s e -> DropdownMessage -> Maybe (WidgetResult s e)
handleLvMsg WidgetEnv s e
wenv WidgetNode s e
node (OnChangeMessage Int
idx a
_) =
    forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq a
items forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
value -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {p}. p -> WidgetNode s e -> Int -> a -> WidgetResult s e
onChange WidgetEnv s e
wenv WidgetNode s e
node Int
idx a
value
  handleLvMsg WidgetEnv s e
wenv WidgetNode s e
node DropdownMessage
OnListBlur = forall a. a -> Maybe a
Just WidgetResult s e
result where
    tempResult :: WidgetResult s e
tempResult = forall {p}. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
    result :: WidgetResult s e
result = WidgetResult s e
tempResult 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. WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq WidgetEnv s e
wenv)

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

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

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

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

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

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    Renderer -> Bool -> Rect -> IO () -> IO ()
drawInScissor Renderer
renderer Bool
True Rect
viewport forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction Renderer
renderer Rect
viewport StyleState
style forall a b. (a -> b) -> a -> b
$ \Rect
contentArea -> do
        forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
mainNode 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
mainNode Renderer
renderer
        Renderer -> StyleState -> Rect -> IO ()
renderArrow Renderer
renderer StyleState
style Rect
contentArea

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

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

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

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

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

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

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

createMoveFocusReq :: WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq :: forall s e. WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq WidgetEnv s e
wenv = forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus forall a. Maybe a
Nothing FocusDirection
direction where
  direction :: FocusDirection
direction
    | 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. HasKeyMod s a => Lens' s a
L.keyMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasLeftShift s a => Lens' s a
L.leftShift = FocusDirection
FocusBwd
    | Bool
otherwise = FocusDirection
FocusFwd