{-|
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 is customizable, and so is its styling. In case
only 'Text' content is needed, 'Monomer.Widgets.Singles.TextDropdown' is easier
to use.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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 (cast)
import GHC.Generics

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.
-}
data DropdownCfg s e a = DropdownCfg {
  DropdownCfg s e a -> Maybe Double
_ddcMaxHeight :: Maybe Double,
  DropdownCfg s e a -> Maybe Style
_ddcItemStyle :: Maybe Style,
  DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle :: Maybe Style,
  DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq :: [Path -> WidgetRequest s e],
  DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq :: [Path -> WidgetRequest s e],
  DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq :: [a -> WidgetRequest s e],
  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 :: forall s e a.
Maybe Double
-> Maybe Style
-> Maybe Style
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> DropdownCfg s e a
DropdownCfg {
    _ddcMaxHeight :: Maybe Double
_ddcMaxHeight = Maybe Double
forall a. Maybe a
Nothing,
    _ddcItemStyle :: Maybe Style
_ddcItemStyle = Maybe Style
forall a. Maybe a
Nothing,
    _ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = Maybe Style
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 :: forall s e a.
Maybe Double
-> Maybe Style
-> Maybe Style
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> DropdownCfg s e a
DropdownCfg {
    _ddcMaxHeight :: Maybe Double
_ddcMaxHeight = DropdownCfg s e a -> Maybe Double
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Double
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
t1,
    _ddcItemStyle :: Maybe Style
_ddcItemStyle = DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
t2 Maybe Style -> Maybe Style -> Maybe Style
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
t1,
    _ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
t2 Maybe Style -> Maybe Style -> Maybe Style
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
t1,
    _ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
t2,
    _ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
t2,
    _ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = DropdownCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
t1 [a -> WidgetRequest s e]
-> [a -> WidgetRequest s e] -> [a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [a -> WidgetRequest s e]
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 = DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
t1 [Int -> a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
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 = DropdownCfg s e a
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 = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

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

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

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

instance CmbOnChangeIdxReq (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 = DropdownCfg s e a
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 = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcMaxHeight :: Maybe Double
_ddcMaxHeight = Double -> Maybe Double
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 = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcItemStyle :: Maybe Style
_ddcItemStyle = Style -> Maybe Style
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 = DropdownCfg s e a
forall a. Default a => a
def {
    _ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style
  }

data DropdownState = DropdownState {
  DropdownState -> Bool
_ddsOpen :: Bool,
  DropdownState -> Point
_ddsOffset :: Point
} deriving (DropdownState -> DropdownState -> Bool
(DropdownState -> DropdownState -> Bool)
-> (DropdownState -> DropdownState -> Bool) -> Eq DropdownState
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
(Int -> DropdownState -> ShowS)
-> (DropdownState -> String)
-> ([DropdownState] -> ShowS)
-> Show DropdownState
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. DropdownState -> Rep DropdownState x)
-> (forall x. Rep DropdownState x -> DropdownState)
-> Generic DropdownState
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 :: 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 = ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
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]
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_ :: 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 = ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field
  newNode :: WidgetNode s e
newNode = WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
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 :: 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 = a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
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]
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_ :: 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 = (Int -> a -> e) -> DropdownCfg s e a
forall t e a. CmbOnChangeIdx t e a => (Int -> a -> e) -> t
onChangeIdx Int -> a -> e
handler DropdownCfg s e a -> [DropdownCfg s e a] -> [DropdownCfg s e a]
forall a. a -> [a] -> [a]
: [DropdownCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
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_ (a -> WidgetData s a
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_
  :: (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_ :: 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 = Widget s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e
makeNode Widget s e
widget where
  config :: DropdownCfg s e a
config = [DropdownCfg s e a] -> DropdownCfg s e a
forall a. Monoid a => [a] -> a
mconcat [DropdownCfg s e a]
configs
  newState :: DropdownState
newState = Bool -> Point -> DropdownState
DropdownState Bool
False Point
forall a. Default a => a
def
  newItems :: Seq a
newItems = (Seq a -> a -> Seq a) -> Seq a -> t a -> Seq a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
(|>) Seq a
forall a. Seq a
Empty t a
items
  widget :: Widget s e
widget = WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
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

makeNode :: Widget s e -> WidgetNode s e
makeNode :: Widget s e -> WidgetNode s e
makeNode Widget s e
widget = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"dropdown" Widget s e
widget
  WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

makeDropdown
  :: (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
-> 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 = Container s e DropdownState
forall a. Default a => a
def {
    containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
    containerChildrenOffset :: Maybe Point
containerChildrenOffset = Point -> Maybe Point
forall a. a -> Maybe a
Just (DropdownState -> Point
_ddsOffset DropdownState
state),
    containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = ContainerGetBaseStyle s e
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 = ContainerFindNextFocusHandler s e
forall s a p p p.
HasChildren s (Seq a) =>
p -> s -> p -> p -> Seq a
findNextFocus,
    containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = ContainerFindByPointHandler s e
forall s s e p p.
HasChildren s (Seq (WidgetNode s e)) =>
p -> s -> p -> Point -> Maybe Int
findByPoint,
    containerMerge :: ContainerMergeHandler s e DropdownState
containerMerge = ContainerMergeHandler s e DropdownState
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> DropdownState -> WidgetResult s e
merge,
    containerDispose :: ContainerInitHandler s e
containerDispose = ContainerInitHandler s e
forall p s e. p -> WidgetNode s e -> WidgetResult s e
dispose,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = ContainerMessageHandler s e
forall a p.
Typeable a =>
WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall s e p.
WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize
  }
  baseWidget :: Widget s e
baseWidget = DropdownState -> Container s e DropdownState -> Widget s e
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 = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) WidgetData s a
widgetData

  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 = WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
    nodeStyle :: Style
nodeStyle = WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo WidgetNode s e
node WidgetNodeInfo -> Getting Style WidgetNodeInfo Style -> Style
forall s a. s -> Getting a s a -> a
^. Getting Style WidgetNodeInfo Style
forall s a. HasStyle s a => Lens' s a
L.style
    mainNode :: WidgetNode s e
mainNode = a -> WidgetNode s e
makeMain a
selected
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
nodeStyle
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    selectListNode :: WidgetNode s e
selectListNode = WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
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 = WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
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
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Widget s e
newWidget
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WidgetNode s e] -> Seq (WidgetNode s e)
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 = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style where
    style :: Style
style = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownStyle

  init :: ContainerInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
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 = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    reqs :: [WidgetRequest s e]
reqs = [ WidgetId -> WidgetRequest s e
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 s -> Getting (Seq a) s (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) s (Seq a)
forall s a. HasChildren s a => Lens' s a
L.children
    | Bool
otherwise = Seq a
forall a. Seq a
Empty

  findByPoint :: p -> s -> p -> Point -> Maybe Int
findByPoint p
wenv s
node p
start Point
point = Maybe Int
result where
    children :: Seq (WidgetNode s e)
children = s
node s
-> Getting (Seq (WidgetNode s e)) s (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting (Seq (WidgetNode s e)) s (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
    mainNode :: WidgetNode s e
mainNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
mainIdx
    listNode :: WidgetNode s e
listNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
listIdx
    result :: Maybe Int
result
      | Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
listNode Point
point = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
listIdx
      | Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
mainNode Point
point = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
mainIdx
      | Bool
otherwise = Maybe Int
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 = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
newResult where
    tmpResult :: Maybe (WidgetResult s e)
tmpResult = WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev [Path -> WidgetRequest s e]
reqs
    newResult :: WidgetResult s e
newResult = WidgetResult s e -> Maybe (WidgetResult s e) -> WidgetResult s e
forall a. a -> Maybe a -> a
fromMaybe (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) Maybe (WidgetResult s e)
tmpResult
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetRequest s e
forall s e. WidgetRequest s e
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 -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
prev (DropdownCfg s e a -> [Path -> WidgetRequest s e]
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 (Path -> Path -> Bool
forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
path Path
focusedPath)
        -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
next (DropdownCfg s e a -> [Path -> WidgetRequest s e]
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 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) Int
mainIdx
      listNode :: WidgetNode s e
listNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) 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
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
mainNode Point
point
      validListPos :: Bool
validListPos = Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> 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 = CursorIcon -> Maybe CursorIcon
forall a. a -> Maybe a
Just CursorIcon
CursorArrow Maybe CursorIcon -> Maybe CursorIcon -> Bool
forall a. Eq a => a -> a -> Bool
== ((Path, CursorIcon) -> CursorIcon
forall a b. (a, b) -> b
snd ((Path, CursorIcon) -> CursorIcon)
-> Maybe (Path, CursorIcon) -> Maybe CursorIcon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Maybe (Path, CursorIcon))
     (WidgetEnv s e)
     (Maybe (Path, CursorIcon))
-> Maybe (Path, CursorIcon)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Path, CursorIcon))
  (WidgetEnv s e)
  (Maybe (Path, CursorIcon))
forall s a. HasCursor s a => Lens' s a
L.cursor)
      resetRes :: WidgetResult s e
resetRes = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> CursorIcon -> WidgetRequest s e
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 = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resetRes
        | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    ButtonAction Point
_ Button
btn ButtonState
BtnPressed Int
_
      | Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
L.mainButton Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isOpen -> Maybe (WidgetResult s e)
result where
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus (WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId)]

    Click Point
point Button
_ Int
_
      | Point -> WidgetNode s e -> Bool
forall s a. (HasInfo s a, HasViewport a Rect) => Point -> s -> Bool
openRequired Point
point WidgetNode s e
node -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultOpen
      | Point -> WidgetNode s e -> Bool
forall s a a.
(HasChildren s (Seq a), HasInfo a a, HasViewport a Rect) =>
Point -> s -> Bool
closeRequired Point
point WidgetNode s e
node -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultClose
      where
        inVp :: Bool
inVp = WidgetNode s e -> Point -> Bool
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
          WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
CursorArrow]
        resultClose :: WidgetResult s e
resultClose = ContainerInitHandler s e
forall p. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
          WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetId -> WidgetRequest s e
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 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ ContainerInitHandler s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node
      | KeyCode -> Bool
isKeyEscape KeyCode
code Bool -> Bool -> Bool
&& Bool
isOpen -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ ContainerInitHandler s e
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 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (((KeyCode -> Bool) -> Bool) -> [KeyCode -> Bool] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KeyCode -> Bool) -> KeyCode -> Bool
forall a b. (a -> b) -> a -> b
$ KeyCode
code) [KeyCode -> Bool]
activationKeys)

    SystemEvent
_
      | Bool -> Bool
not Bool
isOpen -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreChildrenEvents]
      | Bool
otherwise -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
    where
      style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
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 WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
      focusedPath :: Path
focusedPath = WidgetEnv s e
wenv WidgetEnv s e -> Getting Path (WidgetEnv s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path (WidgetEnv s e) Path
forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath
      overlayPath :: Maybe Path
overlayPath = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (Maybe Path) (WidgetEnv s e) (Maybe Path) -> Maybe Path
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Path) (WidgetEnv s e) (Maybe Path)
forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath

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

  openRequired :: Point -> s -> Bool
openRequired Point
point s
node = Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& Bool
inViewport where
    inViewport :: Bool
inViewport = Point -> Rect -> Bool
pointInRect Point
point (s
node s -> Getting Rect s Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (a -> Const Rect a) -> s -> Const Rect s
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Rect a) -> s -> Const Rect s)
-> ((Rect -> Const Rect Rect) -> a -> Const Rect a)
-> Getting Rect s Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect) -> a -> Const Rect a
forall s a. HasViewport s a => Lens' s a
L.viewport)

  closeRequired :: Point -> s -> Bool
