{-|
Module      : Monomer.Widgets.Singles.NumericField
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 numeric types.

Supports instances of the 'FromFractional' typeclass. Several basic types are
implemented, both for integer and floating point types.

Handles mouse wheel and shift + vertical drag to increase/decrease the number.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

module Monomer.Widgets.Singles.NumericField (
  -- * Configuration
  NumericFieldCfg,
  FormattableNumber,
  NumericTextConverter,
  -- * Constructors
  numericField,
  numericField_,
  numericFieldV,
  numericFieldV_
) where

import Control.Applicative ((<|>))
import Control.Lens ((^.), ALens', _1, _2, _3)
import Control.Monad (join)
import Data.Char
import Data.Default
import Data.Either
import Data.List (isPrefixOf)
import Data.Maybe
import Data.Text (Text)
import Data.Text.Read (signed, rational)
import Data.Typeable (Typeable, typeOf)

import qualified Data.Attoparsec.Text as A
import qualified Data.Text as T
import qualified Formatting as F

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

import qualified Monomer.Lens as L
import qualified Monomer.Widgets.Util.Parser as P

-- | Converts a numeric instance to and from 'Text'.
class NumericTextConverter a where
  numericAcceptText :: Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
  numericFromText :: Text -> Maybe a
  numericToText :: Int -> a -> Text
  numericToFractional :: Fractional b => a -> Maybe b
  numericFromFractional :: (Real b, Fractional b) => b -> a

instance {-# OVERLAPPABLE #-} FromFractional a => NumericTextConverter a where
  numericAcceptText :: Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
numericAcceptText Maybe a
minVal Maybe a
maxVal Int
decimals Text
text = (Bool, Bool, Maybe a)
result where
    accept :: Bool
accept = Int -> Text -> Bool
acceptNumberInput Int
decimals Text
text
    parsed :: Maybe a
parsed = Text -> Maybe a
forall a. NumericTextConverter a => Text -> Maybe a
numericFromText Text
text
    isValid :: Bool
isValid = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
parsed Bool -> Bool -> Bool
&& Maybe a -> Maybe a -> a -> Bool
forall a. Ord a => Maybe a -> Maybe a -> a -> Bool
numberInBounds Maybe a
minVal Maybe a
maxVal (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
parsed)
    fromText :: Maybe a
fromText
      | Bool
isValid = Maybe a
parsed
      | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
    result :: (Bool, Bool, Maybe a)
result = (Bool
accept, Bool
isValid, Maybe a
fromText)
  numericFromText :: Text -> Maybe a
numericFromText Text
text = case Reader Rational -> Reader Rational
forall a. Num a => Reader a -> Reader a
signed Reader Rational
forall a. Fractional a => Reader a
rational Text
text of
    Right (Rational
frac :: Rational, Text
_) -> a -> Maybe a
forall a. a -> Maybe a
Just (Rational -> a
forall a b. (FromFractional a, Real b, Fractional b) => b -> a
fromFractional Rational
frac)
    Either String (Rational, Text)
_ -> Maybe a
forall a. Maybe a
Nothing
  numericToText :: Int -> a -> Text
numericToText Int
decimals a
value = Format Text (a -> Text) -> a -> Text
forall a. Format Text a -> a
F.sformat (Int -> Format Text (a -> Text)
forall a r. Real a => Int -> Format r (a -> r)
F.fixed Int
decimals) a
value
  numericToFractional :: a -> Maybe b
numericToFractional = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac
  numericFromFractional :: b -> a
numericFromFractional = b -> a
forall a b. (FromFractional a, Real b, Fractional b) => b -> a
fromFractional

instance (FromFractional a, NumericTextConverter a) => NumericTextConverter (Maybe a) where
  numericAcceptText :: Maybe (Maybe a)
-> Maybe (Maybe a) -> Int -> Text -> (Bool, Bool, Maybe (Maybe a))
numericAcceptText Maybe (Maybe a)
minVal Maybe (Maybe a)
maxVal Int
decimals Text
text
    | Text -> Text
T.strip Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = (Bool
True, Bool
True, Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing)
    | Bool
otherwise = (Bool
accept, Bool
isValid, Maybe (Maybe a)
result) where
      resp :: (Bool, Bool, Maybe a)
resp = Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
forall a.
NumericTextConverter a =>
Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
numericAcceptText (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe a)
minVal) (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe a)
maxVal) Int
decimals Text
text
      (Bool
accept, Bool
isValid, Maybe a
tmpResult) = (Bool, Bool, Maybe a)
resp
      result :: Maybe (Maybe a)
result
        | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
tmpResult = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
tmpResult
        | Bool
otherwise = Maybe (Maybe a)
forall a. Maybe a
Nothing
  numericFromText :: Text -> Maybe (Maybe a)
numericFromText = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a))
-> (Text -> Maybe a) -> Text -> Maybe (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe a
forall a. NumericTextConverter a => Text -> Maybe a
numericFromText
  numericToText :: Int -> Maybe a -> Text
numericToText Int
_ Maybe a
Nothing = Text
""
  numericToText Int
decimals (Just a
value) = Int -> a -> Text
forall a. NumericTextConverter a => Int -> a -> Text
numericToText Int
decimals a
value
  numericToFractional :: Maybe a -> Maybe b
numericToFractional Maybe a
Nothing = Maybe b
forall a. Maybe a
Nothing
  numericToFractional (Just a
value) = a -> Maybe b
forall a b. (NumericTextConverter a, Fractional b) => a -> Maybe b
numericToFractional a
value
  numericFromFractional :: b -> Maybe a
numericFromFractional = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (b -> a) -> b -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
forall a b.
(NumericTextConverter a, Real b, Fractional b) =>
b -> a
numericFromFractional

-- | Constraints for numeric types accepted by numericField.
type FormattableNumber a
  = (Eq a, Ord a, Show a, NumericTextConverter a, Typeable a)

{-|
Configuration options for numericField:

- '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.
- 'minValue': Minimum valid number.
- 'maxValue': Maximum valid number.
- 'wheelRate': The rate at which wheel movement affects the number.
- 'dragRate': The rate at which drag movement affects the number.
- '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.
- 'decimals': the maximum number of digits after the decimal separator. Defaults
  to zero for integers and two for floating point types.
-}
data NumericFieldCfg s e a = NumericFieldCfg {
  NumericFieldCfg s e a -> Maybe Double
_nfcCaretWidth :: Maybe Double,
  NumericFieldCfg s e a -> Maybe Int
_nfcCaretMs :: Maybe Int,
  NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
_nfcValid :: Maybe (WidgetData s Bool),
  NumericFieldCfg s e a -> [Bool -> e]
_nfcValidV :: [Bool -> e],
  NumericFieldCfg s e a -> Maybe Int
_nfcDecimals :: Maybe Int,
  NumericFieldCfg s e a -> Maybe a
_nfcMinValue :: Maybe a,
  NumericFieldCfg s e a -> Maybe a
_nfcMaxValue :: Maybe a,
  NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate :: Maybe Double,
  NumericFieldCfg s e a -> Maybe Double
_nfcDragRate :: Maybe Double,
  NumericFieldCfg s e a -> Maybe Bool
_nfcResizeOnChange :: Maybe Bool,
  NumericFieldCfg s e a -> Maybe Bool
_nfcSelectOnFocus :: Maybe Bool,
  NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnFocusReq :: [Path -> WidgetRequest s e],
  NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnBlurReq :: [Path -> WidgetRequest s e],
  NumericFieldCfg s e a -> [a -> WidgetRequest s e]
_nfcOnChangeReq :: [a -> WidgetRequest s e]
}

instance Default (NumericFieldCfg s e a) where
  def :: NumericFieldCfg s e a
def = NumericFieldCfg :: forall s e a.
Maybe Double
-> Maybe Int
-> Maybe (WidgetData s Bool)
-> [Bool -> e]
-> Maybe Int
-> Maybe a
-> Maybe a
-> Maybe Double
-> Maybe Double
-> Maybe Bool
-> Maybe Bool
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> NumericFieldCfg s e a
NumericFieldCfg {
    _nfcCaretWidth :: Maybe Double
_nfcCaretWidth = Maybe Double
forall a. Maybe a
Nothing,
    _nfcCaretMs :: Maybe Int
_nfcCaretMs = Maybe Int
forall a. Maybe a
Nothing,
    _nfcValid :: Maybe (WidgetData s Bool)
_nfcValid = Maybe (WidgetData s Bool)
forall a. Maybe a
Nothing,
    _nfcValidV :: [Bool -> e]
_nfcValidV = [],
    _nfcDecimals :: Maybe Int
_nfcDecimals = Maybe Int
forall a. Maybe a
Nothing,
    _nfcMinValue :: Maybe a
_nfcMinValue = Maybe a
forall a. Maybe a
Nothing,
    _nfcMaxValue :: Maybe a
_nfcMaxValue = Maybe a
forall a. Maybe a
Nothing,
    _nfcWheelRate :: Maybe Double
_nfcWheelRate = Maybe Double
forall a. Maybe a
Nothing,
    _nfcDragRate :: Maybe Double
_nfcDragRate = Maybe Double
forall a. Maybe a
Nothing,
    _nfcResizeOnChange :: Maybe Bool
_nfcResizeOnChange = Maybe Bool
forall a. Maybe a
Nothing,
    _nfcSelectOnFocus :: Maybe Bool
_nfcSelectOnFocus = Maybe Bool
forall a. Maybe a
Nothing,
    _nfcOnFocusReq :: [Path -> WidgetRequest s e]
_nfcOnFocusReq = [],
    _nfcOnBlurReq :: [Path -> WidgetRequest s e]
_nfcOnBlurReq = [],
    _nfcOnChangeReq :: [a -> WidgetRequest s e]
_nfcOnChangeReq = []
  }

instance Semigroup (NumericFieldCfg s e a) where
  <> :: NumericFieldCfg s e a
-> NumericFieldCfg s e a -> NumericFieldCfg s e a
(<>) NumericFieldCfg s e a
t1 NumericFieldCfg s e a
t2 = NumericFieldCfg :: forall s e a.
Maybe Double
-> Maybe Int
-> Maybe (WidgetData s Bool)
-> [Bool -> e]
-> Maybe Int
-> Maybe a
-> Maybe a
-> Maybe Double
-> Maybe Double
-> Maybe Bool
-> Maybe Bool
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> NumericFieldCfg s e a
NumericFieldCfg {
    _nfcCaretWidth :: Maybe Double
_nfcCaretWidth = NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcCaretWidth NumericFieldCfg s e a
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcCaretWidth NumericFieldCfg s e a
t1,
    _nfcCaretMs :: Maybe Int
_nfcCaretMs = NumericFieldCfg s e a -> Maybe Int
forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcCaretMs NumericFieldCfg s e a
t2 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe Int
forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcCaretMs NumericFieldCfg s e a
t1,
    _nfcValid :: Maybe (WidgetData s Bool)
_nfcValid = NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
forall s e a. NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
_nfcValid NumericFieldCfg s e a
t2 Maybe (WidgetData s Bool)
-> Maybe (WidgetData s Bool) -> Maybe (WidgetData s Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
forall s e a. NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
_nfcValid NumericFieldCfg s e a
t1,
    _nfcValidV :: [Bool -> e]
_nfcValidV = NumericFieldCfg s e a -> [Bool -> e]
forall s e a. NumericFieldCfg s e a -> [Bool -> e]
_nfcValidV NumericFieldCfg s e a
t1 [Bool -> e] -> [Bool -> e] -> [Bool -> e]
forall a. Semigroup a => a -> a -> a
<> NumericFieldCfg s e a -> [Bool -> e]
forall s e a. NumericFieldCfg s e a -> [Bool -> e]
_nfcValidV NumericFieldCfg s e a
t2,
    _nfcDecimals :: Maybe Int
_nfcDecimals = NumericFieldCfg s e a -> Maybe Int
forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals NumericFieldCfg s e a
t2 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe Int
forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals NumericFieldCfg s e a
t1,
    _nfcMinValue :: Maybe a
_nfcMinValue = NumericFieldCfg s e a -> Maybe a
forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue NumericFieldCfg s e a
t2 Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe a
forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue NumericFieldCfg s e a
t1,
    _nfcMaxValue :: Maybe a
_nfcMaxValue = NumericFieldCfg s e a -> Maybe a
forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue NumericFieldCfg s e a
t2 Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe a
forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue NumericFieldCfg s e a
t1,
    _nfcWheelRate :: Maybe Double
_nfcWheelRate = NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate NumericFieldCfg s e a
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate NumericFieldCfg s e a
t1,
    _nfcDragRate :: Maybe Double
_nfcDragRate = NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate NumericFieldCfg s e a
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate NumericFieldCfg s e a
t1,
    _nfcResizeOnChange :: Maybe Bool
_nfcResizeOnChange = NumericFieldCfg s e a -> Maybe Bool
forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcResizeOnChange NumericFieldCfg s e a
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe Bool
forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcResizeOnChange NumericFieldCfg s e a
t1,
    _nfcSelectOnFocus :: Maybe Bool
_nfcSelectOnFocus = NumericFieldCfg s e a -> Maybe Bool
forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcSelectOnFocus NumericFieldCfg s e a
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe Bool
forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcSelectOnFocus NumericFieldCfg s e a
t1,
    _nfcOnFocusReq :: [Path -> WidgetRequest s e]
_nfcOnFocusReq = NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnFocusReq NumericFieldCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnFocusReq NumericFieldCfg s e a
t2,
    _nfcOnBlurReq :: [Path -> WidgetRequest s e]
_nfcOnBlurReq = NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnBlurReq NumericFieldCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnBlurReq NumericFieldCfg s e a
t2,
    _nfcOnChangeReq :: [a -> WidgetRequest s e]
_nfcOnChangeReq = NumericFieldCfg s e a -> [a -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [a -> WidgetRequest s e]
_nfcOnChangeReq NumericFieldCfg s e a
t1 [a -> WidgetRequest s e]
-> [a -> WidgetRequest s e] -> [a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> NumericFieldCfg s e a -> [a -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [a -> WidgetRequest s e]
_nfcOnChangeReq NumericFieldCfg s e a
t2
  }

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

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

instance CmbCaretMs (NumericFieldCfg s e a) Int where
  caretMs :: Int -> NumericFieldCfg s e a
caretMs Int
ms = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcCaretMs :: Maybe Int
_nfcCaretMs = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ms
  }

instance CmbValidInput (NumericFieldCfg s e a) s where
  validInput :: ALens' s Bool -> NumericFieldCfg s e a
validInput ALens' s Bool
field = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcValid :: Maybe (WidgetData s Bool)
_nfcValid = 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 (NumericFieldCfg s e a) e where
  validInputV :: (Bool -> e) -> NumericFieldCfg s e a
validInputV Bool -> e
fn = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcValidV :: [Bool -> e]
_nfcValidV = [Bool -> e
fn]
  }

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

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

instance FormattableNumber a => CmbMinValue (NumericFieldCfg s e a) a where
  minValue :: a -> NumericFieldCfg s e a
minValue a
len = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcMinValue :: Maybe a
_nfcMinValue = a -> Maybe a
forall a. a -> Maybe a
Just a
len
  }

instance FormattableNumber a => CmbMaxValue (NumericFieldCfg s e a) a where
  maxValue :: a -> NumericFieldCfg s e a
maxValue a
len = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcMaxValue :: Maybe a
_nfcMaxValue = a -> Maybe a
forall a. a -> Maybe a
Just a
len
  }

instance CmbWheelRate (NumericFieldCfg s e a) Double where
  wheelRate :: Double -> NumericFieldCfg s e a
wheelRate Double
rate = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcWheelRate :: Maybe Double
_nfcWheelRate = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
rate
  }

