{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Text.Megaparsec.Time
-- Description : Various parsers for types related to time.
-- Copyright   : (c) drlkf, 2024
-- License     : GPL-3
-- Maintainer  : drlkf@drlkf.net
-- Stability   : experimental
module Text.Megaparsec.Time (
  -- * Types.
  DayResult,

  -- * Simple parsers.
  hoursParser,
  minutesParser,
  secondsParser,
  timeParser,
  dayParser,
  gregorianDayParser,

  -- * Composite parsers.
  dateParser,
  durationParser,
) where

import Control.Applicative (optional, (<|>))
import Control.Monad (replicateM)
import Control.Monad.Combinators (choice, some)
import Data.Char (toLower)
import Data.Functor (($>))
import Data.Maybe (fromMaybe)
import Data.Time (
  Day,
  DayOfWeek (..),
  NominalDiffTime,
  TimeOfDay (..),
  defaultTimeLocale,
  makeTimeOfDayValid,
  parseTimeM,
  secondsToNominalDiffTime,
 )
import Text.Megaparsec (Parsec, takeRest, try)
import Text.Megaparsec.Char (
  char,
  digitChar,
  space,
  space1,
  string',
 )
import Text.Printf (printf)

_posNumParser
  :: Ord e
  => Read a
  => Parsec e String a
_posNumParser :: forall e a. (Ord e, Read a) => Parsec e String a
_posNumParser = String -> a
forall a. Read a => String -> a
read (String -> a)
-> ParsecT e String Identity String -> ParsecT e String Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity Char -> ParsecT e String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT e String Identity Char
ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

-- | Representation of a parser result with either a number of days relative to
-- the current day, or a 'DayOfWeek'.
type DayResult = Either Int DayOfWeek

-- | Parse a tuple containing a day or not, and a 'TimeOfDay'.
dateParser
  :: Ord e
  => Parsec e String (Maybe DayResult, TimeOfDay)
dateParser :: forall e. Ord e => Parsec e String (Maybe DayResult, TimeOfDay)
dateParser = (,) (Maybe DayResult -> TimeOfDay -> (Maybe DayResult, TimeOfDay))
-> ParsecT e String Identity (Maybe DayResult)
-> ParsecT
     e String Identity (TimeOfDay -> (Maybe DayResult, TimeOfDay))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity DayResult
-> ParsecT e String Identity (Maybe DayResult)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT e String Identity DayResult
-> ParsecT e String Identity DayResult
forall a.
ParsecT e String Identity a -> ParsecT e String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT e String Identity DayResult
forall e. Ord e => Parsec e String DayResult
dayParser ParsecT e String Identity DayResult
-> ParsecT e String Identity ()
-> ParsecT e String Identity DayResult
forall a b.
ParsecT e String Identity a
-> ParsecT e String Identity b -> ParsecT e String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT e String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1)) ParsecT
  e String Identity (TimeOfDay -> (Maybe DayResult, TimeOfDay))
-> ParsecT e String Identity TimeOfDay
-> ParsecT e String Identity (Maybe DayResult, TimeOfDay)
forall a b.
ParsecT e String Identity (a -> b)
-> ParsecT e String Identity a -> ParsecT e String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT e String Identity TimeOfDay
forall e. Ord e => Parsec e String TimeOfDay
timeParser

-- | Parse a day using one of the following, all case-insensitive:
--
--   * a short (3-letters) or long day name e.g @mon@ or @monday@
--   * @yesterday@ or @tomorrow@
--   * a day number relative to the current day i.e @+2@ is two days from today
--   * an absolute number for a 'DayOfWeek', refer to its 'Num' instance for more information.
dayParser
  :: Ord e
  => Parsec e String DayResult
dayParser :: forall e. Ord e => Parsec e String DayResult
dayParser =
  [ParsecT e String Identity DayResult]
-> ParsecT e String Identity DayResult
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ DayOfWeek -> DayResult
forall a b. b -> Either a b
Right (DayOfWeek -> DayResult)
-> ParsecT e String Identity DayOfWeek
-> ParsecT e String Identity DayResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity DayOfWeek
longDay
    , DayOfWeek -> DayResult
forall a b. b -> Either a b
Right (DayOfWeek -> DayResult)
-> ParsecT e String Identity DayOfWeek
-> ParsecT e String Identity DayResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity DayOfWeek
shortDay
    , Int -> DayResult
