{-|
Module      : Monomer.Widgets.Singles.TimeField
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Input field for time types with support for different formats.

@
timeField timeLens
@

With configuration options:

@
timeField_ timeLens [timeFormatHHMMSS]
@

Supports 'TimeOfDay' type of the <https://hackage.haskell.org/package/time time>
library, but other types can be supported by implementing 'TimeOfDayConverter'.
'Maybe' is also supported.

Handles mouse wheel and shift + vertical drag to increase/decrease minutes.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

module Monomer.Widgets.Singles.TimeField (
  -- * Configuration
  TimeFieldCfg,
  FormattableTime,
  TimeFieldFormat,
  TimeOfDayConverter(..),
  TimeTextConverter(..),
  -- * Constructors
  timeField,
  timeField_,
  timeFieldV,
  timeFieldV_,
  timeFieldD_,
  timeFormatHHMM,
  timeFormatHHMMSS
) 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

-- | Available formats for 'timeField'.
data TimeFieldFormat
  = FormatHHMM
  | FormatHHMMSS
  deriving (TimeFieldFormat -> TimeFieldFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeFieldFormat -> TimeFieldFormat -> Bool
$c/= :: TimeFieldFormat -> TimeFieldFormat -> Bool
== :: TimeFieldFormat -> TimeFieldFormat -> Bool
$c== :: TimeFieldFormat -> TimeFieldFormat -> Bool
Eq, Int -> TimeFieldFormat -> ShowS
[TimeFieldFormat] -> ShowS
TimeFieldFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeFieldFormat] -> ShowS
$cshowList :: [TimeFieldFormat] -> ShowS
show :: TimeFieldFormat -> String
$cshow :: TimeFieldFormat -> String
showsPrec :: Int -> TimeFieldFormat -> ShowS
$cshowsPrec :: Int -> TimeFieldFormat -> ShowS
Show)

defaultTimeFormat :: TimeFieldFormat
defaultTimeFormat :: TimeFieldFormat
defaultTimeFormat = TimeFieldFormat
FormatHHMM

defaultTimeDelim :: Char
defaultTimeDelim :: Char
defaultTimeDelim = Char
':'

{-|
Converter to and form the 'TimeOfDay' type of the time library. To use types
other than 'TimeOfDay' of said library, this typeclass needs to be implemented.
--}
class (Eq a, Ord a, Show a, Typeable a) => TimeOfDayConverter a where
  convertFromTimeOfDay :: TimeOfDay -> a
  convertToTimeOfDay :: a -> Maybe TimeOfDay

instance TimeOfDayConverter TimeOfDay where
  convertFromTimeOfDay :: TimeOfDay -> TimeOfDay
convertFromTimeOfDay = forall a. a -> a
id
  convertToTimeOfDay :: TimeOfDay -> Maybe TimeOfDay
convertToTimeOfDay = forall a. a -> Maybe a
Just

{-|
Converts a 'TimeOfDay' instance to and from 'Text'. Implementing this typeclass
is not necessary for instances of 'TimeOfDayConverter'.
-}
class TimeTextConverter a where
  timeAcceptText :: TimeFieldFormat -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
  timeFromText :: TimeFieldFormat -> Text -> Maybe a
  timeToText :: TimeFieldFormat -> a -> Text
  timeFromTimeOfDay' :: TimeOfDay -> a
  timeToTimeOfDay' :: a -> Maybe TimeOfDay

instance {-# OVERLAPPABLE #-} TimeOfDayConverter a => TimeTextConverter a where
  timeAcceptText :: TimeFieldFormat
-> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
timeAcceptText TimeFieldFormat
format Maybe a
minVal Maybe a
maxVal Text
text = (Bool, Bool, Maybe a)
result where
    accept :: Bool
accept = TimeFieldFormat -> Text -> Bool
acceptTextInput TimeFieldFormat
format Text
text
    parsed :: Maybe a
parsed = forall a. TimeTextConverter a => TimeFieldFormat -> Text -> Maybe a
timeFromText TimeFieldFormat
format 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
timeInBounds 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)
  timeFromText :: TimeFieldFormat -> Text -> Maybe a
timeFromText = forall a.
(TimeOfDayConverter a, FormattableTime a) =>
TimeFieldFormat -> Text -> Maybe a
timeFromTextSimple
  timeToText :: TimeFieldFormat -> a -> Text
timeToText = forall a. FormattableTime a => TimeFieldFormat -> a -> Text
timeToTextSimple
  timeFromTimeOfDay' :: TimeOfDay -> a