instance CmbDragRate (NumericFieldCfg s e a) Double where
  dragRate :: Double -> NumericFieldCfg s e a
dragRate Double
rate = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcDragRate :: Maybe Double
_nfcDragRate = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
rate
  }

instance CmbDecimals (NumericFieldCfg s e a) where
  decimals :: Int -> NumericFieldCfg s e a
decimals Int
num = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcDecimals :: Maybe Int
_nfcDecimals = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
num
  }

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

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

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

-- | Creates a numeric field using the given lens.
numericField
  :: (FormattableNumber a, WidgetEvent e)
  => ALens' s a -> WidgetNode s e
numericField :: ALens' s a -> WidgetNode s e
numericField ALens' s a
field = ALens' s a -> [NumericFieldCfg s e a] -> WidgetNode s e
forall a e s.
(FormattableNumber a, WidgetEvent e) =>
ALens' s a -> [NumericFieldCfg s e a] -> WidgetNode s e
numericField_ ALens' s a
field [NumericFieldCfg s e a]
forall a. Default a => a
def

-- | Creates a numeric field using the given lens. Accepts config.
numericField_
  :: (FormattableNumber a, WidgetEvent e)
  => ALens' s a
  -> [NumericFieldCfg s e a]
  -> WidgetNode s e
numericField_ :: ALens' s a -> [NumericFieldCfg s e a] -> WidgetNode s e
numericField_ ALens' s a
field [NumericFieldCfg s e a]
configs = WidgetNode s e
widget where
  widget :: WidgetNode s e
widget = WidgetData s a -> [NumericFieldCfg s e a] -> WidgetNode s e
forall s e a.
(FormattableNumber a, WidgetEvent e) =>
WidgetData s a -> [NumericFieldCfg s e a] -> WidgetNode s e
numericFieldD_ (ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) [NumericFieldCfg s e a]
configs

-- | Creates a numeric field using the given value and 'onChange' event handler.
numericFieldV
  :: (FormattableNumber a, WidgetEvent e)
  => a -> (a -> e) -> WidgetNode s e
numericFieldV :: a -> (a -> e) -> WidgetNode s e
numericFieldV a
value a -> e
handler = a -> (a -> e) -> [NumericFieldCfg s e a] -> WidgetNode s e
forall a e s.
(FormattableNumber a, WidgetEvent e) =>
a -> (a -> e) -> [NumericFieldCfg s e a] -> WidgetNode s e
numericFieldV_ a
value a -> e
handler [NumericFieldCfg s e a]
forall a. Default a => a
def

-- | Creates a numeric field using the given value and 'onChange' event handler.
--   Accepts config.
numericFieldV_
  :: (FormattableNumber a, WidgetEvent e)
  => a
  -> (a -> e)
  -> [NumericFieldCfg s e a]
  -> WidgetNode s e
numericFieldV_ :: a -> (a -> e) -> [NumericFieldCfg s e a] -> WidgetNode s e
numericFieldV_ a
value a -> e
handler [NumericFieldCfg s e a]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s a
widgetData = a -> WidgetData s a
forall s a. a -> WidgetData s a
WidgetValue a
value
  newConfigs :: [NumericFieldCfg s e a]