forall a b. a -> Either a b
Left (Int -> DayResult)
-> ParsecT e String Identity Int
-> ParsecT e String Identity DayResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens String -> ParsecT e String Identity (Tokens String)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' String
Tokens String
"yesterday" ParsecT e String Identity (Tokens String)
-> Int -> ParsecT e String Identity Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> -Int
1)
    , Int -> DayResult
forall a b. a -> Either a b
Left (Int -> DayResult)
-> ParsecT e String Identity Int
-> ParsecT e String Identity DayResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens String -> ParsecT e String Identity (Tokens String)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' String
Tokens String
"tomorrow" ParsecT e String Identity (Tokens String)
-> Int -> ParsecT e String Identity Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
1)
    , DayOfWeek -> DayResult
forall a b. b -> Either a b
Right (DayOfWeek -> DayResult)
-> ParsecT e String Identity DayOfWeek
-> ParsecT e String Identity DayResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity DayOfWeek
absoluteDay
    , Int -> DayResult
forall a b. a -> Either a b
Left (Int -> DayResult)
-> ParsecT e String Identity Int
-> ParsecT e String Identity DayResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity Int
relativeDay
    ]
 where
  shortDay :: ParsecT e String Identity DayOfWeek
shortDay = [ParsecT e String Identity DayOfWeek]
-> ParsecT e String Identity DayOfWeek
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT e String Identity DayOfWeek]
 -> ParsecT e String Identity DayOfWeek)
-> [ParsecT e String Identity DayOfWeek]
-> ParsecT e String Identity DayOfWeek
forall a b. (a -> b) -> a -> b
$ (DayOfWeek -> ParsecT e String Identity DayOfWeek)
-> [DayOfWeek] -> [ParsecT e String Identity DayOfWeek]
forall a b. (a -> b) -> [a] -> [b]
map ((DayOfWeek -> Tokens String)
-> DayOfWeek -> ParsecT e String Identity DayOfWeek
forall {f :: * -> *} {e} {s} {b}.
(MonadParsec e s f, FoldCase (Tokens s)) =>
(b -> Tokens s) -> b -> f b
ciString ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower (String -> String) -> (DayOfWeek -> String) -> DayOfWeek -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> (DayOfWeek -> String) -> DayOfWeek -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek -> String
forall a. Show a => a -> String
show)) [DayOfWeek]
weekDays
  longDay :: ParsecT e String Identity DayOfWeek
longDay = [ParsecT e String Identity DayOfWeek]
-> ParsecT e String Identity DayOfWeek
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT e String Identity DayOfWeek]
 -> ParsecT e String Identity DayOfWeek)
-> [ParsecT e String Identity DayOfWeek]
-> ParsecT e String Identity DayOfWeek
forall a b. (a -> b) -> a -> b
$ (DayOfWeek -> ParsecT e String Identity DayOfWeek)
-> [DayOfWeek] -> [ParsecT e String Identity DayOfWeek]
forall a b. (a -> b) -> [a] -> [b]
map ((DayOfWeek -> Tokens String)
-> DayOfWeek -> ParsecT e String Identity DayOfWeek
forall {f :: * -> *} {e} {s} {b}.
(MonadParsec e s f, FoldCase (Tokens s)) =>
(b -> Tokens s) -> b -> f b
ciString ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower (String -> String) -> (DayOfWeek -> String) -> DayOfWeek -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek -> String
forall a. Show a => a -> String
show)) [DayOfWeek]
weekDays
  ciString :: (b -> Tokens s) -> b -> f b
ciString b -> Tokens s
f b
d = f (Tokens s) -> f (Tokens s)
forall a. f a -> f a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' (b -> Tokens s
f b
d)) f (Tokens s) -> b -> f b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
d
  weekDays :: [DayOfWeek]
weekDays = [DayOfWeek
Monday .. DayOfWeek
Friday]
  sign :: ParsecT e String Identity (Int -> Int)
sign = (Token String -> ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-' ParsecT e String Identity Char
-> (Int -> Int) -> ParsecT e String Identity (Int -> Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> Int
forall a. Num a => a -> a
negate) ParsecT e String Identity (Int -> Int)
-> ParsecT e String Identity (Int -> Int)
-> ParsecT e String Identity (Int -> Int)
forall a.
ParsecT e String Identity a
-> ParsecT e String Identity a -> ParsecT e String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token String -> ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'+' ParsecT e String Identity Char
-> (Int -> Int) -> ParsecT e String Identity (Int -> Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> Int
forall a. a -> a
id)
  absoluteDay :: ParsecT e String Identity DayOfWeek
absoluteDay = Int -> DayOfWeek
forall a. Enum a => Int -> a
toEnum (Int -> DayOfWeek) -> (String -> Int) -> String -> DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> DayOfWeek)
-> ParsecT e String Identity String
-> ParsecT e String Identity DayOfWeek
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity Char -> ParsecT e String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT e String Identity Char
ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
  relativeDay :: ParsecT e String Identity Int
