{-# 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 = 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
type FormattableNumber a
= (Eq a, Ord a, Show a, NumericTextConverter a, Typeable a)
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]
}
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
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
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
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
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