timeFromTimeOfDay' = forall a. TimeOfDayConverter a => TimeOfDay -> a
convertFromTimeOfDay
  timeToTimeOfDay' :: a -> Maybe TimeOfDay
timeToTimeOfDay' = forall a. TimeOfDayConverter a => a -> Maybe TimeOfDay
convertToTimeOfDay

instance (TimeOfDayConverter a, TimeTextConverter a) => TimeTextConverter (Maybe a) where
  timeAcceptText :: TimeFieldFormat
-> Maybe (Maybe a)
-> Maybe (Maybe a)
-> Text
-> (Bool, Bool, Maybe (Maybe a))
timeAcceptText TimeFieldFormat
format 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.
TimeTextConverter a =>
TimeFieldFormat
-> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
timeAcceptText TimeFieldFormat
format (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
  timeFromText :: TimeFieldFormat -> Text -> Maybe (Maybe a)
timeFromText TimeFieldFormat
format = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TimeTextConverter a => TimeFieldFormat -> Text -> Maybe a
timeFromText TimeFieldFormat
format
  timeToText :: TimeFieldFormat -> Maybe a -> Text
timeToText TimeFieldFormat
format Maybe a
Nothing = Text
""
  timeToText TimeFieldFormat
format (Just a
value) = forall a. TimeTextConverter a => TimeFieldFormat -> a -> Text
timeToText TimeFieldFormat
format a
value
  timeFromTimeOfDay' :: TimeOfDay -> Maybe a
timeFromTimeOfDay' = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TimeTextConverter a => TimeOfDay -> a
timeFromTimeOfDay'
  timeToTimeOfDay' :: Maybe a -> Maybe TimeOfDay
timeToTimeOfDay' Maybe a
Nothing = forall a. Maybe a
Nothing
  timeToTimeOfDay' (Just a
value) = forall a. TimeTextConverter a => a -> Maybe TimeOfDay
timeToTimeOfDay' a
value

-- | Constraints for time types accepted by timeField.
type FormattableTime a
  = (Eq a, Ord a, Show a, TimeTextConverter a, Typeable a)

{-|
Configuration options for timeField:

- 'validInput': field indicating if the current input is valid. Useful to show
warnings in the UI, or disable buttons if needed.
- 'resizeOnChange': Whether input causes ResizeWidgets requests.
- 'selectOnFocus': Whether all input should be selected when focus is received.
- 'readOnly': Whether to prevent the user changing the input text.
- 'minValue': Minimum valid time.
- 'maxValue': Maximum valid time.
- 'wheelRate': The rate at which wheel movement affects the time.
- 'dragRate': The rate at which drag movement affects the time.
- 'onFocus': event to raise when focus is received.
- 'onFocusReq': 'WidgetRequest' to generate when focus is received.
- 'onBlur': event to raise when focus is lost.
- 'onBlurReq': 'WidgetRequest' to generate when focus is lost.
- 'onChange': event to raise when the value changes.
- 'onChangeReq': 'WidgetRequest' to generate when the value changes.
- 'timeFormatHHMM': accepts HH:MM.
- 'timeFormatHHMMSS': accepts HH:MM:SS.
-}
data TimeFieldCfg s e a = TimeFieldCfg {
  forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcCaretWidth :: Maybe Double,
  forall s e a. TimeFieldCfg s e a -> Maybe Millisecond
_tfcCaretMs :: Maybe Millisecond,
  forall s e a. TimeFieldCfg s e a -> Maybe (WidgetData s Bool)
_tfcValid :: Maybe (WidgetData s Bool),
  forall s e a. TimeFieldCfg s e a -> [Bool -> e]
_tfcValidV :: [Bool -> e],
  forall s e a. TimeFieldCfg s e a -> Maybe TimeFieldFormat
_tfcTimeFormat :: Maybe TimeFieldFormat,
  forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMinValue :: Maybe a,
  forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMaxValue :: Maybe a,
  forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcWheelRate :: Maybe Double,
  forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcDragRate :: Maybe Double,
  forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcResizeOnChange :: Maybe Bool,
  forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcSelectOnFocus :: Maybe Bool,
  forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcReadOnly :: Maybe Bool,
  forall s e a. TimeFieldCfg s e a -> [Path -> WidgetRequest s e]
_tfcOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e a. TimeFieldCfg s e a -> [Path -> WidgetRequest s e]
_tfcOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e a. TimeFieldCfg s e a -> [a -> WidgetRequest s e]
_tfcOnChangeReq :: [a -> WidgetRequest s e]
}

instance Default (TimeFieldCfg s e a) where
  def :: TimeFieldCfg s e a
