{-|
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, with support for valid ranges and decimal places.

@
numericField numericLens
@

With configuration options:

@
numericField_ numericLens [minValue 0, maxValue 100, decimals 2]
@

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_,
  numericFieldD_
) 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 TextShow

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'. Implementing this typeclass
is not necessary for instances of 'FromFractional'.
-}
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.
- 'readOnly': Whether to prevent the user changing the input text.
- '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 Millisecond
_nfcCaretMs :: Maybe Millisecond,
  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 -> Maybe Bool
_nfcReadOnly :: 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 Millisecond
-> Maybe (WidgetData s Bool)
-> [Bool -> e]
-> Maybe Int
-> Maybe a
-> Maybe a
-> Maybe Double
-> Maybe Double
-> Maybe Bool
-> 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 Millisecond
_nfcCaretMs = Maybe Millisecond
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,
    _nfcReadOnly :: Maybe Bool
_nfcReadOnly = 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 Millisecond
-> Maybe (WidgetData s Bool)
-> [Bool -> e]
-> Maybe Int
-> Maybe a
-> Maybe a
-> Maybe Double
-> Maybe Double
-> Maybe Bool
-> 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 Millisecond
_nfcCaretMs = NumericFieldCfg s e a -> Maybe Millisecond
forall s e a. NumericFieldCfg s e a -> Maybe Millisecond
_nfcCaretMs NumericFieldCfg s e a
t2 Maybe Millisecond -> Maybe Millisecond -> Maybe Millisecond
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumericFieldCfg s e a -> Maybe Millisecond
forall s e a. NumericFieldCfg s e a -> Maybe Millisecond
_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,
    _nfcReadOnly :: Maybe Bool
_nfcReadOnly = NumericFieldCfg s e a -> Maybe Bool
forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcReadOnly 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
_nfcReadOnly 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) Millisecond where
  caretMs :: Millisecond -> NumericFieldCfg s e a
caretMs Millisecond
ms = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcCaretMs :: Maybe Millisecond
_nfcCaretMs = Millisecond -> Maybe Millisecond
forall a. a -> Maybe a
Just Millisecond
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 CmbReadOnly (NumericFieldCfg s e a) where
  readOnly_ :: Bool -> NumericFieldCfg s e a
readOnly_ Bool
ro = NumericFieldCfg s e a
forall a. Default a => a
def {
    _nfcReadOnly :: Maybe Bool
_nfcReadOnly = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
ro
  }

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

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

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
  readOnly :: Bool
readOnly = 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
_nfcReadOnly 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 = case NumericFieldCfg s e a -> Maybe Int
forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals NumericFieldCfg s e a
config of
    Just Int
count -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
count
    Maybe Int
Nothing
      | a -> Bool
forall a. Typeable a => a -> Bool
isIntegral a
initialValue -> Int
0
      | Bool
otherwise -> Int
2
  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 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 = 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 Millisecond
_ifcCaretMs = NumericFieldCfg s e a -> Maybe Millisecond
forall s e a. NumericFieldCfg s e a -> Maybe Millisecond
_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),
    _ifcReadOnly :: Bool
_ifcReadOnly = Bool
readOnly,
    _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 = if Bool
readOnly then Maybe (InputWheelHandler a)
forall a. Maybe a
Nothing else 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 = if Bool
readOnly then Maybe (InputDragHandler a)
forall a. Maybe a
Nothing else 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
  }
  wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"numericField-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. TextShow a => a -> Text
showt (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
initialValue))
  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
wtype 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
"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