newConfigs = (a -> e) -> NumericFieldCfg s e a
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler NumericFieldCfg s e a
-> [NumericFieldCfg s e a] -> [NumericFieldCfg s e a]
forall a. a -> [a] -> [a]
: [NumericFieldCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = WidgetData s a -> [NumericFieldCfg s e a] -> WidgetNode s e
forall s e a.
(FormattableNumber a, WidgetEvent e) =>
WidgetData s a -> [NumericFieldCfg s e a] -> WidgetNode s e
numericFieldD_ WidgetData s a
forall s. WidgetData s a
widgetData [NumericFieldCfg s e a]
newConfigs

-- | Creates a numeric field providing a 'WidgetData' instance and config.
numericFieldD_
  :: forall s e a . (FormattableNumber a, WidgetEvent e)
  => WidgetData s a
  -> [NumericFieldCfg s e a]
  -> WidgetNode s e
numericFieldD_ :: WidgetData s a -> [NumericFieldCfg s e a] -> WidgetNode s e
numericFieldD_ WidgetData s a
widgetData [NumericFieldCfg s e a]
configs = WidgetNode s e
newNode where
  config :: NumericFieldCfg s e a
config = [NumericFieldCfg s e a] -> NumericFieldCfg s e a
forall a. Monoid a => [a] -> a
mconcat [NumericFieldCfg s e a]
configs
  minVal :: Maybe a
minVal = NumericFieldCfg s e a -> Maybe a
forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue NumericFieldCfg s e a
config
  maxVal :: Maybe a
maxVal = NumericFieldCfg s e a -> Maybe a
forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue NumericFieldCfg s e a
config

  initialValue :: a
initialValue
    | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
minVal = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
minVal
    | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
maxVal = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
maxVal
    | Bool
otherwise = Double -> a
forall a b.
(NumericTextConverter a, Real b, Fractional b) =>
b -> a
numericFromFractional Double
0
  decimals :: Int
decimals
    | a -> Bool
forall a. Typeable a => a -> Bool
isIntegral a
initialValue = Int
0
    | Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
2 (NumericFieldCfg s e a -> Maybe Int
forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals NumericFieldCfg s e a
config)
  defWidth :: Double
defWidth
    | a -> Bool
forall a. Typeable a => a -> Bool
isIntegral a
initialValue = Double
50
    | Bool
otherwise = Double
70

  acceptText :: Text -> (Bool, Bool, Maybe a)
acceptText = Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
forall a.
NumericTextConverter a =>
Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
numericAcceptText Maybe a
minVal Maybe a
maxVal Int
decimals
  acceptInput :: Text -> Bool
acceptInput Text
text = Text -> (Bool, Bool, Maybe a)
acceptText Text
text (Bool, Bool, Maybe a)
-> Getting Bool (Bool, Bool, Maybe a) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (Bool, Bool, Maybe a) Bool
forall s t a b. Field1 s t a b => Lens s t a b
_1
  validInput :: Text -> Bool
validInput Text
text = Text -> (Bool, Bool, Maybe a)
acceptText Text
text (Bool, Bool, Maybe a)
-> Getting Bool (Bool, Bool, Maybe a) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (Bool, Bool, Maybe a) Bool
forall s t a b. Field2 s t a b => Lens s t a b
_2
  fromText :: Text -> Maybe a
fromText Text
text = Text -> (Bool, Bool, Maybe a)
acceptText Text
text (Bool, Bool, Maybe a)
-> Getting (Maybe a) (Bool, Bool, Maybe a) (Maybe a) -> Maybe a
forall s a. s -> Getting a s a -> a
^. Getting (Maybe a) (Bool, Bool, Maybe a) (Maybe a)
forall s t a b. Field3 s t a b => Lens s t a b
_3
  toText :: a -> Text
toText = Int -> a -> Text
forall a. NumericTextConverter a => Int -> a -> Text
numericToText Int
decimals

  inputConfig :: InputFieldCfg s e a
inputConfig = InputFieldCfg :: forall s e a.
Maybe Text
-> a
-> WidgetData s a
-> Maybe (WidgetData s Bool)
-> [Bool -> e]
-> Bool
-> Double
-> Maybe Double
-> Maybe Int
-> Maybe Char
-> 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 = Maybe Text
forall a. Maybe a
Nothing,
    _ifcInitialValue :: a
_ifcInitialValue = a
initialValue,
    _ifcValue :: WidgetData s a
_ifcValue = WidgetData s a
widgetData,
    _ifcValid :: Maybe (WidgetData s Bool)
_ifcValid = NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
forall s e a. NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
_nfcValid NumericFieldCfg s e a
config,
    _ifcValidV :: [Bool -> e]
_ifcValidV = NumericFieldCfg s e a -> [Bool -> e]
forall s e a. NumericFieldCfg s e a -> [Bool -> e]
_nfcValidV NumericFieldCfg s e a
config,
    _ifcFromText :: Text -> Maybe a
_ifcFromText = Text -> Maybe a
fromText,
    _ifcToText :: a -> Text
_ifcToText = a -> Text
toText,
    _ifcAcceptInput :: Text -> Bool
_ifcAcceptInput = Text -> Bool
acceptInput,
    _ifcIsValidInput :: Text -> Bool
_ifcIsValidInput = Text -> Bool
validInput,
    _ifcDefCursorEnd :: Bool
_ifcDefCursorEnd = Bool
False,
    _ifcDefWidth :: Double
_ifcDefWidth = Double
defWidth,
    _ifcCaretWidth :: Maybe Double
_ifcCaretWidth = NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcCaretWidth NumericFieldCfg s e a
config,
    _ifcCaretMs :: Maybe Int
_ifcCaretMs = NumericFieldCfg s e a -> Maybe Int
forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcCaretMs NumericFieldCfg s e a
config,
    _ifcDisplayChar :: Maybe Char
_ifcDisplayChar = Maybe Char
forall a. Maybe a
Nothing,
    _ifcResizeOnChange :: Bool
_ifcResizeOnChange = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (NumericFieldCfg s e a -> Maybe Bool
forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcResizeOnChange NumericFieldCfg s e a
config),
    _ifcSelectOnFocus :: Bool
_ifcSelectOnFocus = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (NumericFieldCfg s e a -> Maybe Bool
forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcSelectOnFocus NumericFieldCfg s e a
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. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle,
    _ifcWheelHandler :: Maybe (InputWheelHandler a)
_ifcWheelHandler = InputWheelHandler a -> Maybe (InputWheelHandler a)
forall a. a -> Maybe a
Just (NumericFieldCfg s e a -> InputWheelHandler a
forall a s e.
FormattableNumber a =>
NumericFieldCfg s e a
-> InputFieldState a
-> Point
-> Point
-> WheelDirection
-> (Text, Int, Maybe Int)
handleWheel NumericFieldCfg s e a
config),
    _ifcDragHandler :: Maybe (InputDragHandler a)
_ifcDragHandler = InputDragHandler a -> Maybe (InputDragHandler a)
forall a. a -> Maybe a
Just (NumericFieldCfg s e a -> InputDragHandler a
forall a s e.
FormattableNumber a =>
NumericFieldCfg s e a
-> InputFieldState a -> Point -> Point -> (Text, Int, Maybe Int)
handleDrag NumericFieldCfg s e a
config),
    _ifcDragCursor :: Maybe CursorIcon
_ifcDragCursor = CursorIcon -> Maybe CursorIcon
forall a. a -> Maybe a
Just CursorIcon
CursorSizeV,
    _ifcOnFocusReq :: [Path -> WidgetRequest s e]
_ifcOnFocusReq = NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnFocusReq NumericFieldCfg s e a
config,
    _ifcOnBlurReq :: [Path -> WidgetRequest s e]
_ifcOnBlurReq = NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnBlurReq NumericFieldCfg s e a
config,
    _ifcOnChangeReq :: [a -> WidgetRequest s e]
_ifcOnChangeReq = NumericFieldCfg s e a -> [a -> WidgetRequest s e]
forall s e a. NumericFieldCfg s e a -> [a -> WidgetRequest s e]
_nfcOnChangeReq NumericFieldCfg s e a
config
  }
  newNode :: WidgetNode s e
newNode = WidgetType -> InputFieldCfg s e a -> WidgetNode s e
forall a e s.
(InputFieldValue a, WidgetEvent e) =>
WidgetType -> InputFieldCfg s e a -> WidgetNode s e
inputField_ WidgetType
"numericField" InputFieldCfg s e a
inputConfig

handleWheel
  :: FormattableNumber a
  => NumericFieldCfg s e a
  -> InputFieldState a
  -> Point
  -> Point
  -> WheelDirection
  -> (Text, Int, Maybe Int)
handleWheel :: NumericFieldCfg s e a
-> InputFieldState a
-> Point
-> Point
-> WheelDirection
-> (Text, Int, Maybe Int)
handleWheel NumericFieldCfg s e a
config InputFieldState a
state Point
point Point
move WheelDirection
dir = (Text, Int, Maybe Int)
result where
  Point Double
_ Double
dy = Point
move
  sign :: Double
sign = if WheelDirection
dir WheelDirection -> WheelDirection -> Bool
forall a. Eq a => a -> a -> Bool
== WheelDirection
WheelNormal then Double
1 else -Double
1
  curValue :: a
curValue = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state
  wheelRate :: Double
wheelRate
    | a -> Bool
forall a. Typeable a => a -> Bool
isIntegral a
curValue = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate NumericFieldCfg s e a
config)
    | Bool