def = TimeFieldCfg {
    _tfcCaretWidth :: Maybe Double
_tfcCaretWidth = forall a. Maybe a
Nothing,
    _tfcCaretMs :: Maybe Millisecond
_tfcCaretMs = forall a. Maybe a
Nothing,
    _tfcValid :: Maybe (WidgetData s Bool)
_tfcValid = forall a. Maybe a
Nothing,
    _tfcValidV :: [Bool -> e]
_tfcValidV = [],
    _tfcTimeFormat :: Maybe TimeFieldFormat
_tfcTimeFormat = forall a. Maybe a
Nothing,
    _tfcMinValue :: Maybe a
_tfcMinValue = forall a. Maybe a
Nothing,
    _tfcMaxValue :: Maybe a
_tfcMaxValue = forall a. Maybe a
Nothing,
    _tfcWheelRate :: Maybe Double
_tfcWheelRate = forall a. Maybe a
Nothing,
    _tfcDragRate :: Maybe Double
_tfcDragRate = forall a. Maybe a
Nothing,
    _tfcResizeOnChange :: Maybe Bool
_tfcResizeOnChange = forall a. Maybe a
Nothing,
    _tfcSelectOnFocus :: Maybe Bool
_tfcSelectOnFocus = forall a. Maybe a
Nothing,
    _tfcReadOnly :: Maybe Bool
_tfcReadOnly = forall a. Maybe a
Nothing,
    _tfcOnFocusReq :: [Path -> WidgetRequest s e]
_tfcOnFocusReq = [],
    _tfcOnBlurReq :: [Path -> WidgetRequest s e]
_tfcOnBlurReq = [],
    _tfcOnChangeReq :: [a -> WidgetRequest s e]
_tfcOnChangeReq = []
  }

instance Semigroup (TimeFieldCfg s e a) where
  <> :: TimeFieldCfg s e a -> TimeFieldCfg s e a -> TimeFieldCfg s e a
(<>) TimeFieldCfg s e a
t1 TimeFieldCfg s e a
t2 = TimeFieldCfg {
    _tfcCaretWidth :: Maybe Double
_tfcCaretWidth = forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcCaretWidth TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcCaretWidth TimeFieldCfg s e a
t1,
    _tfcCaretMs :: Maybe Millisecond
_tfcCaretMs = forall s e a. TimeFieldCfg s e a -> Maybe Millisecond
_tfcCaretMs TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe Millisecond
_tfcCaretMs TimeFieldCfg s e a
t1,
    _tfcValid :: Maybe (WidgetData s Bool)
_tfcValid = forall s e a. TimeFieldCfg s e a -> Maybe (WidgetData s Bool)
_tfcValid TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe (WidgetData s Bool)
_tfcValid TimeFieldCfg s e a
t1,
    _tfcValidV :: [Bool -> e]
_tfcValidV = forall s e a. TimeFieldCfg s e a -> [Bool -> e]
_tfcValidV TimeFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. TimeFieldCfg s e a -> [Bool -> e]
_tfcValidV TimeFieldCfg s e a
t2,
    _tfcTimeFormat :: Maybe TimeFieldFormat
_tfcTimeFormat = forall s e a. TimeFieldCfg s e a -> Maybe TimeFieldFormat
_tfcTimeFormat TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe TimeFieldFormat
_tfcTimeFormat TimeFieldCfg s e a
t1,
    _tfcMinValue :: Maybe a
_tfcMinValue = forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMinValue TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMinValue TimeFieldCfg s e a
t1,
    _tfcMaxValue :: Maybe a
_tfcMaxValue = forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMaxValue TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMaxValue TimeFieldCfg s e a
t1,
    _tfcWheelRate :: Maybe Double
_tfcWheelRate = forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcWheelRate TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcWheelRate TimeFieldCfg s e a
t1,
    _tfcDragRate :: Maybe Double
_tfcDragRate = forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcDragRate TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe Double
_tfcDragRate TimeFieldCfg s e a
t1,
    _tfcResizeOnChange :: Maybe Bool
_tfcResizeOnChange = forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcResizeOnChange TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcResizeOnChange TimeFieldCfg s e a
t1,
    _tfcSelectOnFocus :: Maybe Bool
_tfcSelectOnFocus = forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcSelectOnFocus TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcSelectOnFocus TimeFieldCfg s e a
t1,
    _tfcReadOnly :: Maybe Bool
_tfcReadOnly = forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcReadOnly TimeFieldCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcReadOnly TimeFieldCfg s e a
t1,
    _tfcOnFocusReq :: [Path -> WidgetRequest s e]
_tfcOnFocusReq = forall s e a. TimeFieldCfg s e a -> [Path -> WidgetRequest s e]
_tfcOnFocusReq TimeFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. TimeFieldCfg s e a -> [Path -> WidgetRequest s e]
_tfcOnFocusReq TimeFieldCfg s e a
t2,
    _tfcOnBlurReq :: [Path -> WidgetRequest s e]
_tfcOnBlurReq = forall s e a. TimeFieldCfg s e a -> [Path -> WidgetRequest s e]
_tfcOnBlurReq TimeFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. TimeFieldCfg s e a -> [Path -> WidgetRequest s e]
_tfcOnBlurReq TimeFieldCfg s e a
t2,
    _tfcOnChangeReq :: [a -> WidgetRequest s e]
_tfcOnChangeReq = forall s e a. TimeFieldCfg s e a -> [a -> WidgetRequest s e]
_tfcOnChangeReq TimeFieldCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. TimeFieldCfg s e a -> [a -> WidgetRequest s e]
_tfcOnChangeReq TimeFieldCfg s e a
t2
  }

