{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Monomer.Widgets.Singles.DateField (
DateFieldCfg,
DateFieldFormat,
FormattableDate,
DayConverter(..),
DateTextConverter(..),
dateField,
dateField_,
dateFieldV,
dateFieldV_,
dateFieldD_,
dateFormatDelimiter,
dateFormatDDMMYYYY,
dateFormatMMDDYYYY,
dateFormatYYYYMMDD
) where
import Control.Applicative ((<|>))
import Control.Lens ((^.), ALens', _1, _2, _3)
import Control.Monad (join)
import Data.Default
import Data.Either
import Data.Maybe
import Data.Text (Text)
import Data.Time
import Data.Typeable (Typeable, typeOf)
import TextShow
import qualified Data.Attoparsec.Text as A
import qualified Data.Text as T
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
data DateFieldFormat
= FormatDDMMYYYY
| FormatYYYYMMDD
| FormatMMDDYYYY
deriving (DateFieldFormat -> DateFieldFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateFieldFormat -> DateFieldFormat -> Bool
$c/= :: DateFieldFormat -> DateFieldFormat -> Bool
== :: DateFieldFormat -> DateFieldFormat -> Bool
$c== :: DateFieldFormat -> DateFieldFormat -> Bool
Eq, Int -> DateFieldFormat -> ShowS
[DateFieldFormat] -> ShowS
DateFieldFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateFieldFormat] -> ShowS
$cshowList :: [DateFieldFormat] -> ShowS
show :: DateFieldFormat -> String
$cshow :: DateFieldFormat -> String
showsPrec :: Int -> DateFieldFormat -> ShowS
$cshowsPrec :: Int -> DateFieldFormat -> ShowS
Show)
defaultDateFormat :: DateFieldFormat
defaultDateFormat :: DateFieldFormat
defaultDateFormat = DateFieldFormat
FormatDDMMYYYY
defaultDateDelim :: Char
defaultDateDelim :: Char
defaultDateDelim = Char
'/'
class (Eq a, Ord a, Show a, Typeable a) => DayConverter a where
convertFromDay :: Day -> a
convertToDay :: a -> Maybe Day
instance DayConverter Day where
convertFromDay :: Day -> Day
convertFromDay = forall a. a -> a
id
convertToDay :: Day -> Maybe Day
convertToDay = forall a. a -> Maybe a
Just
class DateTextConverter a where
dateAcceptText :: DateFieldFormat -> Char -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
dateFromText :: DateFieldFormat -> Char -> Text -> Maybe a
dateToText :: DateFieldFormat -> Char -> a -> Text
dateFromDay :: Day -> a
dateToDay :: a -> Maybe Day
instance {-# OVERLAPPABLE #-} DayConverter a => DateTextConverter a where
dateAcceptText :: DateFieldFormat
-> Char -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
dateAcceptText DateFieldFormat
format Char
delim Maybe a
minVal Maybe a
maxVal Text
text = (Bool, Bool, Maybe a)
result where
accept :: Bool
accept = DateFieldFormat -> Char -> Text -> Bool
acceptTextInput DateFieldFormat
format Char
delim Text
text
parsed :: Maybe a
parsed = forall a.
DateTextConverter a =>
DateFieldFormat -> Char -> Text -> Maybe a
dateFromText DateFieldFormat
format Char
delim 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
dateInBounds 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)
dateFromText :: DateFieldFormat -> Char -> Text -> Maybe a
dateFromText = forall a.
(DayConverter a, FormattableDate a) =>
DateFieldFormat -> Char -> Text -> Maybe a
dateFromTextSimple
dateToText :: DateFieldFormat -> Char -> a -> Text
dateToText = forall a. FormattableDate a => DateFieldFormat -> Char -> a -> Text
dateToTextSimple
dateFromDay :: Day -> a
dateFromDay = forall a. DayConverter a => Day -> a
convertFromDay
dateToDay :: a -> Maybe Day
dateToDay = forall a. DayConverter a => a -> Maybe Day
convertToDay
instance (DayConverter a, DateTextConverter a) => DateTextConverter (Maybe a) where
dateAcceptText :: DateFieldFormat
-> Char
-> Maybe (Maybe a)
-> Maybe (Maybe a)
-> Text
-> (Bool, Bool, Maybe (Maybe a))
dateAcceptText DateFieldFormat
format Char
delim Maybe (Maybe a)
minVal Maybe (Maybe a)
maxVal 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.
DateTextConverter a =>
DateFieldFormat
-> Char -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
dateAcceptText DateFieldFormat
format Char
delim (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) 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
dateFromText :: DateFieldFormat -> Char -> Text -> Maybe (Maybe a)
dateFromText DateFieldFormat
format Char
delim = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
DateTextConverter a =>
DateFieldFormat -> Char -> Text -> Maybe a
dateFromText DateFieldFormat
format Char
delim
dateToText :: DateFieldFormat -> Char -> Maybe a -> Text
dateToText DateFieldFormat
format Char
delim Maybe a
Nothing = Text
""
dateToText DateFieldFormat
format Char
delim (Just a
value) = forall a.
DateTextConverter a =>
DateFieldFormat -> Char -> a -> Text
dateToText DateFieldFormat
format Char
delim a
value
dateFromDay :: Day -> Maybe a
dateFromDay = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DateTextConverter a => Day -> a
dateFromDay
dateToDay :: Maybe a -> Maybe Day
dateToDay Maybe a
Nothing = forall a. Maybe a
Nothing
dateToDay (Just a
value) = forall a. DateTextConverter a => a -> Maybe Day
dateToDay a
value
type FormattableDate a
= (Eq a, Ord a, Show a, DateTextConverter a, Typeable a)
data DateFieldCfg s e a = DateFieldCfg {
forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcCaretWidth :: Maybe Double,
forall s e a. DateFieldCfg s e a -> Maybe Millisecond
_dfcCaretMs :: Maybe Millisecond,
forall s e a. DateFieldCfg s e a -> Maybe (WidgetData s Bool)
_dfcValid :: Maybe (WidgetData s Bool),
forall s e a. DateFieldCfg s e a -> [Bool -> e]
_dfcValidV :: [Bool -> e],
forall s e a. DateFieldCfg s e a -> Maybe Char
_dfcDateDelim :: Maybe Char,
forall s e a. DateFieldCfg s e a -> Maybe DateFieldFormat
_dfcDateFormat :: Maybe DateFieldFormat,
forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMinValue :: Maybe a,
forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMaxValue :: Maybe a,
forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcWheelRate :: Maybe Double,
forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcDragRate :: Maybe Double,
forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcResizeOnChange :: Maybe Bool,
forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcSelectOnFocus :: Maybe Bool,
forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcReadOnly :: Maybe Bool,
forall s e a. DateFieldCfg s e a -> [Path -> WidgetRequest s e]
_dfcOnFocusReq :: [Path -> WidgetRequest s e],
forall s e a. DateFieldCfg s e a -> [Path -> WidgetRequest s e]
_dfcOnBlurReq :: [Path -> WidgetRequest s e],
forall s e a. DateFieldCfg s e a -> [a -> WidgetRequest s e]
_dfcOnChangeReq :: [a -> WidgetRequest s e]
}
instance Default (DateFieldCfg s e a) where
def :: DateFieldCfg s e a
def = DateFieldCfg {
_dfcCaretWidth :: Maybe Double
_dfcCaretWidth = forall a. Maybe a
Nothing,
_dfcCaretMs :: Maybe Millisecond
_dfcCaretMs = forall a. Maybe a
Nothing,
_dfcValid :: Maybe (WidgetData s Bool)
_dfcValid = forall a. Maybe a
Nothing,
_dfcValidV :: [Bool -> e]
_dfcValidV = [],
_dfcDateDelim :: Maybe Char
_dfcDateDelim = forall a. Maybe a
Nothing,
_dfcDateFormat :: Maybe DateFieldFormat
_dfcDateFormat = forall a. Maybe a
Nothing,
_dfcMinValue :: Maybe a
_dfcMinValue = forall a. Maybe a
Nothing,
_dfcMaxValue :: Maybe a
_dfcMaxValue = forall a. Maybe a
Nothing,
_dfcWheelRate :: Maybe Double
_dfcWheelRate = forall a. Maybe a
Nothing,
_dfcDragRate :: Maybe Double
_dfcDragRate = forall a. Maybe a
Nothing,
_dfcResizeOnChange :: Maybe Bool
_dfcResizeOnChange = forall a. Maybe a
Nothing,
_dfcSelectOnFocus :: Maybe Bool
_dfcSelectOnFocus = forall a. Maybe a
Nothing,
_dfcReadOnly :: Maybe Bool
_dfcReadOnly = forall a. Maybe a
Nothing,
_dfcOnFocusReq :: [Path -> WidgetRequest s e]
_dfcOnFocusReq = [],
_dfcOnBlurReq :: [Path -> WidgetRequest s e]
_dfcOnBlurReq = [],
_dfcOnChangeReq :: [a -> WidgetRequest s e]
_dfcOnChangeReq = []
}
instance Semigroup (DateFieldCfg s e a) where
<> :: DateFieldCfg s e a -> DateFieldCfg s e a -> DateFieldCfg s e a
(<>) DateFieldCfg s e a
t1 DateFieldCfg s e a
t2 = DateFieldCfg {
_dfcCaretWidth :: Maybe Double
_dfcCaretWidth = forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcCaretWidth DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcCaretWidth DateFieldCfg s e a
t1,
_dfcCaretMs :: Maybe Millisecond
_dfcCaretMs = forall s e a. DateFieldCfg s e a -> Maybe Millisecond
_dfcCaretMs DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe Millisecond
_dfcCaretMs DateFieldCfg s e a
t1,
_dfcValid :: Maybe (WidgetData s Bool)
_dfcValid = forall s e a. DateFieldCfg s e a -> Maybe (WidgetData s Bool)
_dfcValid DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe (WidgetData s Bool)
_dfcValid DateFieldCfg s e a
t1,
_dfcValidV :: [Bool -> e]
_dfcValidV = forall s e a. DateFieldCfg s e a -> [Bool -> e]
_dfcValidV DateFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DateFieldCfg s e a -> [Bool -> e]
_dfcValidV DateFieldCfg s e a
t2,
_dfcDateDelim :: Maybe Char
_dfcDateDelim = forall s e a. DateFieldCfg s e a -> Maybe Char
_dfcDateDelim DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe Char
_dfcDateDelim DateFieldCfg s e a
t1,
_dfcDateFormat :: Maybe DateFieldFormat
_dfcDateFormat = forall s e a. DateFieldCfg s e a -> Maybe DateFieldFormat
_dfcDateFormat DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe DateFieldFormat
_dfcDateFormat DateFieldCfg s e a
t1,
_dfcMinValue :: Maybe a
_dfcMinValue = forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMinValue DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMinValue DateFieldCfg s e a
t1,
_dfcMaxValue :: Maybe a
_dfcMaxValue = forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMaxValue DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMaxValue DateFieldCfg s e a
t1,
_dfcWheelRate :: Maybe Double
_dfcWheelRate = forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcWheelRate DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcWheelRate DateFieldCfg s e a
t1,
_dfcDragRate :: Maybe Double
_dfcDragRate = forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcDragRate DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcDragRate DateFieldCfg s e a
t1,
_dfcResizeOnChange :: Maybe Bool
_dfcResizeOnChange = forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcResizeOnChange DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcResizeOnChange DateFieldCfg s e a
t1,
_dfcSelectOnFocus :: Maybe Bool
_dfcSelectOnFocus = forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcSelectOnFocus DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcSelectOnFocus DateFieldCfg s e a
t1,
_dfcReadOnly :: Maybe Bool
_dfcReadOnly = forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcReadOnly DateFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcReadOnly DateFieldCfg s e a
t1,
_dfcOnFocusReq :: [Path -> WidgetRequest s e]
_dfcOnFocusReq = forall s e a. DateFieldCfg s e a -> [Path -> WidgetRequest s e]
_dfcOnFocusReq DateFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DateFieldCfg s e a -> [Path -> WidgetRequest s e]
_dfcOnFocusReq DateFieldCfg s e a
t2,
_dfcOnBlurReq :: [Path -> WidgetRequest s e]
_dfcOnBlurReq = forall s e a. DateFieldCfg s e a -> [Path -> WidgetRequest s e]
_dfcOnBlurReq DateFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DateFieldCfg s e a -> [Path -> WidgetRequest s e]
_dfcOnBlurReq DateFieldCfg s e a
t2,
_dfcOnChangeReq :: [a -> WidgetRequest s e]
_dfcOnChangeReq = forall s e a. DateFieldCfg s e a -> [a -> WidgetRequest s e]
_dfcOnChangeReq DateFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DateFieldCfg s e a -> [a -> WidgetRequest s e]
_dfcOnChangeReq DateFieldCfg s e a
t2
}
instance Monoid (DateFieldCfg s e a) where
mempty :: DateFieldCfg s e a
mempty = forall a. Default a => a
def
instance CmbCaretWidth (DateFieldCfg s e a) Double where
caretWidth :: Double -> DateFieldCfg s e a
caretWidth Double
w = forall a. Default a => a
def {
_dfcCaretWidth :: Maybe Double
_dfcCaretWidth = forall a. a -> Maybe a
Just Double
w
}
instance CmbCaretMs (DateFieldCfg s e a) Millisecond where
caretMs :: Millisecond -> DateFieldCfg s e a
caretMs Millisecond
ms = forall a. Default a => a
def {
_dfcCaretMs :: Maybe Millisecond
_dfcCaretMs = forall a. a -> Maybe a
Just Millisecond
ms
}
instance CmbValidInput (DateFieldCfg s e a) s where
validInput :: ALens' s Bool -> DateFieldCfg s e a
validInput ALens' s Bool
field = forall a. Default a => a
def {
_dfcValid :: Maybe (WidgetData s Bool)
_dfcValid = forall a. a -> Maybe a
Just (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Bool
field)
}
instance CmbValidInputV (DateFieldCfg s e a) e where
validInputV :: (Bool -> e) -> DateFieldCfg s e a
validInputV Bool -> e
fn = forall a. Default a => a
def {
_dfcValidV :: [Bool -> e]
_dfcValidV = [Bool -> e
fn]
}
instance CmbResizeOnChange (DateFieldCfg s e a) where
resizeOnChange_ :: Bool -> DateFieldCfg s e a
resizeOnChange_ Bool
resize = forall a. Default a => a
def {
_dfcResizeOnChange :: Maybe Bool
_dfcResizeOnChange = forall a. a -> Maybe a
Just Bool
resize
}
instance CmbSelectOnFocus (DateFieldCfg s e a) where
selectOnFocus_ :: Bool -> DateFieldCfg s e a
selectOnFocus_ Bool
sel = forall a. Default a => a
def {
_dfcSelectOnFocus :: Maybe Bool
_dfcSelectOnFocus = forall a. a -> Maybe a
Just Bool
sel
}
instance CmbReadOnly (DateFieldCfg s e a) where
readOnly_ :: Bool -> DateFieldCfg s e a
readOnly_ Bool
ro = forall a. Default a => a
def {
_dfcReadOnly :: Maybe Bool
_dfcReadOnly = forall a. a -> Maybe a
Just Bool
ro
}
instance FormattableDate a => CmbMinValue (DateFieldCfg s e a) a where
minValue :: a -> DateFieldCfg s e a
minValue a
value = forall a. Default a => a
def {
_dfcMinValue :: Maybe a
_dfcMinValue = forall a. a -> Maybe a
Just a
value
}
instance FormattableDate a => CmbMaxValue (DateFieldCfg s e a) a where
maxValue :: a -> DateFieldCfg s e a
maxValue a
value = forall a. Default a => a
def {
_dfcMaxValue :: Maybe a
_dfcMaxValue = forall a. a -> Maybe a
Just a
value
}
instance CmbWheelRate (DateFieldCfg s e a) Double where
wheelRate :: Double -> DateFieldCfg s e a
wheelRate Double
rate = forall a. Default a => a
def {
_dfcWheelRate :: Maybe Double
_dfcWheelRate = forall a. a -> Maybe a
Just Double
rate
}
instance CmbDragRate (DateFieldCfg s e a) Double where
dragRate :: Double -> DateFieldCfg s e a
dragRate Double
rate = forall a. Default a => a
def {
_dfcDragRate :: Maybe Double
_dfcDragRate = forall a. a -> Maybe a
Just Double
rate
}
instance WidgetEvent e => CmbOnFocus (DateFieldCfg s e a) e Path where
onFocus :: (Path -> e) -> DateFieldCfg s e a
onFocus Path -> e
fn = forall a. Default a => a
def {
_dfcOnFocusReq :: [Path -> WidgetRequest s e]
_dfcOnFocusReq = [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 (DateFieldCfg s e a) s e Path where
onFocusReq :: (Path -> WidgetRequest s e) -> DateFieldCfg s e a
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
_dfcOnFocusReq :: [Path -> WidgetRequest s e]
_dfcOnFocusReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnBlur (DateFieldCfg s e a) e Path where
onBlur :: (Path -> e) -> DateFieldCfg s e a
onBlur Path -> e
fn = forall a. Default a => a
def {
_dfcOnBlurReq :: [Path -> WidgetRequest s e]
_dfcOnBlurReq = [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 (DateFieldCfg s e a) s e Path where
onBlurReq :: (Path -> WidgetRequest s e) -> DateFieldCfg s e a
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
_dfcOnBlurReq :: [Path -> WidgetRequest s e]
_dfcOnBlurReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnChange (DateFieldCfg s e a) a e where
onChange :: (a -> e) -> DateFieldCfg s e a
onChange a -> e
fn = forall a. Default a => a
def {
_dfcOnChangeReq :: [a -> WidgetRequest s e]
_dfcOnChangeReq = [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 (DateFieldCfg s e a) s e a where
onChangeReq :: (a -> WidgetRequest s e) -> DateFieldCfg s e a
onChangeReq a -> WidgetRequest s e
req = forall a. Default a => a
def {
_dfcOnChangeReq :: [a -> WidgetRequest s e]
_dfcOnChangeReq = [a -> WidgetRequest s e
req]
}
dateFormatDelimiter :: Char -> DateFieldCfg s e a
dateFormatDelimiter :: forall s e a. Char -> DateFieldCfg s e a
dateFormatDelimiter Char
delim = forall a. Default a => a
def {
_dfcDateDelim :: Maybe Char
_dfcDateDelim = forall a. a -> Maybe a
Just Char
delim
}
dateFormatDDMMYYYY :: DateFieldCfg s e a
dateFormatDDMMYYYY :: forall s e a. DateFieldCfg s e a
dateFormatDDMMYYYY = forall a. Default a => a
def {
_dfcDateFormat :: Maybe DateFieldFormat
_dfcDateFormat = forall a. a -> Maybe a
Just DateFieldFormat
FormatDDMMYYYY
}
dateFormatMMDDYYYY :: DateFieldCfg s e a
dateFormatMMDDYYYY :: forall s e a. DateFieldCfg s e a
dateFormatMMDDYYYY = forall a. Default a => a
def {
_dfcDateFormat :: Maybe DateFieldFormat
_dfcDateFormat = forall a. a -> Maybe a
Just DateFieldFormat
FormatMMDDYYYY
}
dateFormatYYYYMMDD :: DateFieldCfg s e a
dateFormatYYYYMMDD :: forall s e a. DateFieldCfg s e a
dateFormatYYYYMMDD = forall a. Default a => a
def {
_dfcDateFormat :: Maybe DateFieldFormat
_dfcDateFormat = forall a. a -> Maybe a
Just DateFieldFormat
FormatYYYYMMDD
}
dateField
:: (FormattableDate a, WidgetEvent e)
=> ALens' s a -> WidgetNode s e
dateField :: forall a e s.
(FormattableDate a, WidgetEvent e) =>
ALens' s a -> WidgetNode s e
dateField ALens' s a
field = forall a e s.
(FormattableDate a, WidgetEvent e) =>
ALens' s a -> [DateFieldCfg s e a] -> WidgetNode s e
dateField_ ALens' s a
field forall a. Default a => a
def
dateField_
:: (FormattableDate a, WidgetEvent e)
=> ALens' s a
-> [DateFieldCfg s e a]
-> WidgetNode s e
dateField_ :: forall a e s.
(FormattableDate a, WidgetEvent e) =>
ALens' s a -> [DateFieldCfg s e a] -> WidgetNode s e
dateField_ ALens' s a
field [DateFieldCfg s e a]
configs = WidgetNode s e
widget where
widget :: WidgetNode s e
widget = forall a e s.
(FormattableDate a, WidgetEvent e) =>
WidgetData s a -> [DateFieldCfg s e a] -> WidgetNode s e
dateFieldD_ (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) [DateFieldCfg s e a]
configs
dateFieldV
:: (FormattableDate a, WidgetEvent e)
=> a -> (a -> e) -> WidgetNode s e
dateFieldV :: forall a e s.
(FormattableDate a, WidgetEvent e) =>
a -> (a -> e) -> WidgetNode s e
dateFieldV a
value a -> e
handler = forall a e s.
(FormattableDate a, WidgetEvent e) =>
a -> (a -> e) -> [DateFieldCfg s e a] -> WidgetNode s e
dateFieldV_ a
value a -> e
handler forall a. Default a => a
def
dateFieldV_
:: (FormattableDate a, WidgetEvent e)
=> a
-> (a -> e)
-> [DateFieldCfg s e a]
-> WidgetNode s e
dateFieldV_ :: forall a e s.
(FormattableDate a, WidgetEvent e) =>
a -> (a -> e) -> [DateFieldCfg s e a] -> WidgetNode s e
dateFieldV_ a
value a -> e
handler [DateFieldCfg 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 :: [DateFieldCfg s e a]
newConfigs = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler forall a. a -> [a] -> [a]
: [DateFieldCfg s e a]
configs
newNode :: WidgetNode s e
newNode = forall a e s.
(FormattableDate a, WidgetEvent e) =>
WidgetData s a -> [DateFieldCfg s e a] -> WidgetNode s e
dateFieldD_ forall {s}. WidgetData s a
widgetData [DateFieldCfg s e a]
newConfigs
dateFieldD_
:: (FormattableDate a, WidgetEvent e)
=> WidgetData s a
-> [DateFieldCfg s e a]
-> WidgetNode s e
dateFieldD_ :: forall a e s.
(FormattableDate a, WidgetEvent e) =>
WidgetData s a -> [DateFieldCfg s e a] -> WidgetNode s e
dateFieldD_ WidgetData s a
widgetData [DateFieldCfg s e a]
configs = WidgetNode s e
newNode where
config :: DateFieldCfg s e a
config = forall a. Monoid a => [a] -> a
mconcat [DateFieldCfg s e a]
configs
format :: DateFieldFormat
format = forall a. a -> Maybe a -> a
fromMaybe DateFieldFormat
defaultDateFormat (forall s e a. DateFieldCfg s e a -> Maybe DateFieldFormat
_dfcDateFormat DateFieldCfg s e a
config)
delim :: Char
delim = forall a. a -> Maybe a -> a
fromMaybe Char
defaultDateDelim (forall s e a. DateFieldCfg s e a -> Maybe Char
_dfcDateDelim DateFieldCfg s e a
config)
minVal :: Maybe a
minVal = forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMinValue DateFieldCfg s e a
config
maxVal :: Maybe a
maxVal = forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMaxValue DateFieldCfg s e a
config
readOnly :: Bool
readOnly = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcReadOnly DateFieldCfg 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. DateTextConverter a => Day -> a
dateFromDay (Year -> Int -> Int -> Day
fromGregorian Year
1970 Int
1 Int
1)
acceptText :: Text -> (Bool, Bool, Maybe a)
acceptText = forall a.
DateTextConverter a =>
DateFieldFormat
-> Char -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
dateAcceptText DateFieldFormat
format Char
delim Maybe a
minVal Maybe a
maxVal
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.
DateTextConverter a =>
DateFieldFormat -> Char -> a -> Text
dateToText DateFieldFormat
format Char
delim
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. DateFieldCfg s e a -> Maybe (WidgetData s Bool)
_dfcValid DateFieldCfg s e a
config,
_ifcValidV :: [Bool -> e]
_ifcValidV = forall s e a. DateFieldCfg s e a -> [Bool -> e]
_dfcValidV DateFieldCfg 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
True,
_ifcDefWidth :: Double
_ifcDefWidth = Double
160,
_ifcCaretWidth :: Maybe Double
_ifcCaretWidth = forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcCaretWidth DateFieldCfg s e a
config,
_ifcCaretMs :: Maybe Millisecond
_ifcCaretMs = forall s e a. DateFieldCfg s e a -> Maybe Millisecond
_dfcCaretMs DateFieldCfg 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. DateFieldCfg s e a -> Maybe Bool
_dfcResizeOnChange DateFieldCfg s e a
config),
_ifcSelectOnFocus :: Bool
_ifcSelectOnFocus = forall a. a -> Maybe a -> a
fromMaybe Bool
True (forall s e a. DateFieldCfg s e a -> Maybe Bool
_dfcSelectOnFocus DateFieldCfg s e a
config),
_ifcReadOnly :: Bool
_ifcReadOnly = Bool
readOnly,
_ifcStyle :: Maybe (ALens' ThemeState StyleState)
_ifcStyle = forall a. a -> Maybe a
Just forall s a. HasDateFieldStyle s a => Lens' s a
L.dateFieldStyle,
_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.
FormattableDate a =>
DateFieldCfg s e a
-> InputFieldState a
-> Point
-> Point
-> WheelDirection
-> (Text, Int, Maybe Int)
handleWheel DateFieldCfg 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.
FormattableDate a =>
DateFieldCfg s e a
-> InputFieldState a -> Point -> Point -> (Text, Int, Maybe Int)
handleDrag DateFieldCfg 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. DateFieldCfg s e a -> [Path -> WidgetRequest s e]
_dfcOnFocusReq DateFieldCfg s e a
config,
_ifcOnBlurReq :: [Path -> WidgetRequest s e]
_ifcOnBlurReq = forall s e a. DateFieldCfg s e a -> [Path -> WidgetRequest s e]
_dfcOnBlurReq DateFieldCfg s e a
config,
_ifcOnChangeReq :: [a -> WidgetRequest s e]
_ifcOnChangeReq = forall s e a. DateFieldCfg s e a -> [a -> WidgetRequest s e]
_dfcOnChangeReq DateFieldCfg s e a
config
}
wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"dateField-" 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
:: FormattableDate a
=> DateFieldCfg s e a
-> InputFieldState a
-> Point
-> Point
-> WheelDirection
-> (Text, Int, Maybe Int)
handleWheel :: forall a s e.
FormattableDate a =>
DateFieldCfg s e a
-> InputFieldState a
-> Point
-> Point
-> WheelDirection
-> (Text, Int, Maybe Int)
handleWheel DateFieldCfg 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. a -> Maybe a -> a
fromMaybe Double
1 (forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcWheelRate DateFieldCfg s e a
config)
result :: (Text, Int, Maybe Int)
result = forall a s e.
FormattableDate a =>
DateFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove DateFieldCfg s e a
config InputFieldState a
state Double
wheelRate a
curValue (Double
dy forall a. Num a => a -> a -> a
* Double
sign)
handleDrag
:: FormattableDate a
=> DateFieldCfg s e a
-> InputFieldState a
-> Point
-> Point
-> (Text, Int, Maybe Int)
handleDrag :: forall a s e.
FormattableDate a =>
DateFieldCfg s e a
-> InputFieldState a -> Point -> Point -> (Text, Int, Maybe Int)
handleDrag DateFieldCfg 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. a -> Maybe a -> a
fromMaybe Double
1 (forall s e a. DateFieldCfg s e a -> Maybe Double
_dfcDragRate DateFieldCfg s e a
config)
result :: (Text, Int, Maybe Int)
result = forall a s e.
FormattableDate a =>
DateFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove DateFieldCfg s e a
config InputFieldState a
state Double
dragRate a
selValue Double
dy
handleMove
:: FormattableDate a
=> DateFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove :: forall a s e.
FormattableDate a =>
DateFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove DateFieldCfg s e a
config InputFieldState a
state Double
rate a
value Double
dy = (Text, Int, Maybe Int)
result where
format :: DateFieldFormat
format = forall a. a -> Maybe a -> a
fromMaybe DateFieldFormat
defaultDateFormat (forall s e a. DateFieldCfg s e a -> Maybe DateFieldFormat
_dfcDateFormat DateFieldCfg s e a
config)
delim :: Char
delim = forall a. a -> Maybe a -> a
fromMaybe Char
defaultDateDelim (forall s e a. DateFieldCfg s e a -> Maybe Char
_dfcDateDelim DateFieldCfg s e a
config)
minVal :: Maybe a
minVal = forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMinValue DateFieldCfg s e a
config
maxVal :: Maybe a
maxVal = forall s e a. DateFieldCfg s e a -> Maybe a
_dfcMaxValue DateFieldCfg s e a
config
acceptText :: Text -> (Bool, Bool, Maybe a)
acceptText = forall a.
DateTextConverter a =>
DateFieldFormat
-> Char -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
dateAcceptText DateFieldFormat
format Char
delim Maybe a
minVal Maybe a
maxVal
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.
DateTextConverter a =>
DateFieldFormat -> Char -> a -> Text
dateToText DateFieldFormat
format Char
delim
(Bool
valid, Maybe a
mParsedVal, a
parsedVal) = case forall a. DateTextConverter a => a -> Maybe Day
dateToDay a
value of
Just Day
val -> (Bool
True, Maybe a
mParsedVal, a
parsedVal) where
tmpValue :: Day
tmpValue = Year -> Day -> Day
addDays (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
dy forall a. Num a => a -> a -> a
* Double
rate)) Day
val
mParsedVal :: Maybe a
mParsedVal = Text -> Maybe a
fromText (a -> Text
toText (forall a. DateTextConverter a => Day -> a
dateFromDay Day
tmpValue))
parsedVal :: a
parsedVal = forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
mParsedVal
Maybe Day
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 = a -> Text
toText 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)
dateFromTextSimple
:: (DayConverter a, FormattableDate a)
=> DateFieldFormat
-> Char
-> Text
-> Maybe a
dateFromTextSimple :: forall a.
(DayConverter a, FormattableDate a) =>
DateFieldFormat -> Char -> Text -> Maybe a
dateFromTextSimple DateFieldFormat
format Char
delim Text
text = Maybe a
newDate where
compParser :: Parser Text Int
compParser = Char -> Parser Char
A.char Char
delim forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parser a
A.decimal
dateParser :: Parser Text (Int, Int, Int)
dateParser = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => Parser a
A.decimal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Int
compParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Int
compParser
tmpDate :: Maybe Day
tmpDate = case forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Text (Int, Int, Int)
dateParser Text
text of
Left String
_ -> forall a. Maybe a
Nothing
Right (Int
n1, Int
n2, Int
n3)
| DateFieldFormat
format forall a. Eq a => a -> a -> Bool
== DateFieldFormat
FormatDDMMYYYY -> Year -> Int -> Int -> Maybe Day
fromGregorianValid (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n3) Int
n2 Int
n1
| DateFieldFormat
format forall a. Eq a => a -> a -> Bool
== DateFieldFormat
FormatMMDDYYYY -> Year -> Int -> Int -> Maybe Day
fromGregorianValid (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n3) Int
n1 Int
n2
| Bool
otherwise -> Year -> Int -> Int -> Maybe Day
fromGregorianValid (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n1) Int
n2 Int
n3
newDate :: Maybe a
newDate = Maybe Day
tmpDate forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DateTextConverter a => Day -> a
dateFromDay
dateToTextSimple :: FormattableDate a => DateFieldFormat -> Char -> a -> Text
dateToTextSimple :: forall a. FormattableDate a => DateFieldFormat -> Char -> a -> Text
dateToTextSimple DateFieldFormat
format Char
delim a
val = Text
result where
converted :: Maybe Day
converted = forall a. DateTextConverter a => a -> Maybe Day
dateToDay a
val
(Year
year, Int
month, Int
day) = Day -> (Year, Int, Int)
toGregorian (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Day
converted)
sep :: Text
sep = Char -> Text
T.singleton Char
delim
padd :: a -> Text
padd a
num
| a
num forall a. Ord a => a -> a -> Bool
< a
10 = Text
"0" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show a
num)
| Bool
otherwise = String -> Text
T.pack (forall a. Show a => a -> String
show a
num)
tday :: Text
tday = forall {a}. (Ord a, Num a, Show a) => a -> Text
padd Int
day
tmonth :: Text
tmonth = forall {a}. (Ord a, Num a, Show a) => a -> Text
padd Int
month
tyear :: Text
tyear = String -> Text
T.pack (forall a. Show a => a -> String
show Year
year)
result :: Text
result
| forall a. Maybe a -> Bool
isNothing Maybe Day
converted = Text
""
| DateFieldFormat
format forall a. Eq a => a -> a -> Bool
== DateFieldFormat
FormatDDMMYYYY = Text
tday forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tmonth forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tyear
| DateFieldFormat
format forall a. Eq a => a -> a -> Bool
== DateFieldFormat
FormatMMDDYYYY = Text
tmonth forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tday forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tyear
| Bool
otherwise = Text
tyear forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tmonth forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tday
acceptTextInput :: DateFieldFormat -> Char -> Text -> Bool
acceptTextInput :: DateFieldFormat -> Char -> Text -> Bool
acceptTextInput DateFieldFormat
format Char
delim 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
numP :: Parser Text Text
numP = Parser Char
A.digit forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
""
delimP :: Parser Text Text
delimP = Char -> Parser Char
A.char Char
delim forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
""
dayP :: Parser Text Text
dayP = Int -> Parser Text Text -> Parser Text Text
P.upto Int
2 Parser Text Text
numP
monthP :: Parser Text Text
monthP = Int -> Parser Text Text -> Parser Text Text
P.upto Int
2 Parser Text Text
numP
yearP :: Parser Text Text
yearP = Int -> Parser Text Text -> Parser Text Text
P.upto Int
4 Parser Text Text
numP
withDelim :: Parser Text a -> Parser Text a
withDelim Parser Text a
parser = forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option a
"" (Parser Text Text
delimP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text a
parser)
parsers :: [Parser Text Text]
parsers
| DateFieldFormat
format forall a. Eq a => a -> a -> Bool
== DateFieldFormat
FormatDDMMYYYY = [Parser Text Text
dayP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
monthP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
yearP]
| DateFieldFormat
format forall a. Eq a => a -> a -> Bool
== DateFieldFormat
FormatMMDDYYYY = [Parser Text Text
monthP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
dayP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
yearP]
| Bool
otherwise = [Parser Text Text
yearP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
monthP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
dayP]
parser :: Parser Text Text
parser = [Parser Text Text] -> Parser Text Text
P.join [Parser Text Text]
parsers forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput
dateInBounds :: (Ord a) => Maybe a -> Maybe a -> a -> Bool
dateInBounds :: forall a. Ord a => Maybe a -> Maybe a -> a -> Bool
dateInBounds Maybe a
Nothing Maybe a
Nothing a
_ = Bool
True
dateInBounds (Just a
minVal) Maybe a
Nothing a
val = a
val forall a. Ord a => a -> a -> Bool
>= a
minVal
dateInBounds Maybe a
Nothing (Just a
maxVal) a
val = a
val forall a. Ord a => a -> a -> Bool
<= a
maxVal
dateInBounds (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