relativeDay = (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
($) ((Int -> Int) -> Int -> Int)
-> ParsecT e String Identity (Int -> Int)
-> ParsecT e String Identity (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity (Int -> Int)
sign ParsecT e String Identity (Int -> Int)
-> ParsecT e String Identity Int -> ParsecT e String Identity Int
forall a b.
ParsecT e String Identity (a -> b)
-> ParsecT e String Identity a -> ParsecT e String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT e String Identity String
-> ParsecT e String Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity Char -> ParsecT e String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT e String Identity Char
ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)

-- | Parse a 'NominalDiffTime' using strings like @1h23m45s@, with all
-- components being optional as long as one is present.
durationParser
  :: Ord e
  => Parsec e String NominalDiffTime
durationParser :: forall e. Ord e => Parsec e String NominalDiffTime
durationParser = ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity NominalDiffTime
forall a.
ParsecT e String Identity a -> ParsecT e String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT e String Identity NominalDiffTime
hours ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity NominalDiffTime
forall a.
ParsecT e String Identity a
-> ParsecT e String Identity a -> ParsecT e String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity NominalDiffTime
forall a.
ParsecT e String Identity a -> ParsecT e String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT e String Identity NominalDiffTime
minutes ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity NominalDiffTime
forall a.
ParsecT e String Identity a
-> ParsecT e String Identity a -> ParsecT e String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT e String Identity NominalDiffTime
forall e. Ord e => Parsec e String NominalDiffTime
secondsParser
 where
  hours :: ParsecT e String Identity NominalDiffTime
hours = do
    NominalDiffTime
h <- ParsecT e String Identity NominalDiffTime
forall e. Ord e => Parsec e String NominalDiffTime
hoursParser ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity ()
-> ParsecT e String Identity NominalDiffTime
forall a b.
ParsecT e String Identity a
-> ParsecT e String Identity b -> ParsecT e String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT e String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    NominalDiffTime
m <- NominalDiffTime -> Maybe NominalDiffTime -> NominalDiffTime
forall a. a -> Maybe a -> a
fromMaybe NominalDiffTime
zero (Maybe NominalDiffTime -> NominalDiffTime)
-> ParsecT e String Identity (Maybe NominalDiffTime)
-> ParsecT e String Identity NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity (Maybe NominalDiffTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity NominalDiffTime
forall a.
ParsecT e String Identity a -> ParsecT e String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT e String Identity NominalDiffTime
minutes)
    NominalDiffTime
s <- NominalDiffTime -> Maybe NominalDiffTime -> NominalDiffTime
forall a. a -> Maybe a -> a
fromMaybe NominalDiffTime
zero (Maybe NominalDiffTime -> NominalDiffTime)
-> ParsecT e String Identity (Maybe NominalDiffTime)
-> ParsecT e String Identity NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity (Maybe NominalDiffTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT e String Identity NominalDiffTime
forall e. Ord e => Parsec e String NominalDiffTime
secondsParser

    NominalDiffTime -> ParsecT e String Identity NominalDiffTime
forall a. a -> ParsecT e String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime
h NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
m NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
s)

  minutes :: ParsecT e String Identity NominalDiffTime
minutes = do
    NominalDiffTime
m <- ParsecT e String Identity NominalDiffTime
forall e. Ord e => Parsec e String NominalDiffTime
minutesParser ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity ()
-> ParsecT e String Identity NominalDiffTime
forall a b.
ParsecT e String Identity a
-> ParsecT e String Identity b -> ParsecT e String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT e String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    NominalDiffTime
s <- NominalDiffTime -> Maybe NominalDiffTime -> NominalDiffTime
forall a. a -> Maybe a -> a
fromMaybe NominalDiffTime
zero (Maybe NominalDiffTime -> NominalDiffTime)
-> ParsecT e String Identity (Maybe NominalDiffTime)
-> ParsecT e String Identity NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity (Maybe NominalDiffTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT e String Identity NominalDiffTime
forall e. Ord e => Parsec e String NominalDiffTime
secondsParser

    NominalDiffTime -> ParsecT e String Identity NominalDiffTime
forall a. a -> ParsecT e String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime
m NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
s)

-- | Parse a Gregorian 'Day' from a @%F@ or @%d\/%m\/%Y@ format.
gregorianDayParser
  :: Ord e
  => Parsec e String Day
gregorianDayParser :: forall e. Ord e => Parsec e String Day
gregorianDayParser = do
  String
s <- ParsecT e String Identity String
ParsecT e String Identity (Tokens String)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest

  let parseTime :: String -> Parsec e String Day
parseTime = (String -> String -> Parsec e String Day)
-> String -> String -> Parsec e String Day
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> TimeLocale -> String -> String -> Parsec e String Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale) String
s

  String -> Parsec e String Day