instance Monoid (TimeFieldCfg s e a) where
  mempty :: TimeFieldCfg s e a
mempty = forall a. Default a => a
def

instance CmbCaretWidth (TimeFieldCfg s e a) Double where
  caretWidth :: Double -> TimeFieldCfg s e a
caretWidth Double
w = forall a. Default a => a
def {
    _tfcCaretWidth :: Maybe Double
_tfcCaretWidth = forall a. a -> Maybe a
Just Double
w
  }

instance CmbCaretMs (TimeFieldCfg s e a) Millisecond where
  caretMs :: Millisecond -> TimeFieldCfg s e a
caretMs Millisecond
ms = forall a. Default a => a
def {
    _tfcCaretMs :: Maybe Millisecond
_tfcCaretMs = forall a. a -> Maybe a
Just Millisecond
ms
  }

instance CmbValidInput (TimeFieldCfg s e a) s where
  validInput :: ALens' s Bool -> TimeFieldCfg s e a
validInput ALens' s Bool
field = forall a. Default a => a
def {
    _tfcValid :: Maybe (WidgetData s Bool)
_tfcValid = forall a. a -> Maybe a
Just (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Bool
field)
  }

instance CmbValidInputV (TimeFieldCfg s e a) e where
  validInputV :: (Bool -> e) -> TimeFieldCfg s e a
validInputV Bool -> e
fn = forall a. Default a => a
def {
    _tfcValidV :: [Bool -> e]
_tfcValidV = [Bool -> e
fn]
  }

instance CmbResizeOnChange (TimeFieldCfg s e a) where
  resizeOnChange_ :: Bool -> TimeFieldCfg s e a
resizeOnChange_ Bool
resize = forall a. Default a => a
def {
    _tfcResizeOnChange :: Maybe Bool
_tfcResizeOnChange = forall a. a -> Maybe a
Just Bool
resize
  }

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

instance CmbReadOnly (TimeFieldCfg s e a) where
  readOnly_ :: Bool -> TimeFieldCfg s e a
readOnly_ Bool
ro = forall a. Default a => a
def {
    _tfcReadOnly :: Maybe Bool
_tfcReadOnly = forall a. a -> Maybe a
Just Bool
ro
  }

instance FormattableTime a => CmbMinValue (TimeFieldCfg s e a) a where
  minValue :: a -> TimeFieldCfg s e a
minValue a
len = forall a. Default a => a
def {
    _tfcMinValue :: Maybe a
_tfcMinValue = forall a. a -> Maybe a
Just a
len
  }

instance FormattableTime a => CmbMaxValue (TimeFieldCfg s e a) a where
  maxValue :: a -> TimeFieldCfg s e a
maxValue a
len = forall a. Default a => a
def {
    _tfcMaxValue :: Maybe a
_tfcMaxValue = forall a. a -> Maybe a
Just a
len
  }

instance CmbWheelRate (TimeFieldCfg s e a) Double where
  wheelRate :: Double -> TimeFieldCfg s e a
wheelRate Double
rate = forall a. Default a => a
def {
    _tfcWheelRate :: Maybe Double
_tfcWheelRate = forall a. a -> Maybe a
Just Double
rate
  }

instance CmbDragRate (TimeFieldCfg s e a) Double where
  dragRate :: Double -> TimeFieldCfg s e a
dragRate Double
rate = forall a. Default a => a
def {
    _tfcDragRate :: Maybe Double
_tfcDragRate = forall a. a -> Maybe a
Just Double
rate
  }

instance WidgetEvent e => CmbOnFocus (TimeFieldCfg s e a) e Path where
  onFocus :: (Path -> e) -> TimeFieldCfg s e a
onFocus Path -> e
fn = forall a. Default a => a
def {
    _tfcOnFocusReq :: [Path -> WidgetRequest s e]
_tfcOnFocusReq = [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 (TimeFieldCfg s e a) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> TimeFieldCfg s e a
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _tfcOnFocusReq :: [Path -> WidgetRequest s e]
_tfcOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (TimeFieldCfg s e a) e Path where
  onBlur :: (Path -> e) -> TimeFieldCfg s e a
onBlur Path -> e
fn = forall a. Default a => a
def {
    _tfcOnBlurReq :: [Path -> WidgetRequest s e]
_tfcOnBlurReq = [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 (TimeFieldCfg s e a) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> TimeFieldCfg s e a
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _tfcOnBlurReq :: [Path -> WidgetRequest s e]
_tfcOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnChange (TimeFieldCfg s e a) a e where
  onChange :: (a -> e) -> TimeFieldCfg s e a
onChange a -> e
fn = forall a. Default a => a
def {
    _tfcOnChangeReq :: [a -> WidgetRequest s e]
_tfcOnChangeReq = [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 (TimeFieldCfg s e a) s e a where
  onChangeReq :: (a -> WidgetRequest s e) -> TimeFieldCfg s e a
onChangeReq a -> WidgetRequest s e
req = forall a. Default a => a
def {
    _tfcOnChangeReq :: [a -> WidgetRequest s e]
_tfcOnChangeReq = [a -> WidgetRequest s e
req]
  }

-- | Time format HH:MM
timeFormatHHMM :: TimeFieldCfg s e a
timeFormatHHMM :: forall s e a. TimeFieldCfg s e a
timeFormatHHMM = forall a. Default a => a
def {
  _tfcTimeFormat :: Maybe TimeFieldFormat
_tfcTimeFormat = forall a. a -> Maybe a
Just TimeFieldFormat
FormatHHMM
}

-- | Time format HH:MM:SS
timeFormatHHMMSS :: TimeFieldCfg s e a
timeFormatHHMMSS :: forall s e a. TimeFieldCfg s e a
timeFormatHHMMSS = forall a. Default a => a
def {
  _tfcTimeFormat :: Maybe TimeFieldFormat
_tfcTimeFormat = forall a. a -> Maybe a
Just TimeFieldFormat
FormatHHMMSS
}

-- | Creates a time field using the given lens.
timeField
  :: (FormattableTime a, WidgetEvent e)
  => ALens' s a -> WidgetNode s e
timeField :: forall a e s.
(FormattableTime a, WidgetEvent e) =>
ALens' s a -> WidgetNode s e
timeField ALens' s a
field = forall a e s.
(FormattableTime a, WidgetEvent e) =>
ALens' s a -> [TimeFieldCfg s e a] -> WidgetNode s e
timeField_ ALens' s a
field forall a. Default a => a
def

-- | Creates a time field using the given lens. Accepts config.
timeField_
  :: (FormattableTime a, WidgetEvent e)
  => ALens' s a
  -> [TimeFieldCfg s e a]
  -> WidgetNode s e
timeField_ :: forall a e s.
(FormattableTime a, WidgetEvent e) =>
ALens' s a -> [TimeFieldCfg s e a] -> WidgetNode s e
timeField_ ALens' s a
field [TimeFieldCfg s e a]
configs = WidgetNode s e
widget where
  widget :: WidgetNode s e
widget = forall a e s.
(FormattableTime a, WidgetEvent e) =>
WidgetData s a -> [TimeFieldCfg s e a] -> WidgetNode s e
timeFieldD_ (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) [TimeFieldCfg s e a]
configs

-- | Creates a time field using the given value and 'onChange' event handler.
timeFieldV
  :: (FormattableTime a, WidgetEvent e)
  => a -> (a -> e) -> WidgetNode s e
timeFieldV :: forall a e s.
(FormattableTime a, WidgetEvent e) =>
a -> (a -> e) -> WidgetNode s e
timeFieldV a
value a -> e
handler = forall a e s.
(FormattableTime a, WidgetEvent e) =>
a -> (a -> e) -> [TimeFieldCfg s e a] -> WidgetNode s e
timeFieldV_ a
value a -> e
handler forall a. Default a => a
def

-- | Creates a time field using the given value and 'onChange' event handler.
--   Accepts config.
timeFieldV_
  :: (FormattableTime a, WidgetEvent e)
  => a
  -> (a -> e)
  -> [TimeFieldCfg s e a]
  -> WidgetNode s e
timeFieldV_ :: forall a e s.
(FormattableTime a, WidgetEvent e) =>
a -> (a -> e) -> [TimeFieldCfg s e a] -> WidgetNode s e
timeFieldV_ a
value a -> e
handler [TimeFieldCfg 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 :: [TimeFieldCfg s e a]
newConfigs = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler forall a. a -> [a] -> [a]
: [TimeFieldCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = forall a e s.
(FormattableTime a, WidgetEvent e) =>
WidgetData s a -> [TimeFieldCfg s e a] -> WidgetNode s e
timeFieldD_ forall {s}. WidgetData s a
widgetData [TimeFieldCfg s e a]
newConfigs

-- | Creates a time field providing a 'WidgetData' instance and config.
timeFieldD_
  :: (FormattableTime a, WidgetEvent e)
  => WidgetData s a
  -> [TimeFieldCfg s e a]
  -> WidgetNode s e
timeFieldD_ :: forall a e s.
(FormattableTime a, WidgetEvent e) =>
WidgetData s a -> [TimeFieldCfg s e a] -> WidgetNode s e
timeFieldD_ WidgetData s a
widgetData [TimeFieldCfg s e a]
configs = WidgetNode s e
newNode where
  config :: TimeFieldCfg s e a
config = forall a. Monoid a => [a] -> a
mconcat [TimeFieldCfg s e a]
configs
  format :: TimeFieldFormat
format = forall a. a -> Maybe a -> a
fromMaybe TimeFieldFormat
defaultTimeFormat (forall s e a. TimeFieldCfg s e a -> Maybe TimeFieldFormat
_tfcTimeFormat TimeFieldCfg s e a
config)
  minVal :: Maybe a
minVal = forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMinValue TimeFieldCfg s e a
config
  maxVal :: Maybe a
maxVal = forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMaxValue TimeFieldCfg s e a
config
  readOnly :: Bool
readOnly = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcReadOnly TimeFieldCfg 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. TimeTextConverter a => TimeOfDay -> a
timeFromTimeOfDay' TimeOfDay
midnight

  acceptText :: Text -> (Bool, Bool, Maybe a)
acceptText = forall a.
TimeTextConverter a =>
TimeFieldFormat
-> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
timeAcceptText TimeFieldFormat
format 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. TimeTextConverter a => TimeFieldFormat -> a -> Text
timeToText TimeFieldFormat
format

  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. TimeFieldCfg s e a -> Maybe (WidgetData s Bool)
_tfcValid TimeFieldCfg s e a
config,
    _ifcValidV :: [Bool -> e]
_ifcValidV = forall s e a. TimeFieldCfg s e a -> [Bool -> e]
_tfcValidV TimeFieldCfg 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. TimeFieldCfg s e a -> Maybe Double
_tfcCaretWidth TimeFieldCfg s e a
config,
    _ifcCaretMs :: Maybe Millisecond
_ifcCaretMs = forall s e a. TimeFieldCfg s e a -> Maybe Millisecond
_tfcCaretMs TimeFieldCfg 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. TimeFieldCfg s e a -> Maybe Bool
_tfcResizeOnChange TimeFieldCfg s e a
config),
    _ifcSelectOnFocus :: Bool
_ifcSelectOnFocus = forall a. a -> Maybe a -> a
fromMaybe Bool
True (forall s e a. TimeFieldCfg s e a -> Maybe Bool
_tfcSelectOnFocus TimeFieldCfg s e a
config),
    _ifcReadOnly :: Bool
_ifcReadOnly = Bool
readOnly,
    _ifcStyle :: Maybe (ALens' ThemeState StyleState)
_ifcStyle = forall a. a -> Maybe a
Just forall s a. HasTimeFieldStyle s a => Lens' s a
L.timeFieldStyle,
    _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.
FormattableTime a =>
TimeFieldCfg s e a
-> InputFieldState a
-> Point
-> Point
-> WheelDirection
-> (Text, Int, Maybe Int)
handleWheel TimeFieldCfg 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.
FormattableTime a =>
TimeFieldCfg s e a
-> InputFieldState a -> Point -> Point -> (Text, Int, Maybe Int)
handleDrag TimeFieldCfg 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. TimeFieldCfg s e a -> [Path -> WidgetRequest s e]
_tfcOnFocusReq TimeFieldCfg s e a
config,
    _ifcOnBlurReq :: [Path -> WidgetRequest s e]
_ifcOnBlurReq = forall s e a. TimeFieldCfg s e a -> [Path -> WidgetRequest s e]
_tfcOnBlurReq TimeFieldCfg s e a
config,
    _ifcOnChangeReq :: [a -> WidgetRequest s e]
_ifcOnChangeReq = forall s e a. TimeFieldCfg s e a -> [a -> WidgetRequest s e]
_tfcOnChangeReq TimeFieldCfg s e a
config
  }
  wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"timeField-" 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
  :: FormattableTime a
  => TimeFieldCfg s e a
  -> InputFieldState a
  -> Point
  -> Point
  -> WheelDirection
  -> (Text, Int, Maybe Int)
handleWheel :: forall a s e.
FormattableTime a =>
TimeFieldCfg s e a
-> InputFieldState a
-> Point
-> Point
-> WheelDirection
-> (Text, Int, Maybe Int)
handleWheel TimeFieldCfg 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. TimeFieldCfg s e a -> Maybe Double
_tfcWheelRate TimeFieldCfg s e a
config)
  result :: (Text, Int, Maybe Int)
result = forall a s e.
FormattableTime a =>
TimeFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove TimeFieldCfg s e a
config InputFieldState a
state Double
wheelRate a
curValue (Double
dy forall a. Num a => a -> a -> a
* Double
sign)

handleDrag
  :: FormattableTime a
  => TimeFieldCfg s e a
  -> InputFieldState a
  -> Point
  -> Point
  -> (Text, Int, Maybe Int)
handleDrag :: forall a s e.
FormattableTime a =>
TimeFieldCfg s e a
-> InputFieldState a -> Point -> Point -> (Text, Int, Maybe Int)
handleDrag TimeFieldCfg 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. TimeFieldCfg s e a -> Maybe Double
_tfcDragRate TimeFieldCfg s e a
config)
  result :: (Text, Int, Maybe Int)
result = forall a s e.
FormattableTime a =>
TimeFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove TimeFieldCfg s e a
config InputFieldState a
state Double
dragRate a
selValue Double
dy

handleMove
  :: FormattableTime a
  => TimeFieldCfg s e a
  -> InputFieldState a
  -> Double
  -> a
  -> Double
  -> (Text, Int, Maybe Int)
handleMove :: forall a s e.
FormattableTime a =>
TimeFieldCfg s e a
-> InputFieldState a
-> Double
-> a
-> Double
-> (Text, Int, Maybe Int)
handleMove TimeFieldCfg s e a
config InputFieldState a
state Double
rate a
value Double
dy = (Text, Int, Maybe Int)
result where
  format :: TimeFieldFormat
format = forall a. a -> Maybe a -> a
fromMaybe TimeFieldFormat
defaultTimeFormat (forall s e a. TimeFieldCfg s e a -> Maybe TimeFieldFormat
_tfcTimeFormat TimeFieldCfg s e a
config)
  minVal :: Maybe a
minVal = forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMinValue TimeFieldCfg s e a
config
  maxVal :: Maybe a
maxVal = forall s e a. TimeFieldCfg s e a -> Maybe a
_tfcMaxValue TimeFieldCfg s e a
config

  acceptText :: Text -> (Bool, Bool, Maybe a)
acceptText = forall a.
TimeTextConverter a =>
TimeFieldFormat
-> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
timeAcceptText TimeFieldFormat
format 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. TimeTextConverter a => TimeFieldFormat -> a -> Text
timeToText TimeFieldFormat
format

  (Bool
valid, Maybe a
mParsedVal, a
parsedVal) = case forall a. TimeTextConverter a => a -> Maybe TimeOfDay
timeToTimeOfDay' a
value of
    Just TimeOfDay
val -> (Bool
True, Maybe a
mParsedVal, a
parsedVal) where
      tmpValue :: TimeOfDay
tmpValue = Int -> TimeOfDay -> TimeOfDay
addMinutes (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
dy forall a. Num a => a -> a -> a
* Double
rate)) TimeOfDay
val
      mParsedVal :: Maybe a
mParsedVal = Text -> Maybe a
fromText (a -> Text
toText (forall a. TimeTextConverter a => TimeOfDay -> a
timeFromTimeOfDay' TimeOfDay
tmpValue))
      parsedVal :: a
parsedVal = forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
mParsedVal
    Maybe TimeOfDay
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)

timeFromTextSimple
  :: (TimeOfDayConverter a, FormattableTime a)
  => TimeFieldFormat
  -> Text
  -> Maybe a
timeFromTextSimple :: forall a.
(TimeOfDayConverter a, FormattableTime a) =>
TimeFieldFormat -> Text -> Maybe a
timeFromTextSimple TimeFieldFormat
format Text
text = Maybe a
newTime where
  compParser :: Parser Text Int
compParser = Char -> Parser Char
A.char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parser a
A.decimal
  timeParser :: Parser Text (Int, Int, Int)
timeParser
    | TimeFieldFormat
format forall a. Eq a => a -> a -> Bool
== TimeFieldFormat
FormatHHMM = (,,) 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
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
    | Bool
otherwise = (,,) 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
  tmpTime :: Maybe TimeOfDay
tmpTime = case forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Text (Int, Int, Int)
timeParser Text
text of
    Left String
_ -> forall a. Maybe a
Nothing
    Right (Int
n1, Int
n2, Int
n3)
      | TimeFieldFormat
format forall a. Eq a => a -> a -> Bool
== TimeFieldFormat
FormatHHMM -> Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
n1 Int
n2 Pico
0
      | Bool
otherwise -> Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
n1 Int
n2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n3)
  newTime :: Maybe a
newTime = Maybe TimeOfDay
tmpTime forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. TimeTextConverter a => TimeOfDay -> a
timeFromTimeOfDay'

timeToTextSimple :: FormattableTime a => TimeFieldFormat -> a -> Text
timeToTextSimple :: forall a. FormattableTime a => TimeFieldFormat -> a -> Text
timeToTextSimple TimeFieldFormat
format a
val = Text
result where
  sep :: Text
sep = Char -> Text
T.singleton Char
defaultTimeDelim
  converted :: Maybe TimeOfDay
converted = forall a. TimeTextConverter a => a -> Maybe TimeOfDay
timeToTimeOfDay' a
val
  TimeOfDay Int
hh Int
mm Pico
ss = forall a. HasCallStack => Maybe a -> a
fromJust Maybe TimeOfDay
converted
  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)
  thh :: Text
thh = forall {a}. (Ord a, Num a, Show a) => a -> Text
padd Int
hh
  tmm :: Text
tmm = forall {a}. (Ord a, Num a, Show a) => a -> Text
padd Int
mm
  tss :: Text
tss = forall {a}. (Ord a, Num a, Show a) => a -> Text
padd (forall a b. (RealFrac a, Integral b) => a -> b
round Pico
ss)
  result :: Text
result
    | forall a. Maybe a -> Bool
isNothing Maybe TimeOfDay
converted = Text
""
    | TimeFieldFormat
format forall a. Eq a => a -> a -> Bool
== TimeFieldFormat
FormatHHMM = Text
thh forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tmm
    | Bool
otherwise = Text
thh forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tmm forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
tss

acceptTextInput :: TimeFieldFormat -> Text -> Bool
acceptTextInput :: TimeFieldFormat -> Text -> Bool
acceptTextInput TimeFieldFormat
format 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
defaultTimeDelim forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
""
  hhP :: Parser Text Text
hhP = Int -> Parser Text Text -> Parser Text Text
P.upto Int
2 Parser Text Text
numP
  mmP :: Parser Text Text
mmP = Int -> Parser Text Text -> Parser Text Text
P.upto Int
2 Parser Text Text
numP
  ssP :: Parser Text Text
ssP = Int -> Parser Text Text -> Parser Text Text
P.upto Int
2 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
    | TimeFieldFormat
format forall a. Eq a => a -> a -> Bool
== TimeFieldFormat
FormatHHMM = [Parser Text Text
hhP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
mmP]
    | Bool
otherwise = [Parser Text Text
hhP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
mmP, forall {a}. IsString a => Parser Text a -> Parser Text a
withDelim Parser Text Text
ssP]
  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

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

addMinutes :: Int -> TimeOfDay -> TimeOfDay
addMinutes :: Int -> TimeOfDay -> TimeOfDay
addMinutes Int
mins TimeOfDay
time = TimeOfDay
newTime where
  baseDate :: Day
baseDate = Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
1 Int
1
  baseTime :: DiffTime
baseTime = TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
time
  baseUTC :: UTCTime
baseUTC = Day -> DiffTime -> UTCTime
UTCTime Day
baseDate DiffTime
baseTime
  UTCTime Day
newDate DiffTime
diff = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mins forall a. Num a => a -> a -> a
* NominalDiffTime
60) UTCTime
baseUTC
  newTime :: TimeOfDay
newTime
    | Day
newDate forall a. Ord a => a -> a -> Bool
> Day
baseDate = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
23 Int
59 Pico
59
    | Day
newDate forall a. Ord a => a -> a -> Bool
< Day
baseDate = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0
    | Bool
otherwise = DiffTime -> TimeOfDay
timeToTimeOfDay DiffTime
diff