{-# language OverloadedStrings #-}
{-# language TypeApplications #-}

module Rel8.Type.Parser.Time
  ( calendarDiffTime
  , day
  , localTime
  , timeOfDay
  , utcTime
  )
where

-- attoparsec
import qualified Data.Attoparsec.ByteString.Char8 as A

-- base
import Control.Applicative ((<|>), optional)
import Data.Bits ((.&.))
import Data.Bool (bool)
import Data.Fixed (Fixed (MkFixed), Pico, divMod')
import Data.Functor (void)
import Data.Int (Int64)
import Prelude

-- bytestring
import qualified Data.ByteString as BS

-- time
import Data.Time.Calendar (Day, addDays, fromGregorianValid)
import Data.Time.Clock (DiffTime, UTCTime (UTCTime))
import Data.Time.Format.ISO8601 (iso8601ParseM)
import Data.Time.LocalTime
  ( CalendarDiffTime (CalendarDiffTime)
  , LocalTime (LocalTime)
  , TimeOfDay (TimeOfDay)
  , sinceMidnight
  )

-- utf8
import qualified Data.ByteString.UTF8 as UTF8


day :: A.Parser Day
day :: Parser Day
day = do
  Year
y <- Parser Year
forall a. Integral a => Parser a
A.decimal Parser Year -> Parser ByteString Char -> Parser Year
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
'-'
  Int
m <- Parser Int
twoDigits Parser Int -> Parser ByteString Char -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
'-'
  Int
d <- Parser Int
twoDigits
  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 ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Day: invalid date") Day -> Parser Day
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Day -> Parser Day) -> Maybe Day -> Parser Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Maybe Day
fromGregorianValid Year
y Int
m Int
d


timeOfDay :: A.Parser TimeOfDay
timeOfDay :: Parser TimeOfDay
timeOfDay = do
  Int
h <- Parser Int
twoDigits
  Int
m <- Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char -> Parser Int -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
twoDigits
  Pico
s <- Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char
-> Parser ByteString Pico -> Parser ByteString Pico
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Pico
secondsParser
  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
60
    then TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeOfDay -> Parser TimeOfDay) -> TimeOfDay -> Parser TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s
    else String -> Parser TimeOfDay
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"TimeOfDay: invalid time"


localTime :: A.Parser LocalTime
localTime :: Parser LocalTime
localTime = Day -> TimeOfDay -> LocalTime
LocalTime (Day -> TimeOfDay -> LocalTime)
-> Parser Day -> Parser ByteString (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
day Parser ByteString (TimeOfDay -> LocalTime)
-> Parser ByteString Char
-> Parser ByteString (TimeOfDay -> LocalTime)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
separator Parser ByteString (TimeOfDay -> LocalTime)
-> Parser TimeOfDay -> Parser LocalTime
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
timeOfDay
  where
    separator :: Parser ByteString Char
separator = Char -> Parser ByteString Char
A.char Char
' ' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
A.char Char
'T'


utcTime :: A.Parser UTCTime
utcTime :: Parser UTCTime
utcTime = do
  LocalTime Day
date TimeOfDay
time <- Parser LocalTime
localTime
  DiffTime
tz <- Parser DiffTime
timeZone
  let
    (Year
days, DiffTime
time') = (TimeOfDay -> DiffTime
sinceMidnight TimeOfDay
time DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
tz) DiffTime -> DiffTime -> (Year, DiffTime)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
`divMod'` DiffTime
oneDay
      where
        oneDay :: DiffTime
oneDay = DiffTime
24 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60
    date' :: Day
date' = Year -> Day -> Day
addDays Year
days Day
date
  UTCTime -> Parser UTCTime
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Parser UTCTime) -> UTCTime -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
date' DiffTime
time'


calendarDiffTime :: A.Parser CalendarDiffTime
calendarDiffTime :: Parser CalendarDiffTime
calendarDiffTime = Parser CalendarDiffTime
iso8601 Parser CalendarDiffTime
-> Parser CalendarDiffTime -> Parser CalendarDiffTime
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser CalendarDiffTime
postgres
  where
    iso8601 :: Parser CalendarDiffTime
iso8601 = Parser ByteString
A.takeByteString Parser ByteString
-> (ByteString -> Parser CalendarDiffTime)
-> Parser CalendarDiffTime
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser CalendarDiffTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Parser CalendarDiffTime)
-> (ByteString -> String) -> ByteString -> Parser CalendarDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toString
    at :: Parser ByteString ()
at = Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
'@') Parser ByteString (Maybe Char)
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
A.skipSpace
    plural :: Parser ByteString b -> Parser ByteString ()
plural Parser ByteString b
unit = Parser ByteString ()
A.skipSpace Parser ByteString () -> Parser ByteString b -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ByteString b
unit Parser ByteString b
-> Parser ByteString (Maybe ByteString) -> Parser ByteString b
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString -> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString
"s") Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
A.skipSpace
    parseMonths :: Parser Year
parseMonths = Parser Year
sql Parser Year -> Parser Year -> Parser Year
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Year
postgresql
      where
        sql :: Parser Year