parseTime String
"%F" Parsec e String Day -> Parsec e String Day -> Parsec e String Day
forall a.
ParsecT e String Identity a
-> ParsecT e String Identity a -> ParsecT e String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parsec e String Day
parseTime String
"%d/%m/%Y"

-- | Parse a 'NominalDiffTime' from a number of hours from a string like @1h@.
hoursParser
  :: Ord e
  => Parsec e String NominalDiffTime
hoursParser :: forall e. Ord e => Parsec e String NominalDiffTime
hoursParser = Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime)
-> (Pico -> Pico) -> Pico -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* Pico
3600) (Pico -> NominalDiffTime)
-> ParsecT e String Identity Pico
-> ParsecT e String Identity NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity Pico
forall e a. (Ord e, Read a) => Parsec e String a
_posNumParser ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity Char
-> ParsecT e String Identity NominalDiffTime
forall a b.
ParsecT e String Identity a
-> ParsecT e String Identity b -> ParsecT e String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token String -> ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'h'

-- | Parse a 'NominalDiffTime' from a number of minutes from a string like @1m@.
minutesParser
  :: Ord e
  => Parsec e String NominalDiffTime
minutesParser :: forall e. Ord e => Parsec e String NominalDiffTime
minutesParser = Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime)
-> (Pico -> Pico) -> Pico -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* Pico
60) (Pico -> NominalDiffTime)
-> ParsecT e String Identity Pico
-> ParsecT e String Identity NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity Pico
forall e a. (Ord e, Read a) => Parsec e String a
_posNumParser ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity Char
-> ParsecT e String Identity NominalDiffTime
forall a b.
ParsecT e String Identity a
-> ParsecT e String Identity b -> ParsecT e String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token String -> ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'm'

-- | Parse a 'NominalDiffTime' from a number of seconds from a string like @1s@.
secondsParser
  :: Ord e
  => Parsec e String NominalDiffTime
secondsParser :: forall e. Ord e => Parsec e String NominalDiffTime
secondsParser = Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime)
-> ParsecT e String Identity Pico
-> ParsecT e String Identity NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e String Identity Pico
forall e a. (Ord e, Read a) => Parsec e String a
_posNumParser ParsecT e String Identity NominalDiffTime
-> ParsecT e String Identity (Maybe Char)
-> ParsecT e String Identity NominalDiffTime
forall a b.
ParsecT e String Identity a
-> ParsecT e String Identity b -> ParsecT e String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT e String Identity Char
-> ParsecT e String Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token String -> ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
's')

-- | Parse a 'TimeOfDay' from a string like @01:23@.
timeParser
  :: Ord e
  => Parsec e String TimeOfDay
timeParser :: forall e. Ord e => Parsec e String TimeOfDay
timeParser = do
  Int
h <- String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT e String Identity String
-> ParsecT e String Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT e String Identity Char
-> ParsecT e String Identity String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 ParsecT e String Identity Char
ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT e String Identity Int
-> ParsecT e String Identity Char -> ParsecT e String Identity Int
forall a b.
ParsecT e String Identity a
-> ParsecT e String Identity b -> ParsecT e String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token String -> ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
':'
  Int
m <- String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT e String Identity String
-> ParsecT e String Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT e String Identity Char
-> ParsecT e String Identity String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 ParsecT e String Identity Char
ParsecT e String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

  Parsec e String TimeOfDay
-> (TimeOfDay -> Parsec e String TimeOfDay)
-> Maybe TimeOfDay
-> Parsec e String TimeOfDay
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> Parsec e String TimeOfDay
forall a. String -> ParsecT e String Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"invalid hours or minutes %02d:%02d" Int
h Int
m))
    TimeOfDay -> Parsec e String TimeOfDay
forall a. a -> ParsecT e String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
h Int
m Pico
0)

-- | Zero seconds in 'NominalDiffTime'.
zero :: NominalDiffTime
zero :: NominalDiffTime
zero = Pico -> NominalDiffTime
secondsToNominalDiffTime Pico
0