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

Input field for single line 'Text'. Allows setting the maximum number of
characters and a replacement character for password.

@
textField shortTextLens
@

With configuration options:

@
textField_ shortTextLens [maxLength 100, selectOnFocus_ False]
@

-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Singles.TextField (
  -- * Configuration
  TextFieldCfg,
  textFieldDisplayChar,
  -- * Constructors
  textField,
  textField_,
  textFieldV,
  textFieldV_,
  textFieldD_
) where

import Control.Applicative ((<|>))
import Control.Lens (ALens')
import Data.Default
import Data.Maybe
import Data.Text (Text)

import qualified Data.Text as T

import Monomer.Core
import Monomer.Core.Combinators
import Monomer.Widgets.Singles.Base.InputField

import qualified Monomer.Lens as L

{-|
Configuration options for textField:

- 'validInput': field indicating if the current input is valid. Useful to show
  warnings in the UI, or disable buttons if needed.
- 'resizeOnChange': Whether input causes ResizeWidgets requests.
- 'selectOnFocus': Whether all input should be selected when focus is received.
- 'readOnly': Whether to prevent the user changing the input text.
- 'maxLength': the maximum length of input text.
- 'textFieldDisplayChar': the character that will be displayed as replacement of
  the real text. Useful for password fields.
- '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 the value changes.
- 'onChangeReq': 'WidgetRequest' to generate when the value changes.
-}
data TextFieldCfg s e = TextFieldCfg {
  TextFieldCfg s e -> Maybe Double
_tfcCaretWidth :: Maybe Double,
  TextFieldCfg s e -> Maybe Millisecond
_tfcCaretMs :: Maybe Millisecond,
  TextFieldCfg s e -> Maybe Char
_tfcDisplayChar :: Maybe Char,
  TextFieldCfg s e -> Maybe Text
_tfcPlaceholder :: Maybe Text,
  TextFieldCfg s e -> Maybe (WidgetData s Bool)
_tfcValid :: Maybe (WidgetData s Bool),
  TextFieldCfg s e -> [Bool -> e]
_tfcValidV :: [Bool -> e],
  TextFieldCfg s e -> Maybe Int
_tfcMaxLength :: Maybe Int,
  TextFieldCfg s e -> Maybe Bool
_tfcResizeOnChange :: Maybe Bool,
  TextFieldCfg s e -> Maybe Bool
_tfcSelectOnFocus :: Maybe Bool,
  TextFieldCfg s e -> Maybe Bool
_tfcReadOnly :: Maybe Bool,
  TextFieldCfg s e -> [Path -> WidgetRequest s e]
_tfcOnFocusReq :: [Path -> WidgetRequest s e],
  TextFieldCfg s e -> [Path -> WidgetRequest s e]
_tfcOnBlurReq :: [Path -> WidgetRequest s e],
  TextFieldCfg s e -> [Text -> WidgetRequest s e]
_tfcOnChangeReq :: [Text -> WidgetRequest s e]
}

instance Default (TextFieldCfg s e) where
  def :: TextFieldCfg s e
def = TextFieldCfg :: forall s e.
Maybe Double
-> Maybe Millisecond
-> Maybe Char
-> Maybe Text
-> Maybe (WidgetData s Bool)
-> [Bool -> e]
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [Text -> WidgetRequest s e]
-> TextFieldCfg s e
TextFieldCfg {
    _tfcCaretWidth :: Maybe Double
_tfcCaretWidth = Maybe Double
forall a. Maybe a
Nothing,
    _tfcCaretMs :: Maybe Millisecond
_tfcCaretMs = Maybe Millisecond
forall a. Maybe a
Nothing,
    _tfcDisplayChar :: Maybe Char
_tfcDisplayChar = Maybe Char
forall a. Maybe a
Nothing,
    _tfcPlaceholder :: Maybe Text
_tfcPlaceholder = Maybe Text
forall a. Maybe a
Nothing,
    _tfcValid :: Maybe (WidgetData s Bool)
_tfcValid = Maybe (WidgetData s Bool)
forall a. Maybe a
Nothing,
    _tfcValidV :: [Bool -> e]
_tfcValidV = [],
    _tfcMaxLength :: Maybe Int
_tfcMaxLength = Maybe Int
forall a. Maybe a
Nothing,
    _tfcResizeOnChange :: Maybe Bool
_tfcResizeOnChange = Maybe Bool
forall a. Maybe a
Nothing,
    _tfcSelectOnFocus :: Maybe Bool
_tfcSelectOnFocus = Maybe Bool
forall a. Maybe a
Nothing,
    _tfcReadOnly :: Maybe Bool
_tfcReadOnly = Maybe Bool
forall a. Maybe a
Nothing,
    _tfcOnFocusReq :: [Path -> WidgetRequest s e]
_tfcOnFocusReq = [],
    _tfcOnBlurReq :: [Path -> WidgetRequest s e]
_tfcOnBlurReq = [],
    _tfcOnChangeReq :: [Text -> WidgetRequest s e]
_tfcOnChangeReq = []
  }

instance Semigroup (TextFieldCfg s e) where
  <> :: TextFieldCfg s e -> TextFieldCfg s e -> TextFieldCfg s e
(<>) TextFieldCfg s e
t1 TextFieldCfg s e
t2 = TextFieldCfg :: forall s e.
Maybe Double
-> Maybe Millisecond
-> Maybe Char
-> Maybe Text
-> Maybe (WidgetData s Bool)
-> [Bool -> e]
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [Text -> WidgetRequest s e]
-> TextFieldCfg s e
TextFieldCfg {
    _tfcCaretWidth :: Maybe Double
_tfcCaretWidth = TextFieldCfg s e -> Maybe Double
forall s e. TextFieldCfg s e -> Maybe Double
_tfcCaretWidth TextFieldCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe Double
forall s e. TextFieldCfg s e -> Maybe Double
_tfcCaretWidth TextFieldCfg s e
t1,
    _tfcCaretMs :: Maybe Millisecond
_tfcCaretMs = TextFieldCfg s e -> Maybe Millisecond
forall s e. TextFieldCfg s e -> Maybe Millisecond
_tfcCaretMs TextFieldCfg s e
t2 Maybe Millisecond -> Maybe Millisecond -> Maybe Millisecond
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe Millisecond
forall s e. TextFieldCfg s e -> Maybe Millisecond
_tfcCaretMs TextFieldCfg s e
t1,
    _tfcDisplayChar :: Maybe Char
_tfcDisplayChar = TextFieldCfg s e -> Maybe Char
forall s e. TextFieldCfg s e -> Maybe Char
_tfcDisplayChar TextFieldCfg s e
t2 Maybe Char -> Maybe Char -> Maybe Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe Char
forall s e. TextFieldCfg s e -> Maybe Char
_tfcDisplayChar TextFieldCfg s e
t1,
    _tfcPlaceholder :: Maybe Text
_tfcPlaceholder = TextFieldCfg s e -> Maybe Text
forall s e. TextFieldCfg s e -> Maybe Text
_tfcPlaceholder TextFieldCfg s e
t2 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe Text
forall s e. TextFieldCfg s e -> Maybe Text
_tfcPlaceholder TextFieldCfg s e
t1,
    _tfcValid :: Maybe (WidgetData s Bool)
_tfcValid = TextFieldCfg s e -> Maybe (WidgetData s Bool)
forall s e. TextFieldCfg s e -> Maybe (WidgetData s Bool)
_tfcValid TextFieldCfg s e
t2 Maybe (WidgetData s Bool)
-> Maybe (WidgetData s Bool) -> Maybe (WidgetData s Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe (WidgetData s Bool)
forall s e. TextFieldCfg s e -> Maybe (WidgetData s Bool)
_tfcValid TextFieldCfg s e
t1,
    _tfcValidV :: [Bool -> e]
_tfcValidV = TextFieldCfg s e -> [Bool -> e]
forall s e. TextFieldCfg s e -> [Bool -> e]
_tfcValidV TextFieldCfg s e
t1 [Bool -> e] -> [Bool -> e] -> [Bool -> e]
forall a. Semigroup a => a -> a -> a
<> TextFieldCfg s e -> [Bool -> e]
forall s e. TextFieldCfg s e -> [Bool -> e]
_tfcValidV TextFieldCfg s e
t2,
    _tfcMaxLength :: Maybe Int
_tfcMaxLength = TextFieldCfg s e -> Maybe Int
forall s e. TextFieldCfg s e -> Maybe Int
_tfcMaxLength TextFieldCfg s e
t2 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe Int
forall s e. TextFieldCfg s e -> Maybe Int
_tfcMaxLength TextFieldCfg s e
t1,
    _tfcResizeOnChange :: Maybe Bool
_tfcResizeOnChange = TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcResizeOnChange TextFieldCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcResizeOnChange TextFieldCfg s e
t1,
    _tfcSelectOnFocus :: Maybe Bool
_tfcSelectOnFocus = TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcSelectOnFocus TextFieldCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcSelectOnFocus TextFieldCfg s e
t1,
    _tfcReadOnly :: Maybe Bool
_tfcReadOnly = TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcReadOnly TextFieldCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcReadOnly TextFieldCfg s e
t1,
    _tfcOnFocusReq :: [Path -> WidgetRequest s e]
_tfcOnFocusReq = TextFieldCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Path -> WidgetRequest s e]
_tfcOnFocusReq TextFieldCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> TextFieldCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Path -> WidgetRequest s e]
_tfcOnFocusReq TextFieldCfg s e
t2,
    _tfcOnBlurReq :: [Path -> WidgetRequest s e]
_tfcOnBlurReq = TextFieldCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Path -> WidgetRequest s e]
_tfcOnBlurReq TextFieldCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> TextFieldCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Path -> WidgetRequest s e]
_tfcOnBlurReq TextFieldCfg s e
t2,
    _tfcOnChangeReq :: [Text -> WidgetRequest s e]