closeRequired Point
point s
node = Bool
isOpen Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inOverlay where
    offset :: Point
offset = DropdownState -> Point
_ddsOffset DropdownState
state
    listNode :: a
listNode = Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index (s
node s -> Getting (Seq a) s (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) s (Seq a)
forall s a. HasChildren s a => Lens' s a
L.children) Int
listIdx
    listVp :: Rect
listVp = Point -> Rect -> Rect
moveRect Point
offset (a
listNode a -> Getting Rect a Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (a -> Const Rect a) -> a -> Const Rect a
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Rect a) -> a -> Const Rect a)
-> ((Rect -> Const Rect Rect) -> a -> Const Rect a)
-> Getting Rect a Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect) -> a -> Const Rect a
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
requests where
    newState :: DropdownState
newState = DropdownState
state {
      _ddsOpen :: Bool
_ddsOpen = Bool
True,
      _ddsOffset :: Point
_ddsOffset = WidgetEnv s e -> WidgetNode s e -> Point
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
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
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)
forall s a b s.
(HasWidgetId s a, HasPath s b,
 HasChildren s (Seq (WidgetNode s e)),
 HasInfo (IxValue (Seq (WidgetNode s e))) s) =>
s -> (a, b)
scrollListInfo WidgetNode s e
node
    (WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
forall s a b s a.
(HasWidgetId s a, HasPath s b,
 HasChildren s (Seq (WidgetNode s e)),
 HasChildren (IxValue (Seq (WidgetNode s e))) a, Ixed a,
 Num (Index a), HasInfo (IxValue a) s) =>
s -> (a, b)
selectListInfo WidgetNode s e
node
    scrollMsg :: WidgetRequest s e
scrollMsg = WidgetId -> SelectListMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
listWid SelectListMessage
SelectListShowSelected
    requests :: [WidgetRequest s e]
requests = [WidgetId -> Path -> WidgetRequest s e
forall s e. WidgetId -> Path -> WidgetRequest s e
SetOverlay WidgetId
slWid Path
slPath, WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
listWid, WidgetRequest s e
forall s e. WidgetRequest s e
scrollMsg]

  closeDropdown :: p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
requests where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    (WidgetId
slWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
forall s a b s.
(HasWidgetId s a, HasPath s b,
 HasChildren s (Seq (WidgetNode s e)),
 HasInfo (IxValue (Seq (WidgetNode s e))) s) =>
s -> (a, b)
scrollListInfo WidgetNode s e
node
    (WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
forall s a b s a.
(HasWidgetId s a, HasPath s b,
 HasChildren s (Seq (WidgetNode s e)),
 HasChildren (IxValue (Seq (WidgetNode s e))) a, Ixed a,
 Num (Index a), HasInfo (IxValue a) s) =>
s -> (a, b)
selectListInfo WidgetNode s e
node
    newState :: DropdownState
newState = DropdownState
state {
      _ddsOpen :: Bool
_ddsOpen = Bool
False,
      _ddsOffset :: Point
_ddsOffset = Point
forall a. Default a => a
def
    }
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
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 = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
slWid, WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId]

  scrollListInfo :: s -> (a, b)
scrollListInfo s
node = (s
scrollInfo s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasWidgetId s a => Lens' s a
L.widgetId, s
scrollInfo s -> Getting b s b -> b
forall s a. s -> Getting a s a -> a
^. Getting b s b
forall s a. HasPath s a => Lens' s a
L.path) where
    scrollInfo :: s
scrollInfo = s
node s -> Getting (Endo s) s s -> s
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> s -> Const (Endo s) s
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
 -> s -> Const (Endo s) s)
-> ((s -> Const (Endo s) s)
    -> Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> Getting (Endo s) s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq (WidgetNode s e))
-> Traversal'
     (Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq (WidgetNode s e))
listIdx ((IxValue (Seq (WidgetNode s e))
  -> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
 -> Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> ((s -> Const (Endo s) s)
    -> IxValue (Seq (WidgetNode s e))
    -> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
-> (s -> Const (Endo s) s)
-> Seq (WidgetNode s e)
-> Const (Endo s) (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Const (Endo s) s)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e)))
forall s a. HasInfo s a => Lens' s a
L.info

  selectListInfo :: s -> (a, b)
selectListInfo s
node = (s
listInfo s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasWidgetId s a => Lens' s a
L.widgetId, s
listInfo s -> Getting b s b -> b
forall s a. s -> Getting a s a -> a
^. Getting b s b
forall s a. HasPath s a => Lens' s a
L.path) where
    listInfo :: s
listInfo = s
node s -> Getting (Endo s) s s -> s
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> s -> Const (Endo s) s
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
 -> s -> Const (Endo s) s)
