{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module:      Data.Aeson.Parser.Time
-- Copyright:   (c) 2015-2016 Bryan O'Sullivan
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable
--
-- Parsers for parsing dates and times.

module Data.Attoparsec.Time
    (
      day
    , localTime
    , timeOfDay
    , timeZone
    , utcTime
    , zonedTime
    , year
    , month
    , quarter
    ) where

import Control.Applicative ((<|>))
import Data.Attoparsec.Text (Parser, char, digit, option, anyChar, peekChar, takeWhile1, satisfy)
import Data.Bits ((.&.))
import Data.Char (isDigit, ord)
import Data.Fixed (Pico, Fixed (..))
import Data.Int (Int64)
import Data.Integer.Conversion (textToInteger)
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (Day, fromGregorianValid)
import Data.Time.Calendar.Compat (Year)
import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..), fromYearQuarter)
import Data.Time.Calendar.Month.Compat (Month, fromYearMonthValid)
import Data.Time.Clock (UTCTime(..))
import qualified Data.Text as T
import qualified Data.Time.LocalTime as Local

-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
--
-- The year must contain at least 4 digits, to avoid the Y2K problem:
-- a two-digit year @YY@ may mean @YY@, @19YY@, or @20YY@, and we make it
-- an error to prevent the ambiguity.
-- Years from @0000@ to @0999@ must thus be zero-padded.
-- The year may have more than 4 digits.
day :: Parser Day
day :: Parser Day
day = do
  Year -> Year
absOrNeg <- Year -> Year
forall a. Num a => a -> a
negate (Year -> Year) -> Parser Text Char -> Parser Text (Year -> Year)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'-' Parser Text (Year -> Year)
-> Parser Text (Year -> Year) -> Parser Text (Year -> Year)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Year -> Year
forall a. a -> a
id (Year -> Year) -> Parser Text Char -> Parser Text (Year -> Year)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'+' Parser Text (Year -> Year)
-> Parser Text (Year -> Year) -> Parser Text (Year -> Year)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Year -> Year) -> Parser Text (Year -> Year)
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Year -> Year
forall a. a -> a
id
  Year
y <- (Parser Year
year Parser Year -> Parser Text Char -> Parser Year
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'-') Parser Year -> Parser Year -> Parser Year
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Year
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"date must be of form [+,-]YYYY-MM-DD"
  Int
m <- (Parser Int
twoDigits Parser Int -> Parser Text Char -> Parser Int
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'-') Parser Int -> Parser Int -> Parser Int
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Int
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"date must be of form [+,-]YYYY-MM-DD"
  Int
d <- Parser Int
twoDigits Parser Int -> Parser Int -> Parser Int
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Int
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"date must be of form [+,-]YYYY-MM-DD"
  Parser Day -> (Day -> Parser Day) -> Maybe Day -> Parser Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Day
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid date") Day -> Parser Day
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Year -> Int -> Int -> Maybe Day
fromGregorianValid (Year -> Year
absOrNeg Year
y) Int
m Int
d)

-- | Parse a month of the form @[+,-]YYYY-MM@.
--
-- See also 'day' for details about the year format.
month :: Parser Month
month :: Parser Month
month = do
  Year -> Year
absOrNeg <- Year -> Year
forall a. Num a => a -> a
negate (Year -> Year) -> Parser Text Char -> Parser Text (Year -> Year)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'-' Parser Text (Year -> Year)
-> Parser Text (Year -> Year) -> Parser Text (Year -> Year)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Year -> Year
forall a. a -> a
id (Year -> Year) -> Parser Text Char -> Parser Text (Year -> Year)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'+' Parser Text (Year -> Year)
-> Parser Text (Year -> Year) -> Parser Text (Year -> Year)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Year -> Year) -> Parser Text (Year -> Year)
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Year -> Year
forall a. a -> a
id
  Year
y <- (Parser Year
year Parser Year -> Parser Text Char -> Parser Year
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'-') Parser Year -> Parser Year -> Parser Year
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Year
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be of form [+,-]YYYY-MM"
  Int
m <- Parser Int
twoDigits Parser Int -> Parser Int -> Parser Int
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Int
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be of form [+,-]YYYY-MM"
  Parser Month
-> (Month -> Parser Month) -> Maybe Month -> Parser Month
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Month
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid month") Month -> Parser Month
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Year -> Int -> Maybe Month
fromYearMonthValid (Year -> Year
absOrNeg Year
y) Int
m)

-- | Parse a quarter of the form @[+,-]YYYY-QN@.
--
-- See also 'day' for details about the year format.
quarter :: Parser Quarter
quarter :: Parser Quarter
quarter = do
  Year -> Year
absOrNeg <- Year -> Year
forall a. Num a => a -> a
negate (Year -> Year) -> Parser Text Char -> Parser Text (Year -> Year)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'-' Parser Text (Year -> Year)
-> Parser Text (Year -> Year) -> Parser Text (Year -> Year)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Year -> Year
forall a. a -> a
id (Year -> Year) -> Parser Text Char -> Parser Text (Year -> Year)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'+' Parser Text (Year -> Year)
-> Parser Text (Year -> Year) -> Parser Text (Year -> Year)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Year -> Year) -> Parser Text (Year -> Year)
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Year -> Year
forall a. a -> a
id
  Year