_tfcOnChangeReq = TextFieldCfg s e -> [Text -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Text -> WidgetRequest s e]
_tfcOnChangeReq TextFieldCfg s e
t1 [Text -> WidgetRequest s e]
-> [Text -> WidgetRequest s e] -> [Text -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> TextFieldCfg s e -> [Text -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Text -> WidgetRequest s e]
_tfcOnChangeReq TextFieldCfg s e
t2
  }

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

instance CmbCaretWidth (TextFieldCfg s e) Double where
  caretWidth :: Double -> TextFieldCfg s e
caretWidth Double
w = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcCaretWidth :: Maybe Double
_tfcCaretWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
  }

instance CmbCaretMs (TextFieldCfg s e) Millisecond where
  caretMs :: Millisecond -> TextFieldCfg s e
caretMs Millisecond
ms = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcCaretMs :: Maybe Millisecond
_tfcCaretMs = Millisecond -> Maybe Millisecond
forall a. a -> Maybe a
Just Millisecond
ms
  }

instance CmbPlaceholder (TextFieldCfg s e) Text where
  placeholder :: Text -> TextFieldCfg s e
placeholder Text
value = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcPlaceholder :: Maybe Text
_tfcPlaceholder = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
value
  }

instance CmbValidInput (TextFieldCfg s e) s where
  validInput :: ALens' s Bool -> TextFieldCfg s e