otherwise = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.1 (NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate NumericFieldCfg s e a
config)
  result :: (Text, Int, Maybe Int)
result = NumericFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
forall s e a.
FormattableNumber a =>
NumericFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove NumericFieldCfg s e a
config InputFieldState a
state Double
wheelRate a
curValue (Double
dy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sign)

handleDrag
  :: FormattableNumber a
  => NumericFieldCfg s e a
  -> InputFieldState a
  -> Point
  -> Point
  -> (Text, Int, Maybe Int)
handleDrag :: NumericFieldCfg s e a
-> InputFieldState a -> Point -> Point -> (Text, Int, Maybe Int)
handleDrag NumericFieldCfg s e a
config InputFieldState a
state Point
clickPos Point
currPos = (Text, Int, Maybe Int)
result where
  Point Double
_ Double
dy = Point -> Point -> Point
subPoint Point
clickPos Point
currPos
  selValue :: a
selValue = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsDragSelValue InputFieldState a
state
  dragRate :: Double
dragRate
    | a -> Bool
forall a. Typeable a => a -> Bool
isIntegral a
selValue = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate NumericFieldCfg s e a
config)
    | Bool
otherwise = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.1 (NumericFieldCfg s e a -> Maybe Double
forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate NumericFieldCfg s e a
config)
  result :: (Text, Int, Maybe Int)
result = NumericFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
forall s e a.
FormattableNumber a =>
NumericFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove NumericFieldCfg s e a
config InputFieldState a
state Double
dragRate a
selValue Double
dy

handleMove
  :: forall s e a . FormattableNumber a
  => NumericFieldCfg s e a
  -> InputFieldState a
  -> Double
  -> a
  -> Double
  -> (Text, Int, Maybe Int)
handleMove :: NumericFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove NumericFieldCfg s e a
config InputFieldState a
state Double
rate a
value Double
dy = (Text, Int, Maybe Int)
result where
  decimals :: Int
decimals
    | a -> Bool
forall a. Typeable a => a -> Bool
isIntegral a
value = Int
0
    | Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
2 (NumericFieldCfg s e a -> Maybe Int
forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals NumericFieldCfg s e a
config)
  minVal :: Maybe a
minVal = NumericFieldCfg s e a -> Maybe a
forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue NumericFieldCfg s e a
config
  maxVal :: Maybe a
maxVal = NumericFieldCfg s e a -> Maybe a
forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue NumericFieldCfg s e a
config

  acceptText :: Text -> (Bool, Bool, Maybe a)
acceptText = Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
forall a.
NumericTextConverter a =>
Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
numericAcceptText Maybe a
minVal Maybe a
maxVal Int
decimals
  fromText :: Text -> Maybe a
fromText Text
text = Text -> (Bool, Bool, Maybe a)
acceptText Text
text (Bool, Bool, Maybe a)
-> Getting (Maybe a) (Bool, Bool, Maybe a) (Maybe a) -> Maybe a
forall s a. s -> Getting a s a -> a
^. Getting (Maybe a) (Bool, Bool, Maybe a) (Maybe a)
forall s t a b. Field3 s t a b => Lens s t a b
_3
  toText :: Int -> a -> Text
toText = Int -> a -> Text
forall a. NumericTextConverter a => Int -> a -> Text
numericToText

  (Bool
valid, Maybe a
mParsedVal, a
parsedVal) = case a -> Maybe Double
forall a b. (NumericTextConverter a, Fractional b) => a -> Maybe b
numericToFractional a
value of
    Just Double
val -> (Bool
True, Maybe a
mParsedVal, a
parsedVal) where
      tmpValue :: Double
tmpValue = Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
rate
      mParsedVal :: Maybe a
mParsedVal = Text -> Maybe a
fromText (Int -> a -> Text
toText Int
decimals (Double -> a
forall a b.
(NumericTextConverter a, Real b, Fractional b) =>
b -> a
numericFromFractional Double
tmpValue))
      parsedVal :: a
parsedVal = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
mParsedVal
    Maybe Double
