{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Monomer.Widgets.Singles.NumericField (
NumericFieldCfg,
FormattableNumber,
NumericTextConverter(..),
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
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
type FormattableNumber a
= (Eq a, Ord a, Show a, NumericTextConverter a, Typeable a)
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]
}
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
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
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
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
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