validInput ALens' s Bool
field = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcValid :: Maybe (WidgetData s Bool)
_tfcValid = WidgetData s Bool -> Maybe (WidgetData s Bool)
forall a. a -> Maybe a
Just (ALens' s Bool -> WidgetData s Bool
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Bool
field)
  }

instance CmbValidInputV (TextFieldCfg s e) e where
  validInputV :: (Bool -> e) -> TextFieldCfg s e
validInputV Bool -> e
fn = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcValidV :: [Bool -> e]
_tfcValidV = [Bool -> e
fn]
  }

instance CmbResizeOnChange (TextFieldCfg s e) where
  resizeOnChange_ :: Bool -> TextFieldCfg s e
resizeOnChange_ Bool
resize = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcResizeOnChange :: Maybe Bool
_tfcResizeOnChange = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
resize
  }

instance CmbSelectOnFocus (TextFieldCfg s e) where
  selectOnFocus_ :: Bool -> TextFieldCfg s e
selectOnFocus_ Bool
sel = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcSelectOnFocus :: Maybe Bool
_tfcSelectOnFocus = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
sel
  }

instance CmbReadOnly (TextFieldCfg s e) where
  readOnly_ :: Bool -> TextFieldCfg s e
readOnly_ Bool
ro = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcReadOnly :: Maybe Bool
_tfcReadOnly = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
ro
  }