sql = Parser Year -> Parser Year
forall a. Num a => Parser a -> Parser a
A.signed (Parser Year -> Parser Year) -> Parser Year -> Parser Year
forall a b. (a -> b) -> a -> b
$ do
          Year
years <- Parser Year
forall a. Integral a => Parser a
A.decimal Parser Year -> Parser ByteString Char -> Parser Year
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
'-'
          Year
months <- Parser Year
forall a. Integral a => Parser a
A.decimal Parser Year -> Parser ByteString () -> Parser Year
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
A.skipSpace
          Year -> Parser Year
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Parser Year) -> Year -> Parser Year
forall a b. (a -> b) -> a -> b
$ Year
years Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
12 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
months
        postgresql :: Parser Year
postgresql = do
          Parser ByteString ()
at
          Year
years <- Parser Year -> Parser Year
forall a. Num a => Parser a -> Parser a
A.signed Parser Year
forall a. Integral a => Parser a
A.decimal Parser Year -> Parser ByteString () -> Parser Year
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString -> Parser ByteString ()
forall {b}. Parser ByteString b -> Parser ByteString ()
plural Parser ByteString
"year" Parser Year -> Parser Year -> Parser Year
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Year -> Parser Year
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Year
0
          Year
months <- Parser Year -> Parser Year
forall a. Num a => Parser a -> Parser a
A.signed Parser Year
forall a. Integral a => Parser a
A.decimal Parser Year -> Parser ByteString () -> Parser Year
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString -> Parser ByteString ()
forall {b}. Parser ByteString b -> Parser ByteString ()
plural Parser ByteString
"mon" Parser Year -> Parser Year -> Parser Year
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Year -> Parser Year
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Year
0
          Year -> Parser Year
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Parser Year) -> Year -> Parser Year
forall a b. (a -> b) -> a -> b
$ Year
years Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
12 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
months
    parseTime :: Parser ByteString NominalDiffTime
parseTime = NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(+) (NominalDiffTime -> NominalDiffTime -> NominalDiffTime)
-> Parser ByteString NominalDiffTime
-> Parser ByteString (NominalDiffTime -> NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString NominalDiffTime
parseDays Parser ByteString (NominalDiffTime -> NominalDiffTime)
-> Parser ByteString NominalDiffTime
-> Parser ByteString NominalDiffTime
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString NominalDiffTime
time
      where
        time :: Parser ByteString NominalDiffTime
time = Pico -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Pico -> NominalDiffTime)
-> Parser ByteString Pico -> Parser ByteString NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Pico
sql Parser ByteString Pico
-> Parser ByteString Pico -> Parser ByteString Pico
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Pico
postgresql)
          where
            sql :: Parser ByteString Pico
sql = Parser ByteString Pico -> Parser ByteString Pico
forall a. Num a => Parser a -> Parser a
A.signed (Parser ByteString Pico -> Parser ByteString Pico)
-> Parser ByteString Pico -> Parser ByteString Pico
forall a b. (a -> b) -> a -> b
$ do
              Int
h <- Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
A.signed Parser Int
forall a. Integral a => Parser a
A.decimal Parser Int -> Parser ByteString Char -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
':'
              Int
m <- Parser Int
twoDigits Parser Int -> Parser ByteString Char -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
':'
              Pico
s <- Parser ByteString Pico
secondsParser
              Pico -> Parser ByteString Pico
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pico -> Parser ByteString Pico) -> Pico -> Parser ByteString Pico
forall a b. (a -> b) -> a -> b
$ Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((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) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Pico
s
            postgresql :: Parser ByteString Pico
postgresql = do
              Int
h <- Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
A.signed Parser Int
forall a. Integral a => Parser a
A.decimal Parser Int -> Parser ByteString () -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString -> Parser ByteString ()
forall {b}. Parser ByteString b -> Parser ByteString ()
plural Parser ByteString
"hour" Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
              Int
m <- Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
A.signed Parser Int
forall a. Integral a => Parser a
A.decimal Parser Int -> Parser ByteString () -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString -> Parser ByteString ()
forall {b}. Parser ByteString b -> Parser ByteString ()
plural Parser ByteString
"min" Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
              Pico
s <- Parser ByteString Pico
secondsParser Parser ByteString Pico
-> Parser ByteString () -> Parser ByteString Pico
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString -> Parser ByteString ()
forall {b}. Parser ByteString b -> Parser ByteString ()
plural Parser ByteString
"sec" Parser ByteString Pico
-> Parser ByteString Pico -> Parser ByteString Pico
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pico -> Parser ByteString Pico
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pico
0
              Pico -> Parser ByteString Pico
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pico -> Parser ByteString Pico) -> Pico -> Parser ByteString Pico
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int (((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) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Pico
s
        parseDays :: Parser ByteString NominalDiffTime
parseDays = do
          Int
days <- Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
A.signed Parser Int
forall a. Integral a => Parser a
A.decimal Parser Int -> Parser ByteString () -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ByteString -> Parser ByteString ()
forall {b}. Parser ByteString b -> Parser ByteString ()
plural Parser ByteString
"days" Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
skipSpace1) Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
          NominalDiffTime -> Parser ByteString NominalDiffTime
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalDiffTime -> Parser ByteString NominalDiffTime)
-> NominalDiffTime -> Parser ByteString NominalDiffTime
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int Int
days NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60
    postgres :: Parser CalendarDiffTime
postgres = do
      Year
months <- Parser Year
parseMonths
      NominalDiffTime
time <- Parser ByteString NominalDiffTime
parseTime
      Bool
ago <- (Bool
True Bool -> Parser ByteString -> Parser ByteString Bool
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Parser ByteString ()
A.skipSpace Parser ByteString () -> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString
"ago")) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      CalendarDiffTime -> Parser CalendarDiffTime
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CalendarDiffTime -> Parser CalendarDiffTime)
-> CalendarDiffTime -> Parser CalendarDiffTime
forall a b. (a -> b) -> a -> b
$ Year -> NominalDiffTime -> CalendarDiffTime
CalendarDiffTime ((Year -> Year) -> (Year -> Year) -> Bool -> Year -> Year
forall a. a -> a -> Bool -> a
bool Year -> Year
forall a. a -> a
id Year -> Year
forall a. Num a => a -> a
negate Bool
ago Year
months) ((NominalDiffTime -> NominalDiffTime)
-> (NominalDiffTime -> NominalDiffTime)
-> Bool
-> NominalDiffTime
-> NominalDiffTime
forall a. a -> a -> Bool -> a
bool NominalDiffTime -> NominalDiffTime
forall a. a -> a
id NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a
negate Bool
ago NominalDiffTime
time)


secondsParser :: A.Parser Pico
secondsParser :: Parser ByteString Pico
secondsParser = do
  Int
integral <- Parser Int
twoDigits
  Maybe ByteString
mfractional <- Parser ByteString -> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
'.' Parser ByteString Char -> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString
A.takeWhile1 Char -> Bool
A.isDigit)
  Pico -> Parser ByteString Pico
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pico -> Parser ByteString Pico) -> Pico -> Parser ByteString Pico
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
mfractional of
    Maybe ByteString
Nothing -> Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
integral
    Just ByteString
fractional -> Int64 -> ByteString -> Pico
forall {a}. Int64 -> ByteString -> Fixed a
parseFraction (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
integral) ByteString
fractional
 where
  parseFraction :: Int64 -> ByteString -> Fixed a
parseFraction Int64
integral ByteString
digits = Year -> Fixed a
forall k (a :: k). Year -> Fixed a
MkFixed (Int64 -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e))
    where
      e :: Int
e = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
digits)
      n :: Int64
n = (Int64 -> Word8 -> Int64) -> Int64 -> ByteString -> Int64
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' Int64 -> Word8 -> Int64
forall {a} {a}. (Num a, Enum a) => a -> a -> a
go (Int64
integral :: Int64) (Int -> ByteString -> ByteString
BS.take Int
12 ByteString
digits)
        where
          go :: a -> a -> a
go a
acc a
digit = a
10 a -> a -> a
forall a. Num a => a -> a -> a
* a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
digit Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf)


twoDigits :: A.Parser Int
twoDigits :: Parser Int
twoDigits = do
  Char
u <- Parser ByteString Char
A.digit
  Char
l <- Parser ByteString Char
A.digit
  Int -> Parser Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
u Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
l Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf


timeZone :: A.Parser DiffTime
timeZone :: Parser DiffTime
timeZone = DiffTime
0 DiffTime -> Parser ByteString Char -> Parser DiffTime
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
A.char Char
'Z' Parser DiffTime -> Parser DiffTime -> Parser DiffTime
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser DiffTime
diffTime


diffTime :: A.Parser DiffTime
diffTime :: Parser DiffTime
diffTime = Parser DiffTime -> Parser DiffTime
forall a. Num a => Parser a -> Parser a
A.signed (Parser DiffTime -> Parser DiffTime)
-> Parser DiffTime -> Parser DiffTime
forall a b. (a -> b) -> a -> b
$ do
  Int
h <- Parser Int
twoDigits
  Int
m <- Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char -> Parser Int -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
twoDigits Parser Int -> Parser Int -> Parser Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
  Pico
s <- Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char
-> Parser ByteString Pico -> Parser ByteString Pico
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Pico
secondsParser Parser ByteString Pico
-> Parser ByteString Pico -> Parser ByteString Pico
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pico -> Parser ByteString Pico
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pico
0
  DiffTime -> Parser DiffTime
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime -> Parser DiffTime) -> DiffTime -> Parser DiffTime
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> DiffTime
sinceMidnight (TimeOfDay -> DiffTime) -> TimeOfDay -> DiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s


skipSpace1 :: A.Parser ()
skipSpace1 :: Parser ByteString ()
skipSpace1 = Parser ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ByteString ())
-> Parser ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ByteString
A.takeWhile1 Char -> Bool
A.isSpace