{-|
Module      : Monomer.Widgets.Singles.TextDropdown
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 text based.

@
textDropdown textLens ["Option 1", "Option 2", "Option 3"]
@

In case a customizable version is needed, to display rich content in the header
or list items, "Monomer.Widgets.Containers.Dropdown" can be used.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Singles.TextDropdown (
  -- * Configuration
  TextDropdownItem,
  -- * Constructors
  textDropdown,
  textDropdown_,
  textDropdownV,
  textDropdownV_,
  textDropdownS,
  textDropdownS_,
  textDropdownSV,
  textDropdownSV_
) where

import Control.Lens (ALens')
import Data.Default
import Data.Text (Text, pack)
import TextShow

import Monomer.Core
import Monomer.Core.Combinators
import Monomer.Widgets.Containers.Dropdown
import Monomer.Widgets.Singles.Label

-- | Constraints for an item handled by textDropdown.
type TextDropdownItem a = DropdownItem a

{-|
Creates a text dropdown using the given lens. The type must have a 'TextShow'
instance.
-}
textDropdown
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a, TextShow a)
  => ALens' s a      -- ^ The lens into the model.
  -> t a             -- ^ The list of items.
  -> WidgetNode s e  -- ^ The created text dropdown.
textDropdown :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 TextShow a) =>
ALens' s a -> t a -> WidgetNode s e
textDropdown ALens' s a
field t a
items = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t,
 TextDropdownItem a) =>
ALens' s a
-> t a -> (a -> Text) -> [DropdownCfg s e a] -> WidgetNode s e
textDropdown_ ALens' s a
field t a
items forall a. TextShow a => a -> Text
showt forall a. Default a => a
def

{-|
Creates a text dropdown using the given lens. Takes a function for converting
the type to Text. Accepts config.
-}
textDropdown_
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a)
  => ALens' s a           -- ^ The lens into the model.
  -> t a                  -- ^ The list of items.
  -> (a -> Text)          -- ^ The function for converting to Text.
  -> [DropdownCfg s e a]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created text dropdown.
textDropdown_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t,
 TextDropdownItem a) =>
ALens' s a
-> t a -> (a -> Text) -> [DropdownCfg s e a] -> WidgetNode s e
textDropdown_ ALens' s a
field t a
items a -> Text
toText [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t,
 TextDropdownItem a) =>
WidgetData s a
-> t a -> (a -> Text) -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownD_ (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) t a
items a -> Text
toText [DropdownCfg s e a]
configs

{-|
Creates a text dropdown using the given value and 'onChange' event handler.
-}
textDropdownV
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a, TextShow a)
  => a               -- ^ The current value.
  -> (a -> e)        -- ^ The event to raise on change.
  -> t a             -- ^ The list of items.
  -> WidgetNode s e  -- ^ The created text dropdown.
textDropdownV :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 TextShow a) =>
a -> (a -> e) -> t a -> WidgetNode s e
textDropdownV a
value a -> e
handler t a
items = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t,
 TextDropdownItem a) =>
a
-> (a -> e)
-> t a
-> (a -> Text)
-> [DropdownCfg s e a]
-> WidgetNode s e
textDropdownV_ a
value a -> e
handler t a
items forall a. TextShow a => a -> Text
showt forall a. Default a => a
def

{-|
Creates a text dropdown using the given value and 'onChange' event handler.
Takes a function for converting the type to Text. Accepts config.
-}
textDropdownV_
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a)
  => a                    -- ^ The current value.
  -> (a -> e)             -- ^ The event to raise on change.
  -> t a                  -- ^ The list of items.
  -> (a -> Text)          -- ^ The function for converting to Text.
  -> [DropdownCfg s e a]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created text dropdown.
textDropdownV_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t,
 TextDropdownItem a) =>
a
-> (a -> e)
-> t a
-> (a -> Text)
-> [DropdownCfg s e a]
-> WidgetNode s e
textDropdownV_ a
value a -> e
handler t a
items a -> Text
toText [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s a
widgetData = forall s a. a -> WidgetData s a
WidgetValue a
value
  newConfigs :: [DropdownCfg s e a]
newConfigs = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange 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,
 TextDropdownItem a) =>
WidgetData s a
-> t a -> (a -> Text) -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownD_ forall {s}. WidgetData s a
widgetData t a
items a -> Text
toText [DropdownCfg s e a]
newConfigs

{-|
Creates a text dropdown providing a 'WidgetData' instance and config. Takes
a function for converting the type to Text.
-}
textDropdownD_
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a)
  => WidgetData s a       -- ^ The 'WidgetData' to retrieve the value from.
  -> t a                  -- ^ The list of items.
  -> (a -> Text)          -- ^ The function for converting to Text.
  -> [DropdownCfg s e a]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created text dropdown.