instance CmbMaxLength (TextFieldCfg s e) where
  maxLength :: Int -> TextFieldCfg s e
maxLength Int
len = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcMaxLength :: Maybe Int
_tfcMaxLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
len
  }

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

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

instance WidgetEvent e => CmbOnChange (TextFieldCfg s e) Text e where
  onChange :: (Text -> e) -> TextFieldCfg s e
onChange Text -> e
fn = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcOnChangeReq :: [Text -> WidgetRequest s e]
_tfcOnChangeReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Text -> e) -> Text -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> e
fn]
  }

instance CmbOnChangeReq (TextFieldCfg s e) s e Text where
  onChangeReq :: (Text -> WidgetRequest s e) -> TextFieldCfg s e
onChangeReq Text -> WidgetRequest s e
req = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcOnChangeReq :: [Text -> WidgetRequest s e]
_tfcOnChangeReq = [Text -> WidgetRequest s e
req]
  }

-- | Replacement character to show instead of real text. Useful for passwords.
textFieldDisplayChar :: Char -> TextFieldCfg s e
textFieldDisplayChar :: Char -> TextFieldCfg s e
textFieldDisplayChar Char
char = TextFieldCfg s e
forall a. Default a => a
def {
    _tfcDisplayChar :: Maybe Char
_tfcDisplayChar = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
char
  }

-- | Creates a text field using the given lens.
textField :: WidgetEvent e => ALens' s Text -> WidgetNode s e
textField :: ALens' s Text -> WidgetNode s e
textField ALens' s Text
field = ALens' s Text -> [TextFieldCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
ALens' s Text -> [TextFieldCfg s e] -> WidgetNode s e
textField_ ALens' s Text
field [TextFieldCfg s e]
forall a. Default a => a
def

-- | Creates a text field using the given lens. Accepts config.
textField_
  :: WidgetEvent e => ALens' s Text -> [TextFieldCfg s e] -> WidgetNode s e
textField_ :: ALens' s Text -> [TextFieldCfg s e] -> WidgetNode s e
textField_ ALens' s Text
field [TextFieldCfg s e]
configs = WidgetData s Text -> [TextFieldCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextFieldCfg s e] -> WidgetNode s e
textFieldD_ (ALens' s Text -> WidgetData s Text
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Text
field) [TextFieldCfg s e]
configs

-- | Creates a text field using the given value and 'onChange' event handler.
textFieldV :: WidgetEvent e => Text -> (Text -> e) -> WidgetNode s e
textFieldV :: Text -> (Text -> e) -> WidgetNode s e
textFieldV Text
value Text -> e
handler = Text -> (Text -> e) -> [TextFieldCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
Text -> (Text -> e) -> [TextFieldCfg s e] -> WidgetNode s e
textFieldV_ Text
value Text -> e
handler [TextFieldCfg s e]
forall a. Default a => a
def

-- | Creates a text field using the given value and 'onChange' event handler.
--   Accepts config.
textFieldV_
  :: WidgetEvent e => Text -> (Text -> e) -> [TextFieldCfg s e] -> WidgetNode s e
textFieldV_ :: Text -> (Text -> e) -> [TextFieldCfg s e] -> WidgetNode s e
textFieldV_ Text
value Text -> e
handler [TextFieldCfg s e]
configs = WidgetData s Text -> [TextFieldCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetData s Text -> [TextFieldCfg s e] -> WidgetNode s e
textFieldD_ WidgetData s Text
forall s. WidgetData s Text
widgetData [TextFieldCfg s e]
newConfig where
  widgetData :: WidgetData s Text
widgetData = Text -> WidgetData s Text
forall s a. a -> WidgetData s a
WidgetValue Text
value
  newConfig :: [TextFieldCfg s e]
newConfig = (Text -> e) -> TextFieldCfg s e
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Text -> e
handler TextFieldCfg s e -> [TextFieldCfg s e] -> [TextFieldCfg s e]
forall a. a -> [a] -> [a]
: [TextFieldCfg s e]
configs

-- | Creates a text field providing a 'WidgetData' instance and config.
textFieldD_
  :: WidgetEvent e => WidgetData s Text -> [TextFieldCfg s e] -> WidgetNode s e
textFieldD_ :: WidgetData s Text -> [TextFieldCfg s e] -> WidgetNode s e
textFieldD_ WidgetData s Text
widgetData [TextFieldCfg s e]
configs = WidgetNode s e
inputField where
  config :: TextFieldCfg s e
config = [TextFieldCfg s e] -> TextFieldCfg s e
forall a. Monoid a => [a] -> a
mconcat [TextFieldCfg s e]
configs
  fromText :: Text -> Maybe Text
fromText = Maybe Int -> Text -> Maybe Text
textToText (TextFieldCfg s e -> Maybe Int
forall s e. TextFieldCfg s e -> Maybe Int
_tfcMaxLength TextFieldCfg s e
config)
  inputConfig :: InputFieldCfg s e Text
inputConfig = InputFieldCfg :: forall s e a.
Maybe Text
-> a
-> WidgetData s a
-> Maybe (WidgetData s Bool)
-> [Bool -> e]
-> Bool
-> Double
-> Maybe Double
-> Maybe Millisecond
-> Maybe Char
-> Bool
-> Bool
-> Bool
-> (Text -> Maybe a)
-> (a -> Text)
-> (Text -> Bool)
-> (Text -> Bool)
-> Maybe (ALens' ThemeState StyleState)
-> Maybe (InputWheelHandler a)
-> Maybe (InputDragHandler a)
-> Maybe CursorIcon
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> InputFieldCfg s e a
InputFieldCfg {
    _ifcPlaceholder :: Maybe Text
_ifcPlaceholder = TextFieldCfg s e -> Maybe Text
forall s e. TextFieldCfg s e -> Maybe Text
_tfcPlaceholder TextFieldCfg s e
config,
    _ifcInitialValue :: Text
_ifcInitialValue = Text
"",
    _ifcValue :: WidgetData s Text
_ifcValue = WidgetData s Text
widgetData,
    _ifcValid :: Maybe (WidgetData s Bool)
_ifcValid = TextFieldCfg s e -> Maybe (WidgetData s Bool)
forall s e. TextFieldCfg s e -> Maybe (WidgetData s Bool)
_tfcValid TextFieldCfg s e
config,
    _ifcValidV :: [Bool -> e]
_ifcValidV = TextFieldCfg s e -> [Bool -> e]
forall s e. TextFieldCfg s e -> [Bool -> e]
_tfcValidV TextFieldCfg s e
config,
    _ifcFromText :: Text -> Maybe Text
_ifcFromText = Text -> Maybe Text
fromText,
    _ifcToText :: Text -> Text
_ifcToText = Text -> Text
forall a. a -> a
id,
    _ifcAcceptInput :: Text -> Bool
_ifcAcceptInput = Maybe Int -> Text -> Bool
acceptInput (TextFieldCfg s e -> Maybe Int
forall s e. TextFieldCfg s e -> Maybe Int
_tfcMaxLength TextFieldCfg s e
config),
    _ifcIsValidInput :: Text -> Bool
_ifcIsValidInput = Maybe Int -> Text -> Bool
acceptInput (TextFieldCfg s e -> Maybe Int
forall s e. TextFieldCfg s e -> Maybe Int
_tfcMaxLength TextFieldCfg s e
config),
    _ifcDefCursorEnd :: Bool
_ifcDefCursorEnd = Bool
True,
    _ifcDefWidth :: Double
_ifcDefWidth = Double
100,
    _ifcCaretWidth :: Maybe Double
_ifcCaretWidth = TextFieldCfg s e -> Maybe Double
forall s e. TextFieldCfg s e -> Maybe Double
_tfcCaretWidth TextFieldCfg s e
config,
    _ifcCaretMs :: Maybe Millisecond
_ifcCaretMs = TextFieldCfg s e -> Maybe Millisecond
forall s e. TextFieldCfg s e -> Maybe Millisecond
_tfcCaretMs TextFieldCfg s e
config,
    _ifcDisplayChar :: Maybe Char
_ifcDisplayChar = TextFieldCfg s e -> Maybe Char
forall s e. TextFieldCfg s e -> Maybe Char
_tfcDisplayChar TextFieldCfg s e
config,
    _ifcResizeOnChange :: Bool
_ifcResizeOnChange = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcResizeOnChange TextFieldCfg s e
config),
    _ifcSelectOnFocus :: Bool
_ifcSelectOnFocus = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcSelectOnFocus TextFieldCfg s e
config),
    _ifcReadOnly :: Bool
_ifcReadOnly = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (TextFieldCfg s e -> Maybe Bool
forall s e. TextFieldCfg s e -> Maybe Bool
_tfcReadOnly TextFieldCfg s e
config),
    _ifcStyle :: Maybe (ALens' ThemeState StyleState)
_ifcStyle = ALens' ThemeState StyleState
-> Maybe (ALens' ThemeState StyleState)
forall a. a -> Maybe a
Just ALens' ThemeState StyleState
forall s a. HasTextFieldStyle s a => Lens' s a
L.textFieldStyle,
    _ifcWheelHandler :: Maybe (InputWheelHandler Text)
_ifcWheelHandler = Maybe (InputWheelHandler Text)
forall a. Maybe a
Nothing,
    _ifcDragHandler :: Maybe (InputDragHandler Text)
_ifcDragHandler = Maybe (InputDragHandler Text)
forall a. Maybe a
Nothing,
    _ifcDragCursor :: Maybe CursorIcon
_ifcDragCursor = Maybe CursorIcon
forall a. Maybe a
Nothing,
    _ifcOnFocusReq :: [Path -> WidgetRequest s e]
_ifcOnFocusReq = TextFieldCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Path -> WidgetRequest s e]
_tfcOnFocusReq TextFieldCfg s e
config,
    _ifcOnBlurReq :: [Path -> WidgetRequest s e]
_ifcOnBlurReq = TextFieldCfg s e -> [Path -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Path -> WidgetRequest s e]
_tfcOnBlurReq TextFieldCfg s e
config,
    _ifcOnChangeReq :: [Text -> WidgetRequest s e]
_ifcOnChangeReq = TextFieldCfg s e -> [Text -> WidgetRequest s e]
forall s e. TextFieldCfg s e -> [Text -> WidgetRequest s e]
_tfcOnChangeReq TextFieldCfg s e
config
  }
  inputField :: WidgetNode s e
inputField = WidgetType -> InputFieldCfg s e Text -> WidgetNode s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
WidgetType -> InputFieldCfg s e a -> WidgetNode s e
inputField_ WidgetType
"textField" InputFieldCfg s e Text
inputConfig

textToText :: Maybe Int -> Text -> Maybe Text
textToText :: Maybe Int -> Text -> Maybe Text
textToText Maybe Int
Nothing Text
text = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text
textToText (Just Int
len) Text
text
  | Text -> Int
T.length Text
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text
  | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

acceptInput :: Maybe Int -> Text -> Bool
acceptInput :: Maybe Int -> Text -> Bool
acceptInput Maybe Int
Nothing Text
_ = Bool
True
acceptInput (Just Int
len) Text
text = Text -> Int
T.length Text
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len