y <- (Parser Year
year Parser Year -> Parser Text Char -> Parser Year
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'-') Parser Year -> Parser Year -> Parser Year
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Year
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be of form [+,-]YYYY-MM"
  Char
_ <- Char -> Parser Text Char
char Char
'q' Parser Text Char -> Parser Text Char -> Parser Text Char
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text Char
char Char
'Q'
  QuarterOfYear
q <- Parser Text QuarterOfYear
parseQ
  Quarter -> Parser Quarter
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Quarter -> Parser Quarter) -> Quarter -> Parser Quarter
forall a b. (a -> b) -> a -> b
$! Year -> QuarterOfYear -> Quarter
fromYearQuarter (Year -> Year
absOrNeg Year
y) QuarterOfYear
q
  where
    parseQ :: Parser Text QuarterOfYear
parseQ = QuarterOfYear
Q1 QuarterOfYear -> Parser Text Char -> Parser Text QuarterOfYear
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'1'
      Parser Text QuarterOfYear
-> Parser Text QuarterOfYear -> Parser Text QuarterOfYear
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QuarterOfYear
Q2 QuarterOfYear -> Parser Text Char -> Parser Text QuarterOfYear
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'2'
      Parser Text QuarterOfYear
-> Parser Text QuarterOfYear -> Parser Text QuarterOfYear
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QuarterOfYear
Q3 QuarterOfYear -> Parser Text Char -> Parser Text QuarterOfYear
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'3'
      Parser Text QuarterOfYear
-> Parser Text QuarterOfYear -> Parser Text QuarterOfYear
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QuarterOfYear
Q4 QuarterOfYear -> Parser Text Char -> Parser Text QuarterOfYear
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'4'

-- | Parse a year @YYYY@, with at least 4 digits. Does not include any sign.
--
-- Note: 'Year' is a type synonym for 'Integer'.
--
-- @since 1.1.0.0
year :: Parser Year
year :: Parser Year
year = do
  Text
ds <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isDigit
  if Text -> Int
T.length Text
ds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then
    String -> Parser Year
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected year with at least 4 digits"
  else
    Year -> Parser Year
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Year
textToInteger Text
ds)

-- | Parse a two-digit integer (e.g. day of month, hour).
twoDigits :: Parser Int
twoDigits :: Parser Int
twoDigits = do
  Char
a <- Parser Text Char
digit
  Char
b <- Parser Text Char
digit
  let c2d :: Char -> Int
c2d Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15
  Int -> Parser Int
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$! Char -> Int
c2d Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
c2d Char
b

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
timeOfDay :: Parser Local.TimeOfDay
timeOfDay :: Parser TimeOfDay
timeOfDay = do
  Int
h <- Parser Int
twoDigits
  Int
m <- Char -> Parser Text Char
char Char
':' Parser Text Char -> Parser Int -> Parser Int
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
twoDigits
  Pico
s <- Pico -> Parser Text Pico -> Parser Text Pico
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Pico
0 (Char -> Parser Text Char
char Char
':' Parser Text Char -> Parser Text Pico -> Parser Text Pico
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Pico
seconds)
  if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
60 Bool -> Bool -> Bool
&& Pico
s Pico -> Pico -> Bool
forall a. Ord a => a -> a -> Bool
< Pico
61
    then TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Pico -> TimeOfDay
Local.TimeOfDay Int
h Int
m Pico
s)
    else String -> Parser TimeOfDay
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid time"

data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64

-- | Parse a count of seconds, with the integer part being two digits
-- long.
seconds :: Parser Pico
seconds :: Parser Text Pico
seconds = do
  Int
real <- Parser Int
twoDigits
  Maybe Char
mc <- Parser (Maybe Char)
peekChar
  case Maybe Char
mc of
    Just Char
'.' -> do
      Text
t <- Parser Text Char
anyChar Parser Text Char -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isDigit
      Pico -> Parser Text Pico
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pico -> Parser Text Pico) -> Pico -> Parser Text Pico
forall a b. (a -> b) -> a -> b
$! Int -> Text -> Pico
forall {p} {a}. Integral p => p -> Text -> Fixed a
parsePicos Int
real Text
t
    Maybe Char
_ -> Pico -> Parser Text Pico
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pico -> Parser Text Pico) -> Pico -> Parser Text Pico
forall a b. (a -> b) -> a -> b
$! Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
real
 where
  parsePicos :: p -> Text -> Fixed a
parsePicos p
a0 Text
t = Year -> Fixed a
forall k (a :: k). Year -> Fixed a
MkFixed (Int64 -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
t' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n))
    where T Int
n Int64
t'  = (T -> Char -> T) -> T -> Text -> T
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' T -> Char -> T
step (Int -> Int64 -> T
T Int
12 (p -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
a0)) Text
t
          step :: T -> Char -> T
step ma :: T
ma@(T Int
m Int64
a) Char
c
              | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = T
ma
              | Bool
otherwise = Int -> Int64 -> T
T (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int64
10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
a Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
15)

-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
-- zero. (This makes some speedups possible.)
--
-- The accepted formats are @Z@, @+HH@, @+HHMM@, or @+HH:MM@.
--
timeZone :: Parser (Maybe Local.TimeZone)
timeZone :: Parser (Maybe TimeZone)
timeZone = do
  Char
ch <- (Char -> Bool) -> Parser Text Char
satisfy ((Char -> Bool) -> Parser Text Char)
-> (Char -> Bool) -> Parser Text Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
  if Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z'
    then Maybe TimeZone -> Parser (Maybe TimeZone)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TimeZone
forall a. Maybe a
Nothing
    else do
      Int
h <- Parser Int
twoDigits
      Maybe Char
mm <- Parser (Maybe Char)
peekChar
      Int
m <- case Maybe Char
mm of
             Just Char
':'           -> Parser Text Char
anyChar Parser Text Char -> Parser Int -> Parser Int
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
twoDigits
             Just Char
d | Char -> Bool
isDigit Char
d -> Parser Int
twoDigits
             Maybe Char
_                  -> Int -> Parser Int
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
      let off :: Int
off | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = Int -> Int
forall a. Num a => a -> a
negate Int
off0
              | Bool
otherwise = Int
off0
          off0 :: Int
off0 = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
      case Any
forall a. HasCallStack => a
undefined of
        Any
_   | Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
              Maybe TimeZone -> Parser (Maybe TimeZone)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TimeZone
forall a. Maybe a
Nothing
            | Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
720 Bool -> Bool -> Bool
|| Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
840 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59 ->
              String -> Parser (Maybe TimeZone)
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid time zone offset"
            | Bool
otherwise ->
              let !tz :: TimeZone
tz = Int -> TimeZone
Local.minutesToTimeZone Int
off
              in Maybe TimeZone -> Parser (Maybe TimeZone)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
tz)

-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
-- The space may be replaced with a @T@.  The number of seconds is optional
-- and may be followed by a fractional component.
localTime :: Parser Local.LocalTime
localTime :: Parser LocalTime
localTime = Day -> TimeOfDay -> LocalTime
Local.LocalTime (Day -> TimeOfDay -> LocalTime)
-> Parser Day -> Parser Text (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
day Parser Text (TimeOfDay -> LocalTime)
-> Parser Text Char -> Parser Text (TimeOfDay -> LocalTime)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char
daySep Parser Text (TimeOfDay -> LocalTime)
-> Parser TimeOfDay -> Parser LocalTime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
timeOfDay
  where daySep :: Parser Text Char
daySep = (Char -> Bool) -> Parser Text Char
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'T' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')

-- | Behaves as 'zonedTime', but converts any time zone offset into a
-- UTC time.
utcTime :: Parser UTCTime
utcTime :: Parser UTCTime
utcTime = do
  lt :: LocalTime
lt@(Local.LocalTime Day
d TimeOfDay
t) <- Parser LocalTime
localTime
  Maybe TimeZone
mtz <- Parser (Maybe TimeZone)
timeZone
  case Maybe TimeZone
mtz of
    Maybe TimeZone
Nothing -> let !tt :: DiffTime
tt = TimeOfDay -> DiffTime
Local.timeOfDayToTime TimeOfDay
t
               in UTCTime -> Parser UTCTime
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
tt)
    Just TimeZone
tz -> UTCTime -> Parser UTCTime
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Parser UTCTime) -> UTCTime -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$! TimeZone -> LocalTime -> UTCTime
Local.localTimeToUTC TimeZone
tz LocalTime
lt


-- | Parse a date with time zone info. Acceptable formats:
--
-- @YYYY-MM-DD HH:MM Z@
-- @YYYY-MM-DD HH:MM:SS Z@
-- @YYYY-MM-DD HH:MM:SS.SSS Z@
--
-- The first space may instead be a @T@, and the second space is
-- optional.  The @Z@ represents UTC.  The @Z@ may be replaced with a
-- time zone offset of the form @+0000@ or @-08:00@, where the first
-- two digits are hours, the @:@ is optional and the second two digits
-- (also optional) are minutes.
zonedTime :: Parser Local.ZonedTime
zonedTime :: Parser ZonedTime
zonedTime = LocalTime -> TimeZone -> ZonedTime
Local.ZonedTime (LocalTime -> TimeZone -> ZonedTime)
-> Parser LocalTime -> Parser Text (TimeZone -> ZonedTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LocalTime
localTime Parser Text (TimeZone -> ZonedTime)
-> Parser Text TimeZone -> Parser ZonedTime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TimeZone -> Maybe TimeZone -> TimeZone
forall a. a -> Maybe a -> a
fromMaybe TimeZone
utc (Maybe TimeZone -> TimeZone)
-> Parser (Maybe TimeZone) -> Parser Text TimeZone
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe TimeZone)
timeZone)

utc :: Local.TimeZone
utc :: TimeZone
utc = Int -> Bool -> String -> TimeZone
Local.TimeZone Int
0 Bool
False String
""