textDropdownD_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t,
 TextDropdownItem a) =>
WidgetData s a
-> t a -> (a -> Text) -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownD_ WidgetData s a
widgetData t a
items a -> Text
toText [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  makeMain :: a -> WidgetNode s e
makeMain a
t = forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ (a -> Text
toText a
t) [forall t. CmbResizeFactorDim t => Double -> t
resizeFactorW Double
0.01]
  makeRow :: a -> WidgetNode s e
makeRow a
t = forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ (a -> Text
toText a
t) [forall t. CmbResizeFactorDim t => Double -> t
resizeFactorW Double
0.01]
  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 forall {s} {e}. a -> WidgetNode s e
makeMain forall {s} {e}. a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs

{-|
Creates a text dropdown using the given lens. The type must have a 'Show'
instance.
-}
textDropdownS
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a, Show a)
  => ALens' s a      -- ^ The lens into the model.
  -> t a             -- ^ The list of items.
  -> WidgetNode s e  -- ^ The created text dropdown.
textDropdownS :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 Show a) =>
ALens' s a -> t a -> WidgetNode s e
textDropdownS ALens' s a
field t a
items = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 Show a) =>
ALens' s a -> t a -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownS_ ALens' s a
field t a
items forall a. Default a => a
def

{-|
Creates a text dropdown using the given lens. The type must have a 'Show'
instance. Accepts config.
-}
textDropdownS_
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a, Show a)
  => ALens' s a           -- ^ The lens into the model.
  -> t a                  -- ^ The list of items.
  -> [DropdownCfg s e a]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created text dropdown.
textDropdownS_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 Show a) =>
ALens' s a -> t a -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownS_ ALens' s a
field t a
items [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 Show a) =>
WidgetData s a -> t a -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownDS_ (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) t a
items [DropdownCfg s e a]
configs

{-|
Creates a text dropdown using the given value and 'onChange' event handler. The
type must have a 'Show' instance.
-}
textDropdownSV
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a, Show a)
  => a               -- ^ The current value.
  -> (a -> e)        -- ^ The event to raise on change.
  -> t a             -- ^ The list of items.
  -> WidgetNode s e  -- ^ The created text dropdown.
textDropdownSV :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 Show a) =>
a -> (a -> e) -> t a -> WidgetNode s e
textDropdownSV a
value a -> e
handler t a
items = WidgetNode s e
newNode where
  newNode :: WidgetNode s e
newNode = forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 Show a) =>
a -> (a -> e) -> t a -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownSV_ a
value a -> e
handler t a
items forall a. Default a => a
def

{-|
Creates a text dropdown using the given value and 'onChange' event handler. The
type must have a 'Show' instance. Accepts config.
-}
textDropdownSV_
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a, Show a)
  => a                    -- ^ The current value.
  -> (a -> e)             -- ^ The event to raise on change.
  -> t a                  -- ^ The list of items.
  -> [DropdownCfg s e a]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created text dropdown.
textDropdownSV_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 Show a) =>
a -> (a -> e) -> t a -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownSV_ a
value a -> e
handler t a
items [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s a
widgetData = forall s a. a -> WidgetData s a
WidgetValue a
value
  newConfigs :: [DropdownCfg s e a]
newConfigs = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange 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, TextDropdownItem a,
 Show a) =>
WidgetData s a -> t a -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownDS_ forall {s}. WidgetData s a
widgetData t a
items [DropdownCfg s e a]
newConfigs

{-|
Creates a text dropdown providing a 'WidgetData' instance and config. The
type must have a 'Show' instance.
-}
textDropdownDS_
  :: (WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a, Show a)
  => WidgetData s a       -- ^ The 'WidgetData' to retrieve the value from.
  -> t a                  -- ^ The list of items.
  -> [DropdownCfg s e a]  -- ^ The config options.
  -> WidgetNode s e       -- ^ The created text dropdown.
textDropdownDS_ :: forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
 Show a) =>
WidgetData s a -> t a -> [DropdownCfg s e a] -> WidgetNode s e
textDropdownDS_ WidgetData s a
widgetData t a
items [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
  toText :: a -> Text
toText = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
  makeMain :: a -> WidgetNode s e
makeMain a
t = forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ (a -> Text
toText a
t) [forall t. CmbResizeFactorDim t => Double -> t
resizeFactorW Double
0.01]
  makeRow :: a -> WidgetNode s e
makeRow a
t = forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ (a -> Text
toText a
t) [forall t. CmbResizeFactorDim t => Double -> t
resizeFactorW Double
0.01]
  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 forall {s} {e}. a -> WidgetNode s e
makeMain forall {s} {e}. a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs