    {-# 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
      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
      y <- (year <* char '-') <|> fail "date must be of form [+,-]YYYY-MM-DD"
      m <- (twoDigits <* char '-') <|> fail "date must be of form [+,-]YYYY-MM-DD"
      d <- twoDigits <|> fail "date must be of form [+,-]YYYY-MM-DD"
      maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m 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
      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
      y <- (year <* char '-') <|> fail "month must be of form [+,-]YYYY-MM"
      m <- twoDigits <|> fail "month must be of form [+,-]YYYY-MM"
      maybe (fail "invalid month") return (fromYearMonthValid (absOrNeg y) 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
      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
      y <- (year <* char '-') <|> fail "month must be of form [+,-]YYYY-MM"
      _ <- char 'q' <|> char 'Q'
      q <- parseQ
      return $! fromYearQuarter (absOrNeg y) 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
      ds <- (Char -> Bool) -> Parser Text
    takeWhile1 Char -> Bool
    isDigit
      if T.length ds < 4 then
        fail "expected year with at least 4 digits"
      else
        pure (textToInteger ds)

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

    -- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
    timeOfDay :: Parser Local.TimeOfDay
    timeOfDay :: Parser TimeOfDay
    timeOfDay = do
      h <- Parser Int
    twoDigits
      m <- char ':' *> twoDigits
      s <- option 0 (char ':' *> seconds)
      if h < 24 && m < 60 && s < 61
        then return (Local.TimeOfDay h m s)
        else fail "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
      real <- Parser Int
    twoDigits
      mc <- peekChar
      case mc of
        Just Char
    '.' -> do
          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
          return $! parsePicos real 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
      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 ch == 'Z'
        then return Nothing
        else do
          h <- twoDigits
          mm <- peekChar
          m <- case 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 | 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
    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 undefined of
            ZonkAny 0
    _   | 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@(Local.LocalTime d t) <- Parser LocalTime
    localTime
      mtz <- timeZone
      case 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
    ""