{-|
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 = forall a. NumericTextConverter a => Text -> Maybe a
numericFromText Text
text
    isValid :: Bool
isValid = forall a. Maybe a -> Bool
isJust Maybe a
parsed Bool -> Bool -> Bool
&& forall a. Ord a => Maybe a -> Maybe a -> a -> Bool
numberInBounds Maybe a
minVal Maybe a
maxVal (forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
parsed)
    fromText :: Maybe a
fromText
      | Bool
isValid = Maybe a
parsed
      | Bool
otherwise = 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 forall a. Num a => Reader a -> Reader a
signed forall a. Fractional a => Reader a
rational Text
text of
    Right (Rational
frac :: Rational, Text
_) -> forall a. a -> Maybe a
Just (forall a b. (FromFractional a, Real b, Fractional b) => b -> a
fromFractional Rational
frac)
    Either String (Rational, Text)
_ -> forall a. Maybe a
Nothing
  numericToText :: Int -> a -> Text
numericToText Int
decimals a
value = forall a. Format Text a -> a
F.sformat (forall a r. Real a => Int -> Format r (a -> r)
F.fixed Int
decimals) a
value
  numericToFractional :: forall b. Fractional b => a -> Maybe b
numericToFractional = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac
  numericFromFractional :: forall b. (Real b, Fractional b) => b -> a
numericFromFractional = 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 forall a. Eq a => a -> a -> Bool
== Text
"" = (Bool
True, Bool
True, forall a. a -> Maybe a
Just forall a. Maybe a
Nothing)
    | Bool
otherwise = (Bool
accept, Bool
isValid, Maybe (Maybe a)
result) where
      resp :: (Bool, Bool, Maybe a)
resp = forall a.
NumericTextConverter a =>
Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
numericAcceptText (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe a)
minVal) (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
        | forall a. Maybe a -> Bool
isJust Maybe a
tmpResult = forall a. a -> Maybe a
Just Maybe a
tmpResult
        | Bool
otherwise = forall a. Maybe a
Nothing
  numericFromText :: Text -> Maybe (Maybe a)
numericFromText = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a. NumericTextConverter a => Int -> a -> Text
numericToText Int
decimals a
value
  numericToFractional :: forall b. Fractional b => Maybe a -> Maybe b
numericToFractional Maybe a
Nothing = forall a. Maybe a
Nothing
  numericToFractional (Just a
value) = forall a b. (NumericTextConverter a, Fractional b) => a -> Maybe b
numericToFractional a
value
  numericFromFractional :: forall b. (Real b, Fractional b) => b -> Maybe a
numericFromFractional = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 {
  forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcCaretWidth :: Maybe Double,
  forall s e a. NumericFieldCfg s e a -> Maybe Millisecond
_nfcCaretMs :: Maybe Millisecond,
  forall s e a. NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
_nfcValid :: Maybe (WidgetData s Bool),
  forall s e a. NumericFieldCfg s e a -> [Bool -> e]
_nfcValidV :: [Bool -> e],
  forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals :: Maybe Int,
  forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue :: Maybe a,
  forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue :: Maybe a,
  forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate :: Maybe Double,
  forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate :: Maybe Double,
  forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcResizeOnChange :: Maybe Bool,
  forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcSelectOnFocus :: Maybe Bool,
  forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcReadOnly :: Maybe Bool,
  forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e a. 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 {
    _nfcCaretWidth :: Maybe Double
_nfcCaretWidth = forall a. Maybe a
Nothing,
    _nfcCaretMs :: Maybe Millisecond
_nfcCaretMs = forall a. Maybe a
Nothing,
    _nfcValid :: Maybe (WidgetData s Bool)
_nfcValid = forall a. Maybe a
Nothing,
    _nfcValidV :: [Bool -> e]
_nfcValidV = [],
    _nfcDecimals :: Maybe Int
_nfcDecimals = forall a. Maybe a
Nothing,
    _nfcMinValue :: Maybe a
_nfcMinValue = forall a. Maybe a
Nothing,
    _nfcMaxValue :: Maybe a
_nfcMaxValue = forall a. Maybe a
Nothing,
    _nfcWheelRate :: Maybe Double
_nfcWheelRate = forall a. Maybe a
Nothing,
    _nfcDragRate :: Maybe Double
_nfcDragRate = forall a. Maybe a
Nothing,
    _nfcResizeOnChange :: Maybe Bool
_nfcResizeOnChange = forall a. Maybe a
Nothing,
    _nfcSelectOnFocus :: Maybe Bool
_nfcSelectOnFocus = forall a. Maybe a
Nothing,
    _nfcReadOnly :: Maybe Bool
_nfcReadOnly = 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 {
    _nfcCaretWidth :: Maybe Double
_nfcCaretWidth = forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcCaretWidth NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcCaretWidth NumericFieldCfg s e a
t1,
    _nfcCaretMs :: Maybe Millisecond
_nfcCaretMs = forall s e a. NumericFieldCfg s e a -> Maybe Millisecond
_nfcCaretMs NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe Millisecond
_nfcCaretMs NumericFieldCfg s e a
t1,
    _nfcValid :: Maybe (WidgetData s Bool)
_nfcValid = forall s e a. NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
_nfcValid NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
_nfcValid NumericFieldCfg s e a
t1,
    _nfcValidV :: [Bool -> e]
_nfcValidV = forall s e a. NumericFieldCfg s e a -> [Bool -> e]
_nfcValidV NumericFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. NumericFieldCfg s e a -> [Bool -> e]
_nfcValidV NumericFieldCfg s e a
t2,
    _nfcDecimals :: Maybe Int
_nfcDecimals = forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals NumericFieldCfg s e a
t1,
    _nfcMinValue :: Maybe a
_nfcMinValue = forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue NumericFieldCfg s e a
t1,
    _nfcMaxValue :: Maybe a
_nfcMaxValue = forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue NumericFieldCfg s e a
t1,
    _nfcWheelRate :: Maybe Double
_nfcWheelRate = forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate NumericFieldCfg s e a
t1,
    _nfcDragRate :: Maybe Double
_nfcDragRate = forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate NumericFieldCfg s e a
t1,
    _nfcResizeOnChange :: Maybe Bool
_nfcResizeOnChange = forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcResizeOnChange NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcResizeOnChange NumericFieldCfg s e a
t1,
    _nfcReadOnly :: Maybe Bool
_nfcReadOnly = forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcReadOnly NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcReadOnly NumericFieldCfg s e a
t1,
    _nfcSelectOnFocus :: Maybe Bool
_nfcSelectOnFocus = forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcSelectOnFocus NumericFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcSelectOnFocus NumericFieldCfg s e a
t1,
    _nfcOnFocusReq :: [Path -> WidgetRequest s e]
_nfcOnFocusReq = forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnFocusReq NumericFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnFocusReq NumericFieldCfg s e a
t2,
    _nfcOnBlurReq :: [Path -> WidgetRequest s e]
_nfcOnBlurReq = forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnBlurReq NumericFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnBlurReq NumericFieldCfg s e a
t2,
    _nfcOnChangeReq :: [a -> WidgetRequest s e]
_nfcOnChangeReq = forall s e a. NumericFieldCfg s e a -> [a -> WidgetRequest s e]
_nfcOnChangeReq NumericFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> 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 = forall a. Default a => a
def

instance CmbCaretWidth (NumericFieldCfg s e a) Double where
  caretWidth :: Double -> NumericFieldCfg s e a
caretWidth Double
w = forall a. Default a => a
def {
    _nfcCaretWidth :: Maybe Double
_nfcCaretWidth = 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 = forall a. Default a => a
def {
    _nfcCaretMs :: Maybe Millisecond
_nfcCaretMs = 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 = forall a. Default a => a
def {
    _nfcValid :: Maybe (WidgetData s Bool)
_nfcValid = forall a. a -> Maybe a
Just (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 = 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 = forall a. Default a => a
def {
    _nfcResizeOnChange :: Maybe Bool
_nfcResizeOnChange = forall a. a -> Maybe a
Just Bool
resize
  }

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

instance CmbReadOnly (NumericFieldCfg s e a) where
  readOnly_ :: Bool -> NumericFieldCfg s e a
readOnly_ Bool
ro = forall a. Default a => a
def {
    _nfcReadOnly :: Maybe Bool
_nfcReadOnly = 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 = forall a. Default a => a
def {
    _nfcMinValue :: Maybe a
_nfcMinValue = 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 = forall a. Default a => a
def {
    _nfcMaxValue :: Maybe a
_nfcMaxValue = 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 = forall a. Default a => a
def {
    _nfcWheelRate :: Maybe Double
_nfcWheelRate = 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 = forall a. Default a => a
def {
    _nfcDragRate :: Maybe Double
_nfcDragRate = forall a. a -> Maybe a
Just Double
rate
  }

instance CmbDecimals (NumericFieldCfg s e a) where
  decimals :: Int -> NumericFieldCfg s e a
decimals Int
num = forall a. Default a => a
def {
    _nfcDecimals :: Maybe Int
_nfcDecimals = 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 = forall a. Default a => a
def {
    _nfcOnFocusReq :: [Path -> WidgetRequest s e]
_nfcOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
    _nfcOnBlurReq :: [Path -> WidgetRequest s e]
_nfcOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
    _nfcOnChangeReq :: [a -> WidgetRequest s e]
_nfcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 :: forall a e s.
(FormattableNumber a, WidgetEvent e) =>
ALens' s a -> WidgetNode s e
numericField ALens' s a
field = forall a e s.
(FormattableNumber a, WidgetEvent e) =>
ALens' s a -> [NumericFieldCfg s e a] -> WidgetNode s e
numericField_ ALens' s a
field 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_ :: 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]
configs = WidgetNode s e
widget where
  widget :: WidgetNode s e
widget = forall s e a.
(FormattableNumber a, WidgetEvent e) =>
WidgetData s a -> [NumericFieldCfg s e a] -> WidgetNode s e
numericFieldD_ (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 :: forall a e s.
(FormattableNumber a, WidgetEvent e) =>
a -> (a -> e) -> WidgetNode s e
numericFieldV a
value a -> e
handler = forall a e s.
(FormattableNumber a, WidgetEvent e) =>
a -> (a -> e) -> [NumericFieldCfg s e a] -> WidgetNode s e
numericFieldV_ a
value a -> e
handler 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_ :: 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]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s a
widgetData = forall s a. a -> WidgetData s a
WidgetValue a
value
  newConfigs :: [NumericFieldCfg s e a]
newConfigs = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler forall a. a -> [a] -> [a]
: [NumericFieldCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = forall s e a.
(FormattableNumber a, WidgetEvent e) =>
WidgetData s a -> [NumericFieldCfg s e a] -> WidgetNode s e
numericFieldD_ 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_ :: forall s e a.
(FormattableNumber a, WidgetEvent e) =>
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 = forall a. Monoid a => [a] -> a
mconcat [NumericFieldCfg s e a]
configs
  minVal :: Maybe a
minVal = forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue NumericFieldCfg s e a
config
  maxVal :: Maybe a
maxVal = forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue NumericFieldCfg s e a
config
  readOnly :: Bool
readOnly = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcReadOnly NumericFieldCfg s e a
config)

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

  acceptText :: Text -> (Bool, Bool, Maybe a)
acceptText = 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 forall s a. s -> Getting a s a -> a
^. 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 forall s a. s -> Getting a s a -> a
^. 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 forall s a. s -> Getting a s a -> a
^. forall s t a b. Field3 s t a b => Lens s t a b
_3
  toText :: a -> Text
toText = forall a. NumericTextConverter a => Int -> a -> Text
numericToText Int
decimals

  inputConfig :: InputFieldCfg s e a
inputConfig = InputFieldCfg {
    _ifcPlaceholder :: Maybe Text
_ifcPlaceholder = 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 = forall s e a. NumericFieldCfg s e a -> Maybe (WidgetData s Bool)
_nfcValid NumericFieldCfg s e a
config,
    _ifcValidV :: [Bool -> e]
_ifcValidV = 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 = forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcCaretWidth NumericFieldCfg s e a
config,
    _ifcCaretMs :: Maybe Millisecond
_ifcCaretMs = forall s e a. NumericFieldCfg s e a -> Maybe Millisecond
_nfcCaretMs NumericFieldCfg s e a
config,
    _ifcDisplayChar :: Maybe Char
_ifcDisplayChar = forall a. Maybe a
Nothing,
    _ifcResizeOnChange :: Bool
_ifcResizeOnChange = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e a. NumericFieldCfg s e a -> Maybe Bool
_nfcResizeOnChange NumericFieldCfg s e a
config),
    _ifcSelectOnFocus :: Bool
_ifcSelectOnFocus = forall a. a -> Maybe a -> a
fromMaybe Bool
True (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 = forall a. a -> Maybe a
Just forall s a. HasNumericFieldStyle s a => Lens' s a
L.numericFieldStyle,
    _ifcWheelHandler :: Maybe (InputWheelHandler a)
_ifcWheelHandler = if Bool
readOnly then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (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 forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (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 = forall a. a -> Maybe a
Just CursorIcon
CursorSizeV,
    _ifcOnFocusReq :: [Path -> WidgetRequest s e]
_ifcOnFocusReq = forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnFocusReq NumericFieldCfg s e a
config,
    _ifcOnBlurReq :: [Path -> WidgetRequest s e]
_ifcOnBlurReq = forall s e a. NumericFieldCfg s e a -> [Path -> WidgetRequest s e]
_nfcOnBlurReq NumericFieldCfg s e a
config,
    _ifcOnChangeReq :: [a -> WidgetRequest s e]
_ifcOnChangeReq = 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-" forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Text
showt (forall a. Typeable a => a -> TypeRep
typeOf a
initialValue))
  newNode :: WidgetNode s e
newNode = 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 :: 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 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 forall a. Eq a => a -> a -> Bool
== WheelDirection
WheelNormal then Double
1 else -Double
1
  curValue :: a
curValue = forall a. InputFieldState a -> a
_ifsCurrValue InputFieldState a
state
  wheelRate :: Double
wheelRate
    | forall a. Typeable a => a -> Bool
isIntegral a
curValue = forall a. a -> Maybe a -> a
fromMaybe Double
1 (forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate NumericFieldCfg s e a
config)
    | Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe Double
0.1 (forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcWheelRate NumericFieldCfg s e a
config)
  result :: (Text, Int, Maybe Int)
result = 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 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 :: forall a s e.
FormattableNumber a =>
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 = forall a. InputFieldState a -> a
_ifsDragSelValue InputFieldState a
state
  dragRate :: Double
dragRate
    | forall a. Typeable a => a -> Bool
isIntegral a
selValue = forall a. a -> Maybe a -> a
fromMaybe Double
1 (forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate NumericFieldCfg s e a
config)
    | Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe Double
0.1 (forall s e a. NumericFieldCfg s e a -> Maybe Double
_nfcDragRate NumericFieldCfg s e a
config)
  result :: (Text, Int, Maybe Int)
result = 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 :: 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
rate a
value Double
dy = (Text, Int, Maybe Int)
result where
  decimals :: Int
decimals
    | forall a. Typeable a => a -> Bool
isIntegral a
value = Int
0
    | Bool
otherwise = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Int
2 (forall s e a. NumericFieldCfg s e a -> Maybe Int
_nfcDecimals NumericFieldCfg s e a
config)
  minVal :: Maybe a
minVal = forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMinValue NumericFieldCfg s e a
config
  maxVal :: Maybe a
maxVal = forall s e a. NumericFieldCfg s e a -> Maybe a
_nfcMaxValue NumericFieldCfg s e a
config

  acceptText :: Text -> (Bool, Bool, Maybe a)
acceptText = 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 forall s a. s -> Getting a s a -> a
^. forall s t a b. Field3 s t a b => Lens s t a b
_3
  toText :: Int -> a -> Text
toText = forall a. NumericTextConverter a => Int -> a -> Text
numericToText

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

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

numberInBounds :: Ord a => Maybe a -> Maybe a -> a -> Bool
numberInBounds :: forall a. Ord a => 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 forall a. Ord a => a -> a -> Bool
>= a
minVal
numberInBounds Maybe a
Nothing (Just a
maxVal) a
val = a
val forall a. Ord a => a -> a -> Bool
<= a
maxVal
numberInBounds (Just a
minVal) (Just a
maxVal) a
val = a
val forall a. Ord a => a -> a -> Bool
>= a
minVal Bool -> Bool -> Bool
&& a
val forall a. Ord a => a -> a -> Bool
<= a
maxVal

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