Nothing -> (Bool
False, Maybe a
forall a. Maybe a
Nothing, a
forall a. HasCallStack => a
undefined)
  newVal :: a
newVal
    | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
mParsedVal = a
parsedVal
    | Bool
valid Bool -> Bool -> Bool
&& Double
dy Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
maxVal = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
maxVal
    | Bool
valid Bool -> Bool -> Bool
&& Double
dy Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
minVal = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
minVal
    | Bool
otherwise = InputFieldState a -> a
forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state

  newText :: Text
newText = Int -> a -> Text
toText Int
decimals a
newVal
  newPos :: Int
newPos = InputFieldState a -> Int
forall a. InputFieldState a -> Int
_ifsCursorPos InputFieldState a
state
  newSel :: Maybe Int
newSel = InputFieldState a -> Maybe Int
forall a. InputFieldState a -> Maybe Int
_ifsSelStart InputFieldState a
state
  result :: (Text, Int, Maybe Int)
result = (Text
newText, Int
newPos, Maybe Int
newSel)

acceptNumberInput :: Int -> Text -> Bool
acceptNumberInput :: Int -> Text -> Bool
acceptNumberInput Int
decimals Text
text = Either String Text -> Bool
forall a b. Either a b -> Bool
isRight (Parser Text -> Text -> Either String Text
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Text
parser Text
text) where
  sign :: Parser Text
sign = Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Text
"" (Char -> Parser Text
P.single Char
'-')
  number :: Parser Text
number = (Char -> Bool) -> Parser Text
A.takeWhile Char -> Bool
isDigit
  digit :: Parser Text
digit = Char -> Text
T.singleton (Char -> Text) -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char
A.digit
  dot :: Parser Text
dot = Char -> Parser Text
P.single Char
'.'
  dots :: Int
dots = if Int
decimals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
1 else Int
0
  rest :: Parser Text
rest = [Parser Text] -> Parser Text
P.join [Int -> Parser Text -> Parser Text
P.upto Int
dots Parser Text
dot, Int -> Parser Text -> Parser Text
P.upto Int
decimals Parser Text
digit]
  parser :: Parser Text
parser = [Parser Text] -> Parser Text
P.join [Parser Text
sign, Parser Text
number, Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Text
"" Parser Text
rest] Parser Text -> Parser Text () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput

numberInBounds :: Ord a => Maybe a -> Maybe a -> a -> Bool
numberInBounds :: Maybe a -> Maybe a -> a -> Bool
numberInBounds Maybe a
Nothing Maybe a
Nothing a
_ = Bool
True
numberInBounds (Just a
minVal) Maybe a
Nothing a
val = a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
minVal
numberInBounds Maybe a
Nothing (Just a
maxVal) a
val = a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
maxVal
numberInBounds (Just a
minVal) (Just a
maxVal) a
val = a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
minVal Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
maxVal

isIntegral :: Typeable a => a -> Bool
isIntegral :: a -> Bool
isIntegral a
val
  | String
"Int" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name = Bool
True
  | String
"Fixed" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name = Bool
True
  | String
"Word" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
name = Bool
True
  | Bool
otherwise = Bool
False
  where
    typeName :: String
typeName = TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
val)
    name :: String
name
      | String
"Maybe " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
typeName = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
6 String
typeName
      | Bool
otherwise = String
typeName