-> ((s -> Const (Endo s) s)
    -> Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> Getting (Endo s) s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq (WidgetNode s e))
-> Traversal'
     (Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq (WidgetNode s e))
listIdx ((IxValue (Seq (WidgetNode s e))
  -> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
 -> Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> ((s -> Const (Endo s) s)
    -> IxValue (Seq (WidgetNode s e))
    -> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
-> (s -> Const (Endo s) s)
-> Seq (WidgetNode s e)
-> Const (Endo s) (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const (Endo s) a)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e)))
forall s a. HasChildren s a => Lens' s a
L.children ((a -> Const (Endo s) a)
 -> IxValue (Seq (WidgetNode s e))
 -> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
-> ((s -> Const (Endo s) s) -> a -> Const (Endo s) a)
-> (s -> Const (Endo s) s)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index a -> Traversal' a (IxValue a)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index a
0 ((IxValue a -> Const (Endo s) (IxValue a))
 -> a -> Const (Endo s) a)
-> ((s -> Const (Endo s) s)
    -> IxValue a -> Const (Endo s) (IxValue a))
-> (s -> Const (Endo s) s)
-> a
-> Const (Endo s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Const (Endo s) s) -> IxValue a -> Const (Endo s) (IxValue a)
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 =
    a -> Maybe DropdownMessage
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
msg Maybe DropdownMessage
-> (DropdownMessage -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e)
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
_) =
    Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq a
items Maybe a
-> (a -> Maybe (WidgetResult s e)) -> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
value -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> Int -> a -> WidgetResult s e
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 = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
    tempResult :: WidgetResult s e
tempResult = ContainerInitHandler s e
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 WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetEnv s e -> WidgetRequest s e
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 = p -> WidgetNode s e -> WidgetResult s e
forall p. p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node
    newReqs :: Seq (WidgetRequest s e)
newReqs = [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList ([WidgetRequest s e] -> Seq (WidgetRequest s e))
-> [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a b. (a -> b) -> a -> b
$ WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
widgetData a
item
      [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ ((a -> WidgetRequest s e) -> WidgetRequest s e)
-> [a -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> WidgetRequest s e) -> a -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ a
item) (DropdownCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
config)
      [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ ((Int -> a -> WidgetRequest s e) -> WidgetRequest s e)
-> [Int -> a -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int -> a -> WidgetRequest s e
fn -> Int -> a -> WidgetRequest s e
fn Int
idx a
item) (DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
config)
    result :: WidgetResult s e
result = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
newNode (Seq (WidgetRequest s e)
reqs Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
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 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    mainReqW :: SizeReq
mainReqW = WidgetNode s e
mainC WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    mainReqH :: SizeReq
mainReqH = WidgetNode s e
mainC WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
    -- List items reqs
    listC :: WidgetNode s e
listC = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
    listReqW :: SizeReq
listReqW = WidgetNode s e
listC WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    -- 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 = WidgetEnv s e -> Size
forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv
    theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
    maxHeightTheme :: Double
maxHeightTheme = ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasDropdownMaxHeight s a => Lens' s a
L.dropdownMaxHeight
    cfgMaxHeight :: Maybe Double
cfgMaxHeight = DropdownCfg s e a -> Maybe Double
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 = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
20 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
maxHeightTheme Maybe Double
cfgMaxHeight
    reqHeight :: Double
reqHeight = case Int -> Seq (WidgetNode s e) -> Maybe (WidgetNode s e)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
1 (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) of
      Just WidgetNode s e
child -> SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
      Maybe (WidgetNode s e)
_ -> Double
0
    maxHeight :: Double
maxHeight = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
winH (Double -> Double -> Double
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 = WidgetEnv s e -> Size
forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv
    viewport :: Rect
viewport = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
    scOffset :: Point
scOffset = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point (WidgetEnv s e) Point
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 = WidgetEnv s e -> WidgetNode s e -> Double
forall s e. WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node
    newOffset :: Double
newOffset
      | Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lh Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
winH = - (Double
rh Double -> Double -> Double
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 = WidgetEnv s e -> WidgetNode s e -> StyleState
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rh,
      _rH :: Double
_rH = WidgetEnv s e -> WidgetNode s e -> Double
forall s e. WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node
    }
    assignedAreas :: Seq Rect
assignedAreas = [Rect] -> Seq Rect
forall a. [a] -> Seq a
Seq.fromList [Rect
mainArea, Rect
listArea]
    resized :: (WidgetResult s e, Seq Rect)
resized = (WidgetNode s e -> WidgetResult s e
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction Renderer
renderer Rect
viewport StyleState
style ((Rect -> IO ()) -> IO ()) -> (Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Rect
contentArea -> do
        Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
mainNode WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
mainNode Renderer
renderer
        Renderer -> StyleState -> Rect -> IO ()
renderArrow Renderer
renderer StyleState
style Rect
contentArea

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isOpen (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> IO () -> IO ()
createOverlay Renderer
renderer (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer Point
totalOffset (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Renderer -> WidgetEnv s e -> WidgetNode s e -> IO ()
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 = WidgetEnv s e -> WidgetNode s e -> StyleState
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 WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
      mainNode :: WidgetNode s e
mainNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) Int
mainIdx
      -- List view is rendered with an offset to accommodate for window height
      listOverlay :: WidgetNode s e
listOverlay = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) Int
listIdx
      listOverlayVp :: Rect
listOverlayVp = WidgetNode s e
listOverlay WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
      scOffset :: Point
scOffset = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point (WidgetEnv s e) Point
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 = Container s e DropdownState
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
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
        WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Identity Rect)
 -> WidgetEnv s e -> Identity (WidgetEnv s e))
-> Rect -> WidgetEnv s e -> WidgetEnv s e
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 StyleState -> Getting FontSize StyleState FontSize -> FontSize
forall s a. s -> Getting a s a -> a
^. (Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> StyleState -> Const FontSize StyleState
forall s a. HasText s a => Lens' s a
L.text ((Maybe TextStyle -> Const FontSize (Maybe TextStyle))
 -> StyleState -> Const FontSize StyleState)
-> ((FontSize -> Const FontSize FontSize)
    -> Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> Getting FontSize StyleState FontSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Const FontSize TextStyle)
 -> Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> ((FontSize -> Const FontSize FontSize)
    -> TextStyle -> Const FontSize TextStyle)
-> (FontSize -> Const FontSize FontSize)
-> Maybe TextStyle
-> Const FontSize (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FontSize -> Const FontSize (Maybe FontSize))
-> TextStyle -> Const FontSize TextStyle
forall s a. HasFontSize s a => Lens' s a
L.fontSize ((Maybe FontSize -> Const FontSize (Maybe FontSize))
 -> TextStyle -> Const FontSize TextStyle)
-> ((FontSize -> Const FontSize FontSize)
    -> Maybe FontSize -> Const FontSize (Maybe FontSize))
-> (FontSize -> Const FontSize FontSize)
-> TextStyle
-> Const FontSize TextStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSize -> Iso' (Maybe FontSize) FontSize
forall a. Eq a => a -> Iso' (Maybe a) a
non FontSize
forall a. Default a => a
def
      arrowW :: Double
arrowW = FontSize -> Double
unFontSize FontSize
size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
      dh :: Double
dh = (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
arrowW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
      arrowRect :: Rect
arrowRect = Double -> Double -> Double -> Double -> Rect
Rect (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dh Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dh Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.25) Double
arrowW (Double
arrowW Double -> Double -> Double
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 WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget
    renderAction :: IO ()
renderAction = Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
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 :: 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 = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownItemStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownItemStyle
  selectedTheme :: Style
selectedTheme = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownItemSelectedStyle

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

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

createMoveFocusReq :: WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq :: WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq WidgetEnv s e
wenv = Maybe WidgetId -> FocusDirection -> WidgetRequest s e
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus Maybe WidgetId
forall a. Maybe a
Nothing FocusDirection
direction where
  direction :: FocusDirection
direction
    | WidgetEnv s e
wenv WidgetEnv s e -> Getting Bool (WidgetEnv s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Bool InputStatus)
-> WidgetEnv s e -> Const Bool (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Const Bool InputStatus)
 -> WidgetEnv s e -> Const Bool (WidgetEnv s e))
-> ((Bool -> Const Bool Bool)
    -> InputStatus -> Const Bool InputStatus)
-> Getting Bool (WidgetEnv s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyMod -> Const Bool KeyMod)
-> InputStatus -> Const Bool InputStatus
forall s a. HasKeyMod s a => Lens' s a
L.keyMod ((KeyMod -> Const Bool KeyMod)
 -> InputStatus -> Const Bool InputStatus)
-> ((Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod)
-> (Bool -> Const Bool Bool)
-> InputStatus
-> Const Bool InputStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod
forall s a. HasLeftShift s a => Lens' s a
L.leftShift = FocusDirection
FocusBwd
    | Bool
otherwise = FocusDirection
FocusFwd