{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module: Pact.Time.Format.Internal
-- Copyright: Copyright © 2021 Kadena LLC.
--                      © 2013−2014 Liyang HU Liyang HU
-- License: MIT
-- Maintainer: Lars Kuhtz <lars@kadena.io>
-- Stability: experimental
--
-- The code in this module is derived from various modules of the thyme package,
-- which is copyright (c) 2013 Liyang HU and distributed under a BSD3 license.
--
module Pact.Time.Format.Internal
( formatTime
, parseTime
, readTime
, readsTime
) where

import Control.Applicative
import Control.Monad.State.Strict

import Data.Aeson (FromJSON(..), ToJSON(..), withText, Value(String))
import Data.Attoparsec.ByteString.Char8 (Parser, Result, IResult (..))
import qualified Data.Attoparsec.ByteString.Char8 as P
import Data.Bits
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy as L
import Data.Char
import Data.Int
import qualified Data.Text as T
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Vector.Unboxed as VU
import Data.VectorSpace

import Lens.Micro

-- internal modules

import Pact.Time.Internal
import Pact.Time.Format.Locale

-- -------------------------------------------------------------------------- --
-- Lens Utils (from microlens-mtl)

infix 4 .=

(.=) :: MonadState s m => ASetter s s a b -> b -> m ()
ASetter s s a b
l .= :: forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= b
x = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter s s a b
l forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
x)
{-# INLINE (.=) #-}

assign :: MonadState s m => ASetter s s a b -> b -> m ()
assign :: forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter s s a b
l b
x = ASetter s s a b
l forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= b
x
{-# INLINE assign #-}

-- -------------------------------------------------------------------------- --
-- Misc Utils

shows02 :: Int -> ShowS
shows02 :: Int -> ShowS
shows02 Int
n = if Int
n forall a. Ord a => a -> a -> Bool
< Int
10 then (:) Char
'0' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n else forall a. Show a => a -> ShowS
shows Int
n
{-# INLINE shows02 #-}

shows_2 :: Int -> ShowS
shows_2 :: Int -> ShowS
shows_2 Int
n = if Int
n forall a. Ord a => a -> a -> Bool
< Int
10 then (:) Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n else forall a. Show a => a -> ShowS
shows Int
n
{-# INLINE shows_2 #-}

shows03 :: Int -> ShowS
shows03 :: Int -> ShowS
shows03 Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
10 = forall a. [a] -> [a] -> [a]
(++) [Char]
"00" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
100 = forall a. [a] -> [a] -> [a]
(++) [Char]
"0" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n
    | Bool
otherwise = forall a. Show a => a -> ShowS
shows Int
n
{-# INLINE shows03 #-}

showsYear :: Int -> ShowS
showsYear :: Int -> ShowS
showsYear n :: Int
n@(forall a. Num a => a -> a
abs -> Int
u)
    | Int
u forall a. Ord a => a -> a -> Bool
< Int
10 = ShowS
neg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) [Char]
"000" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
u
    | Int
u forall a. Ord a => a -> a -> Bool
< Int
100 = ShowS
neg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) [Char]
"00" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
u
    | Int
u forall a. Ord a => a -> a -> Bool
< Int
1000 = ShowS
neg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) [Char]
"0" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
u
    | Bool
otherwise = ShowS
neg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
u
  where
    neg :: ShowS
neg = if Int
n forall a. Ord a => a -> a -> Bool
< Int
0 then (:) Char
'-' else forall a. a -> a
id
{-# INLINE showsYear #-}

fills06 :: Micros -> ShowS
fills06 :: Micros -> ShowS
fills06 Micros
n
    | Micros
n forall a. Ord a => a -> a -> Bool
< Micros
10 = forall a. [a] -> [a] -> [a]
(++) [Char]
"00000"
    | Micros
n forall a. Ord a => a -> a -> Bool
< Micros
100 = forall a. [a] -> [a] -> [a]
(++) [Char]
"0000"
    | Micros
n forall a. Ord a => a -> a -> Bool
< Micros
1000 = forall a. [a] -> [a] -> [a]
(++) [Char]
"000"
    | Micros
n forall a. Ord a => a -> a -> Bool
< Micros
10000 = forall a. [a] -> [a] -> [a]
(++) [Char]
"00"
    | Micros
n forall a. Ord a => a -> a -> Bool
< Micros
100000 = forall a. [a] -> [a] -> [a]
(++) [Char]
"0"
    | Bool
otherwise = forall a. a -> a
id
{-# INLINE fills06 #-}

drops0 :: Micros -> ShowS
drops0 :: Micros -> ShowS
drops0 Micros
n = case forall a. Integral a => a -> a -> (a, a)
divMod Micros
n Micros
10 of
    (Micros
q, Micros
0) -> Micros -> ShowS
drops0 Micros
q
    (Micros, Micros)
_ -> forall a. Show a => a -> ShowS
shows Micros
n
{-# INLINE drops0 #-}

-- -------------------------------------------------------------------------- --
-- Misc Types

-- Unbounded
type UnboundedInt = Int

type Minutes = UnboundedInt
type Days = UnboundedInt
type Year = UnboundedInt
type Century = UnboundedInt

-- Bounded
type BoundedInt = Int

type Hour = BoundedInt
type Minute = BoundedInt
type Second = BoundedInt
type Month = BoundedInt
type DayOfMonth = BoundedInt
type DayOfYear = BoundedInt
type DayOfWeek = BoundedInt
type WeekOfYear = BoundedInt

-- -------------------------------------------------------------------------- --
-- Year Month Day

data YearMonthDay = YearMonthDay
    { YearMonthDay -> Int
_ymdYear :: {-# UNPACK #-} !Year
    , YearMonthDay -> Int
_ymdMonth :: {-# UNPACK #-} !Month
    , YearMonthDay -> Int
_ymdDay :: {-# UNPACK #-} !DayOfMonth
    }

ymdFromOrdinal :: OrdinalDate -> YearMonthDay
ymdFromOrdinal :: OrdinalDate -> YearMonthDay
ymdFromOrdinal (OrdinalDate Int
y Int
yd) = Int -> Int -> Int -> YearMonthDay
YearMonthDay Int
y Int
m Int
d
  where
    MonthDay Int
m Int
d = Bool -> Int -> MonthDay
monthDaysFromDayOfYear (Int -> Bool
isLeapYear Int
y) Int
yd
{-# INLINEABLE ymdFromOrdinal #-}

ymdToOrdinal :: YearMonthDay -> OrdinalDate
ymdToOrdinal :: YearMonthDay -> OrdinalDate
ymdToOrdinal (YearMonthDay Int
y Int
m Int
d) = Int -> Int -> OrdinalDate
OrdinalDate Int
y forall a b. (a -> b) -> a -> b
$
    Bool -> MonthDay -> Int
monthDaysToDayOfYear (Int -> Bool
isLeapYear Int
y) (Int -> Int -> MonthDay
MonthDay Int
m Int
d)

{-# INLINEABLE ymdToOrdinal #-}

toGregorian :: YearMonthDay -> ModifiedJulianDay
toGregorian :: YearMonthDay -> ModifiedJulianDay
toGregorian = OrdinalDate -> ModifiedJulianDay
fromOrdinalDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. YearMonthDay -> OrdinalDate
ymdToOrdinal
{-# INLINEABLE toGregorian #-}

-- -------------------------------------------------------------------------- --
-- Ordinal Dates

data OrdinalDate = OrdinalDate
    { OrdinalDate -> Int
_odYear :: {-# UNPACK #-} !Year
    , OrdinalDate -> Int
_odDay :: {-# UNPACK #-} !DayOfYear
    }

-- | Gregorian leap year?
isLeapYear :: Year -> Bool
isLeapYear :: Int -> Bool
isLeapYear Int
y = Int
y forall a. Bits a => a -> a -> a
.&. Int
3 forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& (Int
r100 forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
|| Int
q100 forall a. Bits a => a -> a -> a
.&. Int
3 forall a. Eq a => a -> a -> Bool
== Int
0)
  where
    (Int
q100, Int
r100) = Int
y forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100

toOrdinalDate :: ModifiedJulianDay -> OrdinalDate
toOrdinalDate :: ModifiedJulianDay -> OrdinalDate
toOrdinalDate (ModifiedJulianDay Int
mjd)
    | Int
dayB0 forall a. Ord a => a -> a -> Bool
<= Int
0 = case Int -> OrdinalDate
toOrdB0 Int
dayInQC of
        OrdinalDate Int
y Int
yd -> Int -> Int -> OrdinalDate
OrdinalDate (Int
y forall a. Num a => a -> a -> a
+ Int
quadCent forall a. Num a => a -> a -> a
* Int
400) Int
yd
    | Bool
otherwise = Int -> OrdinalDate
toOrdB0 Int
dayB0
  where
    dayB0 :: Int
dayB0 = Int
mjd forall a. Num a => a -> a -> a
+ Int
678575
    (Int
quadCent, Int
dayInQC) = Int
dayB0 forall a. Integral a => a -> a -> (a, a)
`divMod` Int
146097

    -- Input: days since 1-1-1. Precondition: has to be positive!
    toOrdB0 :: Int -> OrdinalDate
toOrdB0 Int
dB0 = OrdinalDate
res
      where
        (Int
y0, Int
r) = (Int
400 forall a. Num a => a -> a -> a
* Int
dB0) forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
146097
        d0 :: Int
d0 = forall {a}. (Integral a, Bits a) => a -> a -> a
dayInYear Int
y0 Int
dB0
        d1 :: Int
d1 = forall {a}. (Integral a, Bits a) => a -> a -> a
dayInYear (Int
y0 forall a. Num a => a -> a -> a
+ Int
1) Int
dB0
        res :: OrdinalDate
res = if Int
r forall a. Ord a => a -> a -> Bool
> Int
146097 forall a. Num a => a -> a -> a
- Int
600 Bool -> Bool -> Bool
&& Int
d1 forall a. Ord a => a -> a -> Bool
> Int
0
                then Int -> Int -> OrdinalDate
OrdinalDate (Int
y0 forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
1) Int
d1
                else Int -> Int -> OrdinalDate
OrdinalDate (Int
y0 forall a. Num a => a -> a -> a
+ Int
1) Int
d0
    {-# INLINE toOrdB0 #-}

    -- Input: (year - 1) (day as days since 1-1-1)
    -- Precondition: year is positive!
    dayInYear :: a -> a -> a
dayInYear a
y0 a
dB0 = a
dB0 forall a. Num a => a -> a -> a
- a
365 forall a. Num a => a -> a -> a
* a
y0 forall a. Num a => a -> a -> a
- a
leaps forall a. Num a => a -> a -> a
+ a
1
      where
        leaps :: a
leaps = a
y0 forall a. Bits a => a -> Int -> a
`shiftR` Int
2 forall a. Num a => a -> a -> a
- a
centuries forall a. Num a => a -> a -> a
+ a
centuries forall a. Bits a => a -> Int -> a
`shiftR` Int
2
        centuries :: a
centuries = a
y0 forall a. Integral a => a -> a -> a
`quot` a
100
    {-# INLINE dayInYear #-}
{-# INLINEABLE toOrdinalDate #-}


fromOrdinalDate :: OrdinalDate -> ModifiedJulianDay
fromOrdinalDate :: OrdinalDate -> ModifiedJulianDay
fromOrdinalDate (OrdinalDate Int
year Int
yd) = Int -> ModifiedJulianDay
ModifiedJulianDay Int
mjd
  where
    years :: Int
years = Int
year forall a. Num a => a -> a -> a
- Int
1
    centuries :: Int
centuries = Int
years forall a. Integral a => a -> a -> a
`div` Int
100
    leaps :: Int
leaps = Int
years forall a. Bits a => a -> Int -> a
`shiftR` Int
2 forall a. Num a => a -> a -> a
- Int
centuries forall a. Num a => a -> a -> a
+ Int
centuries forall a. Bits a => a -> Int -> a
`shiftR` Int
2
    mjd :: Int
mjd = Int
365 forall a. Num a => a -> a -> a
* Int
years forall a. Num a => a -> a -> a
+ Int
leaps forall a. Num a => a -> a -> a
- Int
678576
        forall a. Num a => a -> a -> a
+ forall {c}. Ord c => c -> c -> c -> c
clip Int
1 (if Int -> Bool
isLeapYear Int
year then Int
366 else Int
365) Int
yd
    clip :: c -> c -> c -> c
clip c
a c
b = forall a. Ord a => a -> a -> a
max c
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min c
b
{-# INLINEABLE fromOrdinalDate #-}

-- -------------------------------------------------------------------------- --
-- Months

monthLengths :: VU.Vector Days
monthLengths :: Vector Int
monthLengths     = forall a. Unbox a => [a] -> Vector a
VU.fromList [Int
31,Int
28,Int
31,Int
30,Int
31,Int
30,Int
31,Int
31,Int
30,Int
31,Int
30,Int
31]
{-# NOINLINE monthLengths #-}

monthLengthsLeap :: VU.Vector Days
monthLengthsLeap :: Vector Int
monthLengthsLeap = forall a. Unbox a => [a] -> Vector a
VU.fromList [Int
31,Int
29,Int
31,Int
30,Int
31,Int
30,Int
31,Int
31,Int
30,Int
31,Int
30,Int
31]
{-# NOINLINE monthLengthsLeap #-}

monthDays :: VU.Vector ({-Month-}Int8, {-DayOfMonth-}Int8)
monthDays :: Vector (Int8, Int8)
monthDays = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate Int
365 forall {a} {b}. (Num a, Num b) => Int -> (a, b)
go
  where
    dom01 :: Vector Int
dom01 = forall a b.
(Unbox a, Unbox b) =>
(a -> b -> a) -> a -> Vector b -> Vector a
VU.prescanl' forall a. Num a => a -> a -> a
(+) Int
0 Vector Int
monthLengths
    go :: Int -> (a, b)
go Int
yd = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
      where
        m :: Int
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
12 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => (a -> Bool) -> Vector a -> Maybe Int
VU.findIndex (Int
yd forall a. Ord a => a -> a -> Bool
<) Vector Int
dom01
        d :: Int
d = forall a. Enum a => a -> a
succ Int
yd forall a. Num a => a -> a -> a
- forall a. Unbox a => Vector a -> Int -> a
VU.unsafeIndex Vector Int
dom01 (forall a. Enum a => a -> a
pred Int
m)
{-# NOINLINE monthDays #-}

monthDaysLeap :: VU.Vector ({-Month-}Int8, {-DayOfMonth-}Int8)
monthDaysLeap :: Vector (Int8, Int8)
monthDaysLeap = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate Int
366 forall {a} {b}. (Num a, Num b) => Int -> (a, b)
go
  where
    dom01 :: Vector Int
dom01 = forall a b.
(Unbox a, Unbox b) =>
(a -> b -> a) -> a -> Vector b -> Vector a
VU.prescanl' forall a. Num a => a -> a -> a
(+) Int
0 Vector Int
monthLengthsLeap
    go :: Int -> (a, b)
go Int
yd = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
      where
        m :: Int
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
12 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => (a -> Bool) -> Vector a -> Maybe Int
VU.findIndex (Int
yd forall a. Ord a => a -> a -> Bool
<) Vector Int
dom01
        d :: Int
d = forall a. Enum a => a -> a
succ Int
yd forall a. Num a => a -> a -> a
- forall a. Unbox a => Vector a -> Int -> a
VU.unsafeIndex Vector Int
dom01 (forall a. Enum a => a -> a
pred Int
m)
{-# NOINLINE monthDaysLeap #-}

data MonthDay = MonthDay
    { MonthDay -> Int
_mdMonth :: {-# UNPACK #-} !Month
    , MonthDay -> Int
_mdDay :: {-# UNPACK #-} !DayOfMonth
    }

monthDaysFromDayOfYear :: Bool -> DayOfYear -> MonthDay
monthDaysFromDayOfYear :: Bool -> Int -> MonthDay
monthDaysFromDayOfYear Bool
leap Int
yd = Int -> Int -> MonthDay
MonthDay Int
m Int
d
  where
    i :: Int
i = forall a. Ord a => a -> a -> a
max Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Int
lastDay forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Int
yd
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
m, forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
d) = forall a. Unbox a => Vector a -> Int -> a
VU.unsafeIndex Vector (Int8, Int8)
table Int
i
    (Int
lastDay, Vector (Int8, Int8)
table) = if Bool
leap
      then (Int
365, Vector (Int8, Int8)
monthDaysLeap)
      else (Int
364, Vector (Int8, Int8)
monthDays)
{-# INLINE monthDaysFromDayOfYear #-}

monthDaysToDayOfYear :: Bool -> MonthDay -> DayOfYear
monthDaysToDayOfYear :: Bool -> MonthDay -> Int
monthDaysToDayOfYear Bool
leap (MonthDay Int
month Int
mday) = forall a. Integral a => a -> a -> a
div (Int
367 forall a. Num a => a -> a -> a
* Int
m forall a. Num a => a -> a -> a
- Int
362) Int
12 forall a. Num a => a -> a -> a
+ Int
k forall a. Num a => a -> a -> a
+ Int
d
  where
    m :: Int
m = forall a. Ord a => a -> a -> a
max Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Int
12 forall a b. (a -> b) -> a -> b
$ Int
month
    l :: Int
l = forall a. Unbox a => Vector a -> Int -> a
VU.unsafeIndex Vector Int
lengths (forall a. Enum a => a -> a
pred Int
m)
    d :: Int
d = forall a. Ord a => a -> a -> a
max Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Int
l forall a b. (a -> b) -> a -> b
$ Int
mday
    k :: Int
k = if Int
m forall a. Ord a => a -> a -> Bool
<= Int
2 then Int
0 else Int
ok

    (Vector Int
lengths, Int
ok) = if Bool
leap
      then (Vector Int
monthLengthsLeap, -Int
1)
      else (Vector Int
monthLengths, -Int
2)
{-# INLINE monthDaysToDayOfYear #-}

-- -------------------------------------------------------------------------- --
-- Week Date

data WeekDate = WeekDate
    { WeekDate -> Int
_wdYear :: {-# UNPACK #-} !Year
    , WeekDate -> Int
_wdWeek :: {-# UNPACK #-} !WeekOfYear
    , WeekDate -> Int
_wdDay :: {-# UNPACK #-} !DayOfWeek
    }

toWeekDate :: ModifiedJulianDay -> WeekDate
toWeekDate :: ModifiedJulianDay -> WeekDate
toWeekDate = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (OrdinalDate -> ModifiedJulianDay -> WeekDate
toWeekOrdinal forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModifiedJulianDay -> OrdinalDate
toOrdinalDate)
{-# INLINEABLE toWeekDate #-}

fromWeekDate :: WeekDate -> ModifiedJulianDay
fromWeekDate :: WeekDate -> ModifiedJulianDay
fromWeekDate wd :: WeekDate
wd@(WeekDate Int
y Int
_ Int
_) = Int -> WeekDate -> ModifiedJulianDay
fromWeekLast (Int -> Int
lastWeekOfYear Int
y) WeekDate
wd
{-# INLINEABLE fromWeekDate #-}

toWeekOrdinal :: OrdinalDate -> ModifiedJulianDay -> WeekDate
toWeekOrdinal :: OrdinalDate -> ModifiedJulianDay -> WeekDate
toWeekOrdinal (OrdinalDate Int
y0 Int
yd) (ModifiedJulianDay Int
mjd) =
    Int -> Int -> Int -> WeekDate
WeekDate Int
y1 (Int
w1 forall a. Num a => a -> a -> a
+ Int
1) (Int
d7mod forall a. Num a => a -> a -> a
+ Int
1)
  where
    -- pilfered and refactored; no idea what foo and bar mean
    d :: Int
d = Int
mjd forall a. Num a => a -> a -> a
+ Int
2
    (Int
d7div, Int
d7mod) = forall a. Integral a => a -> a -> (a, a)
divMod Int
d Int
7

    -- foo :: Year -> {-WeekOfYear-1-}Int
    foo :: Int -> Int
foo Int
y = ModifiedJulianDay -> Int
bar forall a b. (a -> b) -> a -> b
$ OrdinalDate -> ModifiedJulianDay
fromOrdinalDate forall a b. (a -> b) -> a -> b
$ Int -> Int -> OrdinalDate
OrdinalDate Int
y Int
6

    -- bar :: ModifiedJulianDay -> {-WeekOfYear-1-}Int
    bar :: ModifiedJulianDay -> Int
bar (ModifiedJulianDay Int
k) = Int
d7div forall a. Num a => a -> a -> a
- forall a. Integral a => a -> a -> a
div Int
k Int
7

    w0 :: Int
w0 = ModifiedJulianDay -> Int
bar forall a b. (a -> b) -> a -> b
$ Int -> ModifiedJulianDay
ModifiedJulianDay (Int
d forall a. Num a => a -> a -> a
- Int
yd forall a. Num a => a -> a -> a
+ Int
4)
    (Int
y1, Int
w1) = case Int
w0 of
        -1 -> (Int
y0 forall a. Num a => a -> a -> a
- Int
1, Int -> Int
foo (Int
y0 forall a. Num a => a -> a -> a
- Int
1))
        Int
52 | Int -> Int
foo (Int
y0 forall a. Num a => a -> a -> a
+ Int
1) forall a. Eq a => a -> a -> Bool
== Int
0 -> (Int
y0 forall a. Num a => a -> a -> a
+ Int
1, Int
0)
        Int
_ -> (Int
y0, Int
w0)
{-# INLINE toWeekOrdinal #-}

lastWeekOfYear :: Year -> WeekOfYear
lastWeekOfYear :: Int -> Int
lastWeekOfYear Int
y = if WeekDate -> Int
_wdWeek WeekDate
wd forall a. Eq a => a -> a -> Bool
== Int
53 then Int
53 else Int
52
  where
    wd :: WeekDate
wd = ModifiedJulianDay -> WeekDate
toWeekDate forall a b. (a -> b) -> a -> b
$ OrdinalDate -> ModifiedJulianDay
fromOrdinalDate forall a b. (a -> b) -> a -> b
$ Int -> Int -> OrdinalDate
OrdinalDate Int
y Int
365
{-# INLINE lastWeekOfYear #-}

fromWeekLast :: WeekOfYear -> WeekDate -> ModifiedJulianDay
fromWeekLast :: Int -> WeekDate -> ModifiedJulianDay
fromWeekLast Int
wMax (WeekDate Int
y Int
w Int
d) = Int -> ModifiedJulianDay
ModifiedJulianDay Int
mjd
  where
    -- pilfered and refactored
    ModifiedJulianDay Int
k = OrdinalDate -> ModifiedJulianDay
fromOrdinalDate forall a b. (a -> b) -> a -> b
$ Int -> Int -> OrdinalDate
OrdinalDate Int
y Int
6
    mjd :: Int
mjd = Int
k forall a. Num a => a -> a -> a
- forall a. Integral a => a -> a -> a
mod Int
k Int
7 forall a. Num a => a -> a -> a
- Int
10 forall a. Num a => a -> a -> a
+ forall {c}. Ord c => c -> c -> c -> c
clip Int
1 Int
7 Int
d forall a. Num a => a -> a -> a
+ forall {c}. Ord c => c -> c -> c -> c
clip Int
1 Int
wMax Int
w forall a. Num a => a -> a -> a
* Int
7
    clip :: c -> c -> c -> c
clip c
a c
b = forall a. Ord a => a -> a -> a
max c
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min c
b
{-# INLINE fromWeekLast #-}

-- -------------------------------------------------------------------------- --
-- Sunday Weeks

-- | Weeks numbered from 0 to 53, starting with the first Sunday of the year
-- as the first day of week 1. The last week of a given year and week 0 of
-- the next both refer to the same week, but not all 'DayOfWeek' are valid.
-- 'Year' coincides with that of 'gregorian'.
--
data SundayWeek = SundayWeek
    { SundayWeek -> Int
_swYear :: {-# UNPACK #-} !Year
    , SundayWeek -> Int
_swWeek :: {-# UNPACK #-} !WeekOfYear
    , SundayWeek -> Int
_swDay :: {-# UNPACK #-} !DayOfWeek
    }

fromSundayWeek :: SundayWeek -> ModifiedJulianDay
fromSundayWeek :: SundayWeek -> ModifiedJulianDay
fromSundayWeek (SundayWeek Int
y Int
w Int
d) = Int -> ModifiedJulianDay
ModifiedJulianDay (Int
firstDay forall a. Num a => a -> a -> a
+ Int
yd)
  where
    ModifiedJulianDay Int
firstDay = OrdinalDate -> ModifiedJulianDay
fromOrdinalDate forall a b. (a -> b) -> a -> b
$ Int -> Int -> OrdinalDate
OrdinalDate Int
y Int
1
    -- following are all 0-based year days
    firstSunday :: Int
firstSunday = forall a. Integral a => a -> a -> a
mod (Int
4 forall a. Num a => a -> a -> a
- Int
firstDay) Int
7
    yd :: Int
yd = Int
firstSunday forall a. Num a => a -> a -> a
+ Int
7 forall a. Num a => a -> a -> a
* (Int
w forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
d
{-# INLINEABLE fromSundayWeek #-}

toSundayOrdinal :: OrdinalDate -> ModifiedJulianDay -> SundayWeek
toSundayOrdinal :: OrdinalDate -> ModifiedJulianDay -> SundayWeek
toSundayOrdinal (OrdinalDate Int
y Int
yd) (ModifiedJulianDay Int
mjd) =
    Int -> Int -> Int -> SundayWeek
SundayWeek Int
y (Int
d7div forall a. Num a => a -> a -> a
- forall a. Integral a => a -> a -> a
div Int
k Int
7) Int
d7mod
  where
    d :: Int
d = Int
mjd forall a. Num a => a -> a -> a
+ Int
3
    k :: Int
k = Int
d forall a. Num a => a -> a -> a
- Int
yd
    (Int
d7div, Int
d7mod) = forall a. Integral a => a -> a -> (a, a)
divMod Int
d Int
7
{-# INLINE toSundayOrdinal #-}

-- -------------------------------------------------------------------------- --
-- Monaday Weeks

-- | Weeks numbered from 0 to 53, starting with the first Monday of the year
-- as the first day of week 1. The last week of a given year and week 0 of
-- the next both refer to the same week, but not all 'DayOfWeek' are valid.
-- 'Year' coincides with that of 'gregorian'.
--
data MondayWeek = MondayWeek
    { MondayWeek -> Int
_mwYear :: {-# UNPACK #-} !Year
    , MondayWeek -> Int
_mwWeek :: {-# UNPACK #-} !WeekOfYear
    , MondayWeek -> Int
_mwDay :: {-# UNPACK #-} !DayOfWeek
    }

fromMondayWeek :: MondayWeek -> ModifiedJulianDay
fromMondayWeek :: MondayWeek -> ModifiedJulianDay
fromMondayWeek (MondayWeek Int
y Int
w Int
d) = Int -> ModifiedJulianDay
ModifiedJulianDay (Int
firstDay forall a. Num a => a -> a -> a
+ Int
yd)
  where
    ModifiedJulianDay Int
firstDay = OrdinalDate -> ModifiedJulianDay
fromOrdinalDate forall a b. (a -> b) -> a -> b
$ Int -> Int -> OrdinalDate
OrdinalDate Int
y Int
1
    -- following are all 0-based year days
    firstMonday :: Int
firstMonday = forall a. Integral a => a -> a -> a
mod (Int
5 forall a. Num a => a -> a -> a
- Int
firstDay) Int
7
    yd :: Int
yd = Int
firstMonday forall a. Num a => a -> a -> a
+ Int
7 forall a. Num a => a -> a -> a
* (Int
w forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
d forall a. Num a => a -> a -> a
- Int
1
{-# INLINEABLE fromMondayWeek #-}

toMondayOrdinal :: OrdinalDate -> ModifiedJulianDay -> MondayWeek
toMondayOrdinal :: OrdinalDate -> ModifiedJulianDay -> MondayWeek
toMondayOrdinal (OrdinalDate Int
y Int
yd) (ModifiedJulianDay Int
mjd) =
    Int -> Int -> Int -> MondayWeek
MondayWeek Int
y (Int
d7div forall a. Num a => a -> a -> a
- forall a. Integral a => a -> a -> a
div Int
k Int
7) (Int
d7mod forall a. Num a => a -> a -> a
+ Int
1)
  where
    d :: Int
d = Int
mjd forall a. Num a => a -> a -> a
+ Int
2
    k :: Int
k = Int
d forall a. Num a => a -> a -> a
- Int
yd
    (Int
d7div, Int
d7mod) = forall a. Integral a => a -> a -> (a, a)
divMod Int
d Int
7
{-# INLINE toMondayOrdinal #-}

-- -------------------------------------------------------------------------- --
-- Time Of Day

data TimeOfDay = TimeOfDay
    { TimeOfDay -> Int
_todHour :: {-# UNPACK #-} !Hour
    , TimeOfDay -> Int
_todMin :: {-# UNPACK #-} !Minute
    , TimeOfDay -> NominalDiffTime
_todSec :: {-# UNPACK #-} !NominalDiffTime
    }

timeOfDayFromNominalDiffTime :: NominalDiffTime -> TimeOfDay
timeOfDayFromNominalDiffTime :: NominalDiffTime -> TimeOfDay
timeOfDayFromNominalDiffTime (NominalDiffTime Micros
t) = Int -> Int -> NominalDiffTime -> TimeOfDay
TimeOfDay
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Micros
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Micros
m) (Micros -> NominalDiffTime
NominalDiffTime Micros
s)
  where
    (Micros
h, Micros
ms) = forall a. Integral a => a -> a -> (a, a)
quotRem Micros
t Micros
3600000000
    (Micros
m, Micros
s) = forall a. Integral a => a -> a -> (a, a)
quotRem Micros
ms Micros
60000000
{-# INLINEABLE timeOfDayFromNominalDiffTime #-}

-- -------------------------------------------------------------------------- --
-- Format Time

class FormatTime t where
    showsTime :: t -> (Char -> ShowS) -> Char -> ShowS

formatTime :: (FormatTime t) => String -> t -> String
formatTime :: forall t. FormatTime t => [Char] -> t -> [Char]
formatTime [Char]
spec t
t = forall t. FormatTime t => [Char] -> t -> ShowS
formatTimeS [Char]
spec t
t [Char]
""
{-# INLINEABLE formatTime #-}

formatTimeS :: (FormatTime t) => String -> t -> ShowS
formatTimeS :: forall t. FormatTime t => [Char] -> t -> ShowS
formatTimeS [Char]
spec t
t = [Char] -> ShowS
go [Char]
spec
  where
    -- leave unrecognised codes as they are
    format :: Char -> ShowS
format = forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime t
t (\Char
c [Char]
s -> Char
'%' forall a. a -> [a] -> [a]
: Char
c forall a. a -> [a] -> [a]
: [Char]
s)
    go :: [Char] -> ShowS
go [Char]
s = case [Char]
s of
        Char
'%' : Char
c : [Char]
rest -> case Char
c of
            -- aggregate
            Char
'c' -> [Char] -> ShowS
go (TimeLocale -> [Char]
dateTimeFmt TimeLocale
l forall a. [a] -> [a] -> [a]
++ [Char]
rest)
            Char
'r' -> [Char] -> ShowS
go (TimeLocale -> [Char]
time12Fmt TimeLocale
l forall a. [a] -> [a] -> [a]
++ [Char]
rest)
            Char
'X' -> [Char] -> ShowS
go (TimeLocale -> [Char]
timeFmt TimeLocale
l forall a. [a] -> [a] -> [a]
++ [Char]
rest)
            Char
'x' -> [Char] -> ShowS
go (TimeLocale -> [Char]
dateFmt TimeLocale
l forall a. [a] -> [a] -> [a]
++ [Char]
rest)
            -- modifier (whatever)
            Char
'-' -> [Char] -> ShowS
go (Char
'%' forall a. a -> [a] -> [a]
: [Char]
rest)
            Char
'_' -> [Char] -> ShowS
go (Char
'%' forall a. a -> [a] -> [a]
: [Char]
rest)
            Char
'0' -> [Char] -> ShowS
go (Char
'%' forall a. a -> [a] -> [a]
: [Char]
rest)
            Char
'^' -> [Char] -> ShowS
go (Char
'%' forall a. a -> [a] -> [a]
: [Char]
rest)
            Char
'#' -> [Char] -> ShowS
go (Char
'%' forall a. a -> [a] -> [a]
: [Char]
rest)
            -- escape (why would anyone need %t and %n?)
            Char
'%' -> (:) Char
'%' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
go [Char]
rest
            -- default
            Char
_ -> Char -> ShowS
format Char
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
go [Char]
rest
        Char
c : [Char]
rest -> (:) Char
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
go [Char]
rest
        [] -> forall a. a -> a
id
      where
        l :: TimeLocale
l = TimeLocale
defaultTimeLocale
{-# INLINEABLE formatTimeS #-}

instance FormatTime TimeOfDay where
    showsTime :: TimeOfDay -> (Char -> ShowS) -> Char -> ShowS
showsTime (TimeOfDay Int
h Int
m (NominalDiffTime Micros
s)) = \ Char -> ShowS
def Char
c -> case Char
c of
        -- aggregate
        Char
'R' -> Int -> ShowS
shows02 Int
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
':' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
shows02 Int
m
        Char
'T' -> Int -> ShowS
shows02 Int
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
':' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
shows02 Int
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
':' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
shows02 Int
si
        -- AM/PM
        Char
'P' -> forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Int
h forall a. Ord a => a -> a -> Bool
< Int
12 then forall a b. (a, b) -> a
fst ([Char], [Char])
amPm else forall a b. (a, b) -> b
snd ([Char], [Char])
amPm
        Char
'p' -> forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ if Int
h forall a. Ord a => a -> a -> Bool
< Int
12 then forall a b. (a, b) -> a
fst ([Char], [Char])
amPm else forall a b. (a, b) -> b
snd ([Char], [Char])
amPm
        -- Hour
        Char
'H' -> Int -> ShowS
shows02 Int
h
        Char
'I' -> Int -> ShowS
shows02 forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod (Int
h forall a. Num a => a -> a -> a
- Int
1) Int
12
        Char
'k' -> Int -> ShowS
shows_2 Int
h
        Char
'l' -> Int -> ShowS
shows_2 forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
mod (Int
h forall a. Num a => a -> a -> a
- Int
1) Int
12
        -- Minute
        Char
'M' -> Int -> ShowS
shows02 Int
m
        -- Second
        Char
'S' -> Int -> ShowS
shows02 Int
si

        -- TODO: Unsupported by Pact
        Char
'q' -> Micros -> ShowS
fills06 Micros
su forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Micros
su forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) [Char]
"000000"

        Char
'v' -> Micros -> ShowS
fills06 Micros
su forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Micros
su
        Char
'Q' -> if Micros
su forall a. Eq a => a -> a -> Bool
== Micros
0 then forall a. a -> a
id else (:) Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micros -> ShowS
fills06 Micros
su forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micros -> ShowS
drops0 Micros
su
        -- default
        Char
_ -> Char -> ShowS
def Char
c
      where
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
si, Micros
su) = forall a. Integral a => a -> a -> (a, a)
quotRem Micros
s Micros
1000000
        TimeLocale {[Char]
[([Char], [Char])]
([Char], [Char])
amPm :: TimeLocale -> ([Char], [Char])
months :: TimeLocale -> [([Char], [Char])]
wDays :: TimeLocale -> [([Char], [Char])]
time12Fmt :: [Char]
timeFmt :: [Char]
dateFmt :: [Char]
dateTimeFmt :: [Char]
months :: [([Char], [Char])]
wDays :: [([Char], [Char])]
amPm :: ([Char], [Char])
dateFmt :: TimeLocale -> [Char]
timeFmt :: TimeLocale -> [Char]
time12Fmt :: TimeLocale -> [Char]
dateTimeFmt :: TimeLocale -> [Char]
..} = TimeLocale
defaultTimeLocale
    {-# INLINEABLE showsTime #-}

instance FormatTime SundayWeek where
    showsTime :: SundayWeek -> (Char -> ShowS) -> Char -> ShowS
showsTime (SundayWeek Int
y Int
w Int
d) = \ Char -> ShowS
def Char
c -> case Char
c of
        -- Year
        Char
'Y' -> Int -> ShowS
showsYear Int
y
        Char
'y' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
mod Int
y Int
100)
        Char
'C' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
div Int
y Int
100)
        -- WeekOfYear
        Char
'U' -> Int -> ShowS
shows02 Int
w
        -- DayOfWeek
        Char
'u' -> forall a. Show a => a -> ShowS
shows forall a b. (a -> b) -> a -> b
$ if Int
d forall a. Eq a => a -> a -> Bool
== Int
0 then Int
7 else Int
d
        Char
'w' -> forall a. Show a => a -> ShowS
shows forall a b. (a -> b) -> a -> b
$ if Int
d forall a. Eq a => a -> a -> Bool
== Int
7 then Int
0 else Int
d
        Char
'A' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
wDays forall a. [a] -> Int -> a
!! forall a. Integral a => a -> a -> a
mod Int
d Int
7
        Char
'a' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
wDays forall a. [a] -> Int -> a
!! forall a. Integral a => a -> a -> a
mod Int
d Int
7
        -- default
        Char
_ -> Char -> ShowS
def Char
c
      where
        TimeLocale {[Char]
[([Char], [Char])]
([Char], [Char])
time12Fmt :: [Char]
timeFmt :: [Char]
dateFmt :: [Char]
dateTimeFmt :: [Char]
amPm :: ([Char], [Char])
months :: [([Char], [Char])]
wDays :: [([Char], [Char])]
amPm :: TimeLocale -> ([Char], [Char])
months :: TimeLocale -> [([Char], [Char])]
wDays :: TimeLocale -> [([Char], [Char])]
dateFmt :: TimeLocale -> [Char]
timeFmt :: TimeLocale -> [Char]
time12Fmt :: TimeLocale -> [Char]
dateTimeFmt :: TimeLocale -> [Char]
..} = TimeLocale
defaultTimeLocale
    {-# INLINEABLE showsTime #-}

instance FormatTime MondayWeek where
    showsTime :: MondayWeek -> (Char -> ShowS) -> Char -> ShowS
showsTime (MondayWeek Int
y Int
w Int
d) = \ Char -> ShowS
def Char
c -> case Char
c of
        -- Year
        Char
'Y' -> Int -> ShowS
showsYear Int
y
        Char
'y' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
mod Int
y Int
100)
        Char
'C' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
div Int
y Int
100)
        -- WeekOfYear
        Char
'W' -> Int -> ShowS
shows02 Int
w
        -- DayOfWeek
        Char
'u' -> forall a. Show a => a -> ShowS
shows forall a b. (a -> b) -> a -> b
$ if Int
d forall a. Eq a => a -> a -> Bool
== Int
0 then Int
7 else Int
d
        Char
'w' -> forall a. Show a => a -> ShowS
shows forall a b. (a -> b) -> a -> b
$ if Int
d forall a. Eq a => a -> a -> Bool
== Int
7 then Int
0 else Int
d
        Char
'A' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
wDays forall a. [a] -> Int -> a
!! forall a. Integral a => a -> a -> a
mod Int
d Int
7
        Char
'a' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
wDays forall a. [a] -> Int -> a
!! forall a. Integral a => a -> a -> a
mod Int
d Int
7
        -- default
        Char
_ -> Char -> ShowS
def Char
c
      where
        TimeLocale {[Char]
[([Char], [Char])]
([Char], [Char])
time12Fmt :: [Char]
timeFmt :: [Char]
dateFmt :: [Char]
dateTimeFmt :: [Char]
amPm :: ([Char], [Char])
months :: [([Char], [Char])]
wDays :: [([Char], [Char])]
amPm :: TimeLocale -> ([Char], [Char])
months :: TimeLocale -> [([Char], [Char])]
wDays :: TimeLocale -> [([Char], [Char])]
dateFmt :: TimeLocale -> [Char]
timeFmt :: TimeLocale -> [Char]
time12Fmt :: TimeLocale -> [Char]
dateTimeFmt :: TimeLocale -> [Char]
..} = TimeLocale
defaultTimeLocale
    {-# INLINEABLE showsTime #-}

instance FormatTime WeekDate where
    showsTime :: WeekDate -> (Char -> ShowS) -> Char -> ShowS
showsTime (WeekDate Int
y Int
w Int
d) = \ Char -> ShowS
def Char
c -> case Char
c of
        -- Year
        Char
'G' -> Int -> ShowS
showsYear Int
y
        Char
'g' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
mod Int
y Int
100)
        Char
'f' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
div Int
y Int
100)
        -- WeekOfYear
        Char
'V' -> Int -> ShowS
shows02 Int
w
        -- DayOfWeek
        Char
'u' -> forall a. Show a => a -> ShowS
shows forall a b. (a -> b) -> a -> b
$ if Int
d forall a. Eq a => a -> a -> Bool
== Int
0 then Int
7 else Int
d
        Char
'w' -> forall a. Show a => a -> ShowS
shows forall a b. (a -> b) -> a -> b
$ if Int
d forall a. Eq a => a -> a -> Bool
== Int
7 then Int
0 else Int
d
        Char
'A' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
wDays forall a. [a] -> Int -> a
!! forall a. Integral a => a -> a -> a
mod Int
d Int
7
        Char
'a' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
wDays forall a. [a] -> Int -> a
!! forall a. Integral a => a -> a -> a
mod Int
d Int
7
        -- default
        Char
_ -> Char -> ShowS
def Char
c
      where
        TimeLocale {[Char]
[([Char], [Char])]
([Char], [Char])
time12Fmt :: [Char]
timeFmt :: [Char]
dateFmt :: [Char]
dateTimeFmt :: [Char]
amPm :: ([Char], [Char])
months :: [([Char], [Char])]
wDays :: [([Char], [Char])]
amPm :: TimeLocale -> ([Char], [Char])
months :: TimeLocale -> [([Char], [Char])]
wDays :: TimeLocale -> [([Char], [Char])]
dateFmt :: TimeLocale -> [Char]
timeFmt :: TimeLocale -> [Char]
time12Fmt :: TimeLocale -> [Char]
dateTimeFmt :: TimeLocale -> [Char]
..} = TimeLocale
defaultTimeLocale
    {-# INLINEABLE showsTime #-}

instance FormatTime YearMonthDay where
    showsTime :: YearMonthDay -> (Char -> ShowS) -> Char -> ShowS
showsTime (YearMonthDay Int
y Int
m Int
d) Char -> ShowS
def Char
c = case Char
c of
        -- aggregate
        Char
'D' -> Int -> ShowS
shows02 Int
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'/' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
shows02 Int
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'/' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
mod Int
y Int
100)
        Char
'F' -> Int -> ShowS
showsYear Int
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'-' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
shows02 Int
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'-' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
shows02 Int
d
        -- Year
        Char
'Y' -> Int -> ShowS
showsYear Int
y
        Char
'y' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
mod Int
y Int
100)
        Char
'C' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
div Int
y Int
100)
        -- Month
        Char
'B' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
months forall a. [a] -> Int -> a
!! (Int
m forall a. Num a => a -> a -> a
- Int
1)
        Char
'b' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
months forall a. [a] -> Int -> a
!! (Int
m forall a. Num a => a -> a -> a
- Int
1)
        Char
'h' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
months forall a. [a] -> Int -> a
!! (Int
m forall a. Num a => a -> a -> a
- Int
1)
        Char
'm' -> Int -> ShowS
shows02 Int
m
        -- DayOfMonth
        Char
'd' -> Int -> ShowS
shows02 Int
d
        Char
'e' -> Int -> ShowS
shows_2 Int
d
        -- default
        Char
_ -> Char -> ShowS
def Char
c
      where
        TimeLocale {[Char]
[([Char], [Char])]
([Char], [Char])
time12Fmt :: [Char]
timeFmt :: [Char]
dateFmt :: [Char]
dateTimeFmt :: [Char]
amPm :: ([Char], [Char])
wDays :: [([Char], [Char])]
months :: [([Char], [Char])]
amPm :: TimeLocale -> ([Char], [Char])
months :: TimeLocale -> [([Char], [Char])]
wDays :: TimeLocale -> [([Char], [Char])]
dateFmt :: TimeLocale -> [Char]
timeFmt :: TimeLocale -> [Char]
time12Fmt :: TimeLocale -> [Char]
dateTimeFmt :: TimeLocale -> [Char]
..} = TimeLocale
defaultTimeLocale
    {-# INLINEABLE showsTime #-}

instance FormatTime MonthDay where
    showsTime :: MonthDay -> (Char -> ShowS) -> Char -> ShowS
showsTime (MonthDay Int
m Int
d) Char -> ShowS
def Char
c = case Char
c of
        -- Month
        Char
'B' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
months forall a. [a] -> Int -> a
!! (Int
m forall a. Num a => a -> a -> a
- Int
1)
        Char
'b' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
months forall a. [a] -> Int -> a
!! (Int
m forall a. Num a => a -> a -> a
- Int
1)
        Char
'h' -> forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
months forall a. [a] -> Int -> a
!! (Int
m forall a. Num a => a -> a -> a
- Int
1)
        Char
'm' -> Int -> ShowS
shows02 Int
m
        -- DayOfMonth
        Char
'd' -> Int -> ShowS
shows02 Int
d
        Char
'e' -> Int -> ShowS
shows_2 Int
d
        -- default
        Char
_ -> Char -> ShowS
def Char
c
      where
        TimeLocale {[Char]
[([Char], [Char])]
([Char], [Char])
time12Fmt :: [Char]
timeFmt :: [Char]
dateFmt :: [Char]
dateTimeFmt :: [Char]
amPm :: ([Char], [Char])
wDays :: [([Char], [Char])]
months :: [([Char], [Char])]
amPm :: TimeLocale -> ([Char], [Char])
months :: TimeLocale -> [([Char], [Char])]
wDays :: TimeLocale -> [([Char], [Char])]
dateFmt :: TimeLocale -> [Char]
timeFmt :: TimeLocale -> [Char]
time12Fmt :: TimeLocale -> [Char]
dateTimeFmt :: TimeLocale -> [Char]
..} = TimeLocale
defaultTimeLocale
    {-# INLINEABLE showsTime #-}

instance FormatTime OrdinalDate where
    showsTime :: OrdinalDate -> (Char -> ShowS) -> Char -> ShowS
showsTime (OrdinalDate Int
y Int
d) Char -> ShowS
def Char
c = case Char
c of
        -- Year
        Char
'Y' -> Int -> ShowS
showsYear Int
y
        Char
'y' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
mod Int
y Int
100)
        Char
'C' -> Int -> ShowS
shows02 (forall a. Integral a => a -> a -> a
div Int
y Int
100)
        -- DayOfYear
        Char
'j' -> Int -> ShowS
shows03 Int
d
        -- default
        Char
_ -> Char -> ShowS
def Char
c
    {-# INLINEABLE showsTime #-}

-- | Format Date that is represented as 'ModifiedJulianDay'
--
instance FormatTime ModifiedJulianDay where
    showsTime :: ModifiedJulianDay -> (Char -> ShowS) -> Char -> ShowS
showsTime d :: ModifiedJulianDay
d@(ModifiedJulianDay -> OrdinalDate
toOrdinalDate -> OrdinalDate
ordinal)
        = forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime OrdinalDate
ordinal
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime (OrdinalDate -> YearMonthDay
ymdFromOrdinal OrdinalDate
ordinal)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime (OrdinalDate -> ModifiedJulianDay -> WeekDate
toWeekOrdinal OrdinalDate
ordinal ModifiedJulianDay
d)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime (OrdinalDate -> ModifiedJulianDay -> SundayWeek
toSundayOrdinal OrdinalDate
ordinal ModifiedJulianDay
d)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime (OrdinalDate -> ModifiedJulianDay -> MondayWeek
toMondayOrdinal OrdinalDate
ordinal ModifiedJulianDay
d)
    {-# INLINEABLE showsTime #-}

instance FormatTime ModifiedJulianDate where
    showsTime :: ModifiedJulianDate -> (Char -> ShowS) -> Char -> ShowS
showsTime (ModifiedJulianDate ModifiedJulianDay
d NominalDiffTime
dt) =
        forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime ModifiedJulianDay
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime (NominalDiffTime -> TimeOfDay
timeOfDayFromNominalDiffTime NominalDiffTime
dt)
    {-# INLINEABLE showsTime #-}

instance FormatTime UTCTime where
    showsTime :: UTCTime -> (Char -> ShowS) -> Char -> ShowS
showsTime UTCTime
t Char -> ShowS
def Char
c = case Char
c of
        Char
's' -> forall a. Show a => a -> ShowS
shows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> (a, a)
quotRem (UTCTime -> Micros
toPosixTimestampMicros UTCTime
t) Micros
1000000
        Char
_ -> (forall t. FormatTime t => t -> (Char -> ShowS) -> Char -> ShowS
showsTime (UTCTime -> ModifiedJulianDate
toModifiedJulianDate UTCTime
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS) -> Char -> ShowS
formatUtcZone) Char -> ShowS
def Char
c
    {-# INLINEABLE showsTime #-}

-- | Pact only supports UTC
--
formatUtcZone :: (Char -> ShowS) -> Char -> ShowS
formatUtcZone :: (Char -> ShowS) -> Char -> ShowS
formatUtcZone Char -> ShowS
def Char
c = case Char
c of
    Char
'z' -> forall a. [a] -> [a] -> [a]
(++) [Char]
"+0000"
    Char
'N' -> forall a. [a] -> [a] -> [a]
(++) [Char]
"+00:00"
    Char
'Z' -> forall a. [a] -> [a] -> [a]
(++) [Char]
"UTC"
    Char
_ -> Char -> ShowS
def Char
c
{-# INLINEABLE formatUtcZone #-}

-- -------------------------------------------------------------------------- --
-- Parser Utils

utf8Char :: Char -> S.ByteString
utf8Char :: Char -> ByteString
utf8Char = ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
B.charUtf8
{-# INLINE utf8Char #-}

utf8String :: String -> S.ByteString
utf8String :: [Char] -> ByteString
utf8String = ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Builder
B.stringUtf8
{-# INLINE utf8String #-}

parserToReadS :: Parser a -> ReadS a
parserToReadS :: forall a. Parser a -> ReadS a
parserToReadS = forall a. (ByteString -> Result a) -> ReadS a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
P.parse
  where
    go :: (S.ByteString -> Result a) -> ReadS a
    go :: forall a. (ByteString -> Result a) -> ReadS a
go ByteString -> Result a
k (forall a. Int -> [a] -> ([a], [a])
splitAt Int
32 -> ([Char]
h, [Char]
t)) = case ByteString -> Result a
k ([Char] -> ByteString
utf8String [Char]
h) of
        -- `date -R | wc -c` is 32 characters
        Fail ByteString
rest [[Char]]
cxts [Char]
msg -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Char]
"parserToReadS: ", [Char]
msg
            , [Char]
"; remaining: ", forall a. Show a => a -> [Char]
show (ByteString -> [Char]
utf8Decode ByteString
rest), [Char]
"; stack: ", forall a. Show a => a -> [Char]
show [[Char]]
cxts ]
        Partial ByteString -> Result a
k' -> forall a. (ByteString -> Result a) -> ReadS a
go ByteString -> Result a
k' [Char]
t
        Done ByteString
rest a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, ByteString -> [Char]
utf8Decode ByteString
rest forall a. [a] -> [a] -> [a]
++ [Char]
t)
    {-# INLINEABLE go #-}

    utf8Decode :: S.ByteString -> String
    utf8Decode :: ByteString -> [Char]
utf8Decode = Text -> [Char]
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8
    {-# INLINE utf8Decode #-}
{-# INLINEABLE parserToReadS #-}

indexOfCI :: [String] -> Parser Int
indexOfCI :: [[Char]] -> Parser Int
indexOfCI = forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i [Char]
s -> Int
i forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser ()
stringCI [Char]
s) [Int
0..]
{-# INLINE indexOfCI #-}

-- | Case-insensitive UTF-8 ByteString parser
--
-- Matches one character at a time. Slow.
--
stringCI :: String -> Parser ()
stringCI :: [Char] -> Parser ()
stringCI = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Parser ()
p Char
c -> Parser ()
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ()
charCI Char
c) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE stringCI #-}

-- | Case-insensitive UTF-8 ByteString parser
--
-- We can't easily perform upper/lower case conversion on the input, so
-- instead we accept either one of @toUpper c@ and @toLower c@.
--
charCI :: Char -> Parser ()
charCI :: Char -> Parser ()
charCI Char
c = if Char
u forall a. Eq a => a -> a -> Bool
== Char
l then Char -> Parser ()
charU8 Char
c else Char -> Parser ()
charU8 Char
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ()
charU8 Char
u
  where
    l :: Char
l = Char -> Char
toLower Char
c
    u :: Char
u = Char -> Char
toUpper Char
c
{-# INLINE charCI #-}

charU8 :: Char -> Parser ()
charU8 :: Char -> Parser ()
charU8 Char
c = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
P.string (Char -> ByteString
utf8Char Char
c)
{-# INLINE charU8 #-}

-- | Number may be prefixed with '-'
--
negative :: (Integral n) => Parser n -> Parser n
negative :: forall n. Integral n => Parser n -> Parser n
negative Parser n
p = forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
'-' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser n
p
{-# INLINE negative #-}

-- | Fixed-length 0-padded decimal
--
dec0 :: Int -> Parser Int
dec0 :: Int -> Parser Int
dec0 Int
n = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
P.parseOnly forall a. Integral a => Parser a
P.decimal forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Parser ByteString
P.take Int
n
{-# INLINE dec0 #-}

-- | Fixed-length space-padded decimal
--
dec_ :: Int -> Parser Int
dec_ :: Int -> Parser Int
dec_ Int
n = Int -> Parser ByteString
P.take Int
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
P.parseOnly forall a. Integral a => Parser a
P.decimal
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
S.dropWhile Char -> Bool
isSpace
{-# INLINE dec_ #-}

-- -------------------------------------------------------------------------- --
-- Time Zones

data TimeZone = TimeZone
    { TimeZone -> Int
_timeZoneMinutes :: {-# UNPACK #-} !Minutes
    , TimeZone -> Bool
_timeZoneSummerOnly :: !Bool
    , TimeZone -> [Char]
_timeZoneName :: String
    }

timeZoneMinutes :: Lens' TimeZone Minutes
timeZoneMinutes :: Lens' TimeZone Int
timeZoneMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeZone -> Int
_timeZoneMinutes forall a b. (a -> b) -> a -> b
$ \TimeZone
a Int
b -> TimeZone
a { _timeZoneMinutes :: Int
_timeZoneMinutes = Int
b }
{-# INLINE timeZoneMinutes #-}

utc :: TimeZone
utc :: TimeZone
utc = Int -> Bool -> [Char] -> TimeZone
TimeZone Int
0 Bool
False [Char]
"UTC"

timeZoneOffset :: TimeZone -> NominalDiffTime
timeZoneOffset :: TimeZone -> NominalDiffTime
timeZoneOffset = Micros -> NominalDiffTime
fromMicroseconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
(*) Int
60000000 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> Int
_timeZoneMinutes
{-# INLINE timeZoneOffset #-}

-- -------------------------------------------------------------------------- --
-- Parse String into a Time Parse Value

data TimeFlag
    = PostMeridiem
    | TwelveHour
    | HasCentury
    | IsPOSIXTime
    | IsOrdinalDate
    | IsGregorian
    | IsWeekDate
    | IsSundayWeek
    | IsMondayWeek
    deriving (Int -> TimeFlag
TimeFlag -> Int
TimeFlag -> [TimeFlag]
TimeFlag -> TimeFlag
TimeFlag -> TimeFlag -> [TimeFlag]
TimeFlag -> TimeFlag -> TimeFlag -> [TimeFlag]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TimeFlag -> TimeFlag -> TimeFlag -> [TimeFlag]
$cenumFromThenTo :: TimeFlag -> TimeFlag -> TimeFlag -> [TimeFlag]
enumFromTo :: TimeFlag -> TimeFlag -> [TimeFlag]
$cenumFromTo :: TimeFlag -> TimeFlag -> [TimeFlag]
enumFromThen :: TimeFlag -> TimeFlag -> [TimeFlag]
$cenumFromThen :: TimeFlag -> TimeFlag -> [TimeFlag]
enumFrom :: TimeFlag -> [TimeFlag]
$cenumFrom :: TimeFlag -> [TimeFlag]
fromEnum :: TimeFlag -> Int
$cfromEnum :: TimeFlag -> Int
toEnum :: Int -> TimeFlag
$ctoEnum :: Int -> TimeFlag
pred :: TimeFlag -> TimeFlag
$cpred :: TimeFlag -> TimeFlag
succ :: TimeFlag -> TimeFlag
$csucc :: TimeFlag -> TimeFlag
Enum, Int -> TimeFlag -> ShowS
[TimeFlag] -> ShowS
TimeFlag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TimeFlag] -> ShowS
$cshowList :: [TimeFlag] -> ShowS
show :: TimeFlag -> [Char]
$cshow :: TimeFlag -> [Char]
showsPrec :: Int -> TimeFlag -> ShowS
$cshowsPrec :: Int -> TimeFlag -> ShowS
Show)

data TimeParse = TimeParse
    { TimeParse -> Int
_tpCentury :: {-# UNPACK #-} !Century
    , TimeParse -> Int
_tpCenturyYear :: {-# UNPACK #-} !Int{-YearOfCentury-}
    , TimeParse -> Int
_tpMonth :: {-# UNPACK #-} !Month
    , TimeParse -> Int
_tpWeekOfYear :: {-# UNPACK #-} !WeekOfYear
    , TimeParse -> Int
_tpDayOfMonth :: {-# UNPACK #-} !DayOfMonth
    , TimeParse -> Int
_tpDayOfYear :: {-# UNPACK #-} !DayOfYear
    , TimeParse -> Int
_tpDayOfWeek :: {-# UNPACK #-} !DayOfWeek
    , TimeParse -> Int
_tpFlags :: {-# UNPACK #-} !Int{-BitSet TimeFlag-}
    , TimeParse -> Int
_tpHour :: {-# UNPACK #-} !Hour
    , TimeParse -> Int
_tpMinute :: {-# UNPACK #-} !Minute
    , TimeParse -> Int
_tpSecond :: {-# UNPACK #-} !Second
    , TimeParse -> NominalDiffTime
_tpSecFrac :: {-# UNPACK #-} !NominalDiffTime
    , TimeParse -> NominalDiffTime
_tpPOSIXTime :: {-# UNPACK #-} !NominalDiffTime
    , TimeParse -> TimeZone
_tpTimeZone :: !TimeZone
    }

flag :: TimeFlag -> Lens' TimeParse Bool
flag :: TimeFlag -> Lens' TimeParse Bool
flag (forall a. Enum a => a -> Int
fromEnum -> Int
f) = Lens' TimeParse Int
tpFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (forall a. Bits a => a -> Int -> Bool
`testBit` Int
f) (\ Int
n Bool
b -> (if Bool
b then forall a. Bits a => a -> Int -> a
setBit else forall a. Bits a => a -> Int -> a
clearBit) Int
n Int
f)
{-# INLINE flag #-}

tpYear :: TimeParse -> Year
tpYear :: TimeParse -> Int
tpYear TimeParse
tp = TimeParse -> Int
_tpCenturyYear TimeParse
tp forall a. Num a => a -> a -> a
+ Int
100 forall a. Num a => a -> a -> a
* if TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
HasCentury
  then TimeParse -> Int
_tpCentury TimeParse
tp
  else if TimeParse -> Int
_tpCenturyYear TimeParse
tp forall a. Ord a => a -> a -> Bool
< Int
69
    then Int
20
    else Int
19
{-# INLINE tpYear #-}

-- | Time 'Parser' for UTF-8 encoded 'ByteString's.
--
-- Attoparsec easily beats any 'String' parser out there, but we do have to
-- be careful to convert the input to UTF-8 'ByteString's.
--
timeParser :: String -> Parser TimeParse
timeParser :: [Char] -> Parser TimeParse
timeParser = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT TimeParse
unixEpoch forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> StateT TimeParse (Parser ByteString) ()
go
  where

    go :: String -> StateT TimeParse Parser ()
    go :: [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
spec = case [Char]
spec of
        Char
'%' : Char
cspec : [Char]
rspec -> case Char
cspec of
            -- aggregate
            Char
'c' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go (TimeLocale -> [Char]
dateTimeFmt TimeLocale
l forall a. [a] -> [a] -> [a]
++ [Char]
rspec)
            Char
'r' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go (TimeLocale -> [Char]
time12Fmt TimeLocale
l forall a. [a] -> [a] -> [a]
++ [Char]
rspec)
            Char
'X' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go (TimeLocale -> [Char]
timeFmt TimeLocale
l forall a. [a] -> [a] -> [a]
++ [Char]
rspec)
            Char
'x' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go (TimeLocale -> [Char]
dateFmt TimeLocale
l forall a. [a] -> [a] -> [a]
++ [Char]
rspec)
            Char
'R' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go ([Char]
"%H:%M" forall a. [a] -> [a] -> [a]
++ [Char]
rspec)
            Char
'T' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go ([Char]
"%H:%M:%S" forall a. [a] -> [a] -> [a]
++ [Char]
rspec)
            Char
'D' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go ([Char]
"%m/%d/%y" forall a. [a] -> [a] -> [a]
++ [Char]
rspec)
            Char
'F' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go ([Char]
"%Y-%m-%d" forall a. [a] -> [a] -> [a]
++ [Char]
rspec)
            -- AM/PM
            Char
'P' -> StateT TimeParse (Parser ByteString) ()
dayHalf
            Char
'p' -> StateT TimeParse (Parser ByteString) ()
dayHalf
            -- Hour
            Char
'H' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setHour24
            Char
'I' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setHour12
            Char
'k' -> (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec_ Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setHour24)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec_ Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setHour24)
            Char
'l' -> (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec_ Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setHour12)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec_ Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setHour12)
            -- Minute
            Char
'M' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' TimeParse Int
tpMinute forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            -- Second
            Char
'S' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' TimeParse Int
tpSecond forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec

            -- TODO: Unsupported by pact
            Char
'q' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Micros
micro forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' TimeParse NominalDiffTime
tpSecFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micros -> NominalDiffTime
NominalDiffTime forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec

            Char
'v' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Micros
micro forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' TimeParse NominalDiffTime
tpSecFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micros -> NominalDiffTime
NominalDiffTime forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            Char
'Q' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Char -> Parser Char
P.char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Micros -> NominalDiffTime
NominalDiffTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Micros
micro) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall v. AdditiveGroup v => v
zeroV)
                forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' TimeParse NominalDiffTime
tpSecFrac forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec

            -- Year
            Char
'Y' -> StateT TimeParse (Parser ByteString) ()
fullYear
            Char
'y' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setCenturyYear
            Char
'C' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setCentury
            -- Month
            Char
'B' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([[Char]] -> Parser Int
indexOfCI forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeLocale -> [([Char], [Char])]
months TimeLocale
l) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setMonth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> a
succ
            Char
'b' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([[Char]] -> Parser Int
indexOfCI forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeLocale -> [([Char], [Char])]
months TimeLocale
l) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setMonth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> a
succ
            Char
'h' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([[Char]] -> Parser Int
indexOfCI forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeLocale -> [([Char], [Char])]
months TimeLocale
l) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setMonth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> a
succ
            Char
'm' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setMonth
            -- DayOfMonth
            Char
'd' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setDayOfMonth
            Char
'e' -> (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec_ Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setDayOfMonth)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec_ Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setDayOfMonth)
            -- DayOfYear
            Char
'j' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
3) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' TimeParse Int
tpDayOfYear
                forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsOrdinalDate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec

            -- Year (WeekDate)
            -- FIXME: problematic if input contains both %Y and %G
            Char
'G' -> TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsWeekDate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT TimeParse (Parser ByteString) ()
fullYear
            Char
'g' -> TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsWeekDate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setCenturyYear
            Char
'f' -> TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsWeekDate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setCentury
            -- WeekOfYear
            -- FIXME: problematic if more than one of the following
            Char
'V' -> TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsWeekDate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setWeekOfYear
            Char
'U' -> TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsSundayWeek forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setWeekOfYear
            Char
'W' -> TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsMondayWeek forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setWeekOfYear
            -- DayOfWeek
            Char
'w' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setDayOfWeek
            Char
'u' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setDayOfWeek
            Char
'A' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([[Char]] -> Parser Int
indexOfCI forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeLocale -> [([Char], [Char])]
wDays TimeLocale
l) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setDayOfWeek
            Char
'a' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([[Char]] -> Parser Int
indexOfCI forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeLocale -> [([Char], [Char])]
wDays TimeLocale
l) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT TimeParse (Parser ByteString) ()
setDayOfWeek

            -- TimeZone
            Char
'z' -> do StateT TimeParse (Parser ByteString) ()
tzOffset; [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            Char
'N' -> do StateT TimeParse (Parser ByteString) ()
tzOffset; [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            Char
'Z' -> do StateT TimeParse (Parser ByteString) ()
tzOffset forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT TimeParse (Parser ByteString) ()
tzName; [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            -- UTCTime
            Char
's' -> do
                Micros
s <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall n. Integral n => Parser n -> Parser n
negative forall a. Integral a => Parser a
P.decimal)
                Lens' TimeParse NominalDiffTime
tpPOSIXTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Micros -> NominalDiffTime
fromMicroseconds (Micros
1000000 forall a. Num a => a -> a -> a
* Micros
s)
                TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsPOSIXTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec

            -- modifier (whatever)
            Char
'-' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go (Char
'%' forall a. a -> [a] -> [a]
: [Char]
rspec)
            Char
'_' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go (Char
'%' forall a. a -> [a] -> [a]
: [Char]
rspec)
            Char
'0' -> [Char] -> StateT TimeParse (Parser ByteString) ()
go (Char
'%' forall a. a -> [a] -> [a]
: [Char]
rspec)
            -- escape (why would anyone need %t and %n?)
            Char
'%' -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
P.char Char
'%') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            Char
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown format character: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Char
cspec

          where
            l :: TimeLocale
l = TimeLocale
defaultTimeLocale
            dayHalf :: StateT TimeParse (Parser ByteString) ()
dayHalf = do
                Bool
pm <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser ()
stringCI (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ TimeLocale -> ([Char], [Char])
amPm TimeLocale
l)
                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser ()
stringCI (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ TimeLocale -> ([Char], [Char])
amPm TimeLocale
l)
                TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
PostMeridiem forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
pm
                TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
TwelveHour forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            -- NOTE: if a greedy parse fails or causes a later failure,
            -- then backtrack and only accept 4-digit years; see #5.
            fullYear :: StateT TimeParse (Parser ByteString) ()
fullYear = Parser Int -> StateT TimeParse (Parser ByteString) ()
year (forall n. Integral n => Parser n -> Parser n
negative forall a. Integral a => Parser a
P.decimal) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Int -> StateT TimeParse (Parser ByteString) ()
year (Int -> Parser Int
dec0 Int
4)
              where
                year :: Parser Int -> StateT TimeParse (Parser ByteString) ()
year Parser Int
p = do
                    (Int
c, Int
y) <- (forall a. Integral a => a -> a -> (a, a)
`divMod` Int
100) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Int
p
                    TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
HasCentury forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                    Lens' TimeParse Int
tpCentury forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
c
                    Lens' TimeParse Int
tpCenturyYear forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
y
                    [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            setHour12 :: Int -> StateT TimeParse (Parser ByteString) ()
setHour12 Int
h = do
                TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
TwelveHour forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                Lens' TimeParse Int
tpHour forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
h
                [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            setHour24 :: Int -> StateT TimeParse (Parser ByteString) ()
setHour24 Int
h = do
                TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
TwelveHour forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
                Lens' TimeParse Int
tpHour forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
h
                [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            setCenturyYear :: Int -> StateT TimeParse (Parser ByteString) ()
setCenturyYear Int
y = do Lens' TimeParse Int
tpCenturyYear forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
y; [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            setCentury :: Int -> StateT TimeParse (Parser ByteString) ()
setCentury Int
c = do
                Lens' TimeParse Int
tpCentury forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
c
                TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
HasCentury forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            setMonth :: Int -> StateT TimeParse (Parser ByteString) ()
setMonth Int
m = do
                TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsGregorian forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                Lens' TimeParse Int
tpMonth forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
m
                [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            setDayOfMonth :: Int -> StateT TimeParse (Parser ByteString) ()
setDayOfMonth Int
d = do
                TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsGregorian forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                Lens' TimeParse Int
tpDayOfMonth forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
d
                [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            setWeekOfYear :: Int -> StateT TimeParse (Parser ByteString) ()
setWeekOfYear Int
w = do Lens' TimeParse Int
tpWeekOfYear forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
w; [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            setDayOfWeek :: Int -> StateT TimeParse (Parser ByteString) ()
setDayOfWeek Int
d = do Lens' TimeParse Int
tpDayOfWeek forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
d; [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
            tzOffset :: StateT TimeParse (Parser ByteString) ()
tzOffset = do
                Int -> Int
s <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. a -> a
id forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
'+' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
'-')
                Int
h <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2)
                () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
P.char Char
':') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Int
m <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Parser Int
dec0 Int
2)
                Lens' TimeParse TimeZone
tpTimeZone forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TimeZone Int
timeZoneMinutes forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> Int
s (Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m)
            tzName :: StateT TimeParse (Parser ByteString) ()
tzName = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser TimeZone
timeZoneParser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' TimeParse TimeZone
tpTimeZone

        Char
c : [Char]
rspec | Char -> Bool
P.isSpace Char
c ->
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Char -> Bool) -> Parser ByteString
P.takeWhile Char -> Bool
P.isSpace) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
P.isSpace [Char]
rspec)
        Char
c : [Char]
rspec | Char -> Bool
isAscii Char
c -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
P.char Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
        Char
c : [Char]
rspec -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser ()
charU8 Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> StateT TimeParse (Parser ByteString) ()
go [Char]
rspec
        [Char]
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    micro :: Parser Int64
    micro :: Parser Micros
micro = do
        Micros
us10 <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
P.parseOnly forall a. Integral a => Parser a
P.decimal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
S.take Int
7
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
`S.append` [Char] -> ByteString
S.pack [Char]
"000000") forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> Parser ByteString
P.takeWhile1 Char -> Bool
P.isDigit
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Integral a => a -> a -> a
div (Micros
us10 forall a. Num a => a -> a -> a
+ Micros
5) Micros
10)
    {-# INLINE micro #-}

    unixEpoch :: TimeParse
    unixEpoch :: TimeParse
unixEpoch = TimeParse
        { _tpCentury :: Int
_tpCentury = Int
19
        , _tpCenturyYear :: Int
_tpCenturyYear = Int
70
        , _tpMonth :: Int
_tpMonth = Int
1
        , _tpWeekOfYear :: Int
_tpWeekOfYear = Int
1
        , _tpDayOfYear :: Int
_tpDayOfYear = Int
1
        , _tpDayOfMonth :: Int
_tpDayOfMonth = Int
1
        , _tpDayOfWeek :: Int
_tpDayOfWeek = Int
4
        , _tpFlags :: Int
_tpFlags = Int
0
        , _tpHour :: Int
_tpHour = Int
0
        , _tpMinute :: Int
_tpMinute = Int
0
        , _tpSecond :: Int
_tpSecond = Int
0
        , _tpSecFrac :: NominalDiffTime
_tpSecFrac = forall v. AdditiveGroup v => v
zeroV
        , _tpPOSIXTime :: NominalDiffTime
_tpPOSIXTime = forall v. AdditiveGroup v => v
zeroV
        , _tpTimeZone :: TimeZone
_tpTimeZone = TimeZone
utc
        }
    {-# INLINE unixEpoch #-}
{-# INLINEABLE timeParser #-}

parseTime :: String -> String -> Maybe UTCTime
parseTime :: [Char] -> [Char] -> Maybe UTCTime
parseTime [Char]
spec = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
P.parseOnly Parser ByteString UTCTime
parser forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
utf8String
  where
    parser :: Parser ByteString UTCTime
parser = forall t. ParseTime t => TimeParse -> t
buildTime forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
P.skipSpace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Parser TimeParse
timeParser [Char]
spec
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
P.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
P.endOfInput
{-# INLINEABLE parseTime #-}

readTime :: (ParseTime t) => String -> String -> t
readTime :: forall t. ParseTime t => [Char] -> [Char] -> t
readTime [Char]
spec = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
P.parseOnly Parser ByteString t
parser forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
utf8String
  where
    parser :: Parser ByteString t
parser = forall t. ParseTime t => TimeParse -> t
buildTime forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
P.skipSpace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Parser TimeParse
timeParser [Char]
spec
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
P.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
P.endOfInput
{-# INLINEABLE readTime #-}

readsTime :: (ParseTime t) => String -> ReadS t
readsTime :: forall t. ParseTime t => [Char] -> ReadS t
readsTime [Char]
spec = forall a. Parser a -> ReadS a
parserToReadS forall a b. (a -> b) -> a -> b
$
    forall t. ParseTime t => TimeParse -> t
buildTime forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
P.skipSpace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Parser TimeParse
timeParser [Char]
spec
{-# INLINEABLE readsTime #-}

-- -------------------------------------------------------------------------- --
-- Build Parse Time

class ParseTime t where
    buildTime :: TimeParse -> t

instance ParseTime TimeOfDay where
    buildTime :: TimeParse -> TimeOfDay
buildTime TimeParse
tp = Int -> Int -> NominalDiffTime -> TimeOfDay
TimeOfDay Int
h (TimeParse -> Int
_tpMinute TimeParse
tp)
        (Micros -> NominalDiffTime
fromMicroseconds (Micros
1000000 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeParse -> Int
_tpSecond TimeParse
tp)) forall v. AdditiveGroup v => v -> v -> v
^+^ TimeParse -> NominalDiffTime
_tpSecFrac TimeParse
tp)
      where
        h :: Int
h = if TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
TwelveHour
              then if TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
PostMeridiem
                then if TimeParse -> Int
_tpHour TimeParse
tp forall a. Ord a => a -> a -> Bool
< Int
12
                  then TimeParse -> Int
_tpHour TimeParse
tp forall a. Num a => a -> a -> a
+ Int
12
                  else TimeParse -> Int
_tpHour TimeParse
tp
                else forall a. Integral a => a -> a -> a
mod (TimeParse -> Int
_tpHour TimeParse
tp) Int
12
              else TimeParse -> Int
_tpHour TimeParse
tp
    {-# INLINE buildTime #-}

instance ParseTime YearMonthDay where
    buildTime :: TimeParse -> YearMonthDay
buildTime TimeParse
tp = Int -> Int -> Int -> YearMonthDay
YearMonthDay (TimeParse -> Int
tpYear TimeParse
tp) (TimeParse -> Int
_tpMonth TimeParse
tp) (TimeParse -> Int
_tpDayOfMonth TimeParse
tp)
    {-# INLINE buildTime #-}

instance ParseTime OrdinalDate where
    buildTime :: TimeParse -> OrdinalDate
buildTime TimeParse
tp = Int -> Int -> OrdinalDate
OrdinalDate (TimeParse -> Int
tpYear TimeParse
tp) (TimeParse -> Int
_tpDayOfYear TimeParse
tp)
    {-# INLINE buildTime #-}

instance ParseTime WeekDate where
    buildTime :: TimeParse -> WeekDate
buildTime TimeParse
tp = Int -> Int -> Int -> WeekDate
WeekDate (TimeParse -> Int
tpYear TimeParse
tp) (TimeParse -> Int
_tpWeekOfYear TimeParse
tp)
        (if TimeParse -> Int
_tpDayOfWeek TimeParse
tp forall a. Eq a => a -> a -> Bool
== Int
0 then Int
7 else TimeParse -> Int
_tpDayOfWeek TimeParse
tp)
    {-# INLINE buildTime #-}

instance ParseTime SundayWeek where
    buildTime :: TimeParse -> SundayWeek
buildTime TimeParse
tp = Int -> Int -> Int -> SundayWeek
SundayWeek (TimeParse -> Int
tpYear TimeParse
tp) (TimeParse -> Int
_tpWeekOfYear TimeParse
tp)
        (if TimeParse -> Int
_tpDayOfWeek TimeParse
tp forall a. Eq a => a -> a -> Bool
== Int
7 then Int
0 else TimeParse -> Int
_tpDayOfWeek TimeParse
tp)
    {-# INLINE buildTime #-}

instance ParseTime MondayWeek where
    buildTime :: TimeParse -> MondayWeek
buildTime TimeParse
tp = Int -> Int -> Int -> MondayWeek
MondayWeek (TimeParse -> Int
tpYear TimeParse
tp) (TimeParse -> Int
_tpWeekOfYear TimeParse
tp)
        (if TimeParse -> Int
_tpDayOfWeek TimeParse
tp forall a. Eq a => a -> a -> Bool
== Int
0 then Int
7 else TimeParse -> Int
_tpDayOfWeek TimeParse
tp)
    {-# INLINE buildTime #-}

instance ParseTime ModifiedJulianDay where
    {-# INLINE buildTime #-}
    buildTime :: TimeParse -> ModifiedJulianDay
buildTime TimeParse
tp
        | TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsOrdinalDate = OrdinalDate -> ModifiedJulianDay
fromOrdinalDate forall a b. (a -> b) -> a -> b
$ forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp
        | TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsGregorian = YearMonthDay -> ModifiedJulianDay
toGregorian forall a b. (a -> b) -> a -> b
$ forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp
        | TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsWeekDate = WeekDate -> ModifiedJulianDay
fromWeekDate forall a b. (a -> b) -> a -> b
$ forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp
        | TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsSundayWeek = SundayWeek -> ModifiedJulianDay
fromSundayWeek forall a b. (a -> b) -> a -> b
$ forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp
        | TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsMondayWeek = MondayWeek -> ModifiedJulianDay
fromMondayWeek forall a b. (a -> b) -> a -> b
$ forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp
        | Bool
otherwise = OrdinalDate -> ModifiedJulianDay
fromOrdinalDate forall a b. (a -> b) -> a -> b
$ forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp
        -- TODO: Better conflict handling when multiple flags are set?

instance ParseTime TimeZone where
    buildTime :: TimeParse -> TimeZone
buildTime = TimeParse -> TimeZone
_tpTimeZone
    {-# INLINE buildTime #-}

instance ParseTime UTCTime where
    buildTime :: TimeParse -> UTCTime
buildTime TimeParse
tp = if TimeParse
tp forall s a. s -> Getting a s a -> a
^. TimeFlag -> Lens' TimeParse Bool
flag TimeFlag
IsPOSIXTime
        then  Micros -> UTCTime
fromPosixTimestampMicros forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Micros
toMicroseconds forall a b. (a -> b) -> a -> b
$ TimeParse -> NominalDiffTime
_tpPOSIXTime TimeParse
tp
        else UTCTime
zoned
      where
        d :: ModifiedJulianDay
        d :: ModifiedJulianDay
d = forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp

        dt :: TimeOfDay
        dt :: TimeOfDay
dt = forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp

        tz :: TimeZone
        tz :: TimeZone
tz = forall t. ParseTime t => TimeParse -> t
buildTime TimeParse
tp

        jul :: ModifiedJulianDate
        jul :: ModifiedJulianDate
jul = ModifiedJulianDay -> NominalDiffTime -> ModifiedJulianDate
ModifiedJulianDate ModifiedJulianDay
d (TimeOfDay -> NominalDiffTime
toDayTime TimeOfDay
dt)

        zoned :: UTCTime
        zoned :: UTCTime
zoned = ModifiedJulianDate -> UTCTime
fromModifiedJulianDate ModifiedJulianDate
jul forall p. AffineSpace p => p -> Diff p -> p
.+^ TimeZone -> NominalDiffTime
timeZoneOffset TimeZone
tz

        toDayTime :: TimeOfDay -> NominalDiffTime
        toDayTime :: TimeOfDay -> NominalDiffTime
toDayTime (TimeOfDay Int
h Int
m NominalDiffTime
s) = NominalDiffTime
s
            forall v. AdditiveGroup v => v -> v -> v
^+^ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall v. VectorSpace v => Scalar v -> v -> v
*^ Micros -> NominalDiffTime
NominalDiffTime Micros
60000000
            forall v. AdditiveGroup v => v -> v -> v
^+^ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h forall v. VectorSpace v => Scalar v -> v -> v
*^ Micros -> NominalDiffTime
NominalDiffTime Micros
3600000000
        {-# INLINEABLE toDayTime #-}
    {-# INLINE buildTime #-}

-- -------------------------------------------------------------------------- --
-- Time Zone Parser

timeZoneParser :: Parser TimeZone
timeZoneParser :: Parser TimeZone
timeZoneParser = [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"TAI" Int
0 Bool
False forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"UT1" Int
0 Bool
False

    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"ZULU" (forall a. Num a => a -> a -> a
($+) Int
00 Int
00) Bool
False --  Same as UTC
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"Z" (forall a. Num a => a -> a -> a
($+) Int
00 Int
00) Bool
False --  Same as UTC
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"YST" (forall a. Num a => a -> a -> a
($-) Int
09 Int
00) Bool
False -- Yukon Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"YDT" (forall a. Num a => a -> a -> a
($-) Int
08 Int
00) Bool
True -- Yukon Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"WST" (forall a. Num a => a -> a -> a
($+) Int
08 Int
00) Bool
False -- West Australian Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"WETDST" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
True -- Western European Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"WET" (forall a. Num a => a -> a -> a
($+) Int
00 Int
00) Bool
False --  Western European Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"WDT" (forall a. Num a => a -> a -> a
($+) Int
09 Int
00) Bool
True -- West Australian Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"WAT" (forall a. Num a => a -> a -> a
($-) Int
01 Int
00) Bool
False -- West Africa Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"WAST" (forall a. Num a => a -> a -> a
($+) Int
07 Int
00) Bool
False -- West Australian Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"WADT" (forall a. Num a => a -> a -> a
($+) Int
08 Int
00) Bool
True -- West Australian Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"UTC" (forall a. Num a => a -> a -> a
($+) Int
00 Int
00) Bool
False --  Universal Coordinated Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"UT" (forall a. Num a => a -> a -> a
($+) Int
00 Int
00) Bool
False --  Universal Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"TFT" (forall a. Num a => a -> a -> a
($+) Int
05 Int
00) Bool
False -- Kerguelen Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"SWT" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- Swedish Winter Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"SST" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
False -- Swedish Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"SET" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- Seychelles Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"SCT" (forall a. Num a => a -> a -> a
($+) Int
04 Int
00) Bool
False -- Mahe Island Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"SAST" (forall a. Num a => a -> a -> a
($+) Int
09 Int
30) Bool
False -- South Australia Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"SADT" (forall a. Num a => a -> a -> a
($+) Int
10 Int
30) Bool
True -- South Australian Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"RET" (forall a. Num a => a -> a -> a
($+) Int
04 Int
00) Bool
False -- Reunion Island Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"PST" (forall a. Num a => a -> a -> a
($-) Int
08 Int
00) Bool
False -- Pacific Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"PDT" (forall a. Num a => a -> a -> a
($-) Int
07 Int
00) Bool
True -- Pacific Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"NZT" (forall a. Num a => a -> a -> a
($+) Int
12 Int
00) Bool
False -- New Zealand Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"NZST" (forall a. Num a => a -> a -> a
($+) Int
12 Int
00) Bool
False -- New Zealand Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"NZDT" (forall a. Num a => a -> a -> a
($+) Int
13 Int
00) Bool
True -- New Zealand Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"NT" (forall a. Num a => a -> a -> a
($-) Int
11 Int
00) Bool
False -- Nome Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"NST" (forall a. Num a => a -> a -> a
($-) Int
03 Int
30) Bool
False -- Newfoundland Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"NOR" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- Norway Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"NFT" (forall a. Num a => a -> a -> a
($-) Int
03 Int
30) Bool
False -- Newfoundland Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"NDT" (forall a. Num a => a -> a -> a
($-) Int
02 Int
30) Bool
True -- Newfoundland Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MVT" (forall a. Num a => a -> a -> a
($+) Int
05 Int
00) Bool
False -- Maldives Island Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MUT" (forall a. Num a => a -> a -> a
($+) Int
04 Int
00) Bool
False -- Mauritius Island Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MT" (forall a. Num a => a -> a -> a
($+) Int
08 Int
30) Bool
False -- Moluccas Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MST" (forall a. Num a => a -> a -> a
($-) Int
07 Int
00) Bool
False -- Mountain Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MMT" (forall a. Num a => a -> a -> a
($+) Int
06 Int
30) Bool
False -- Myanmar Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MHT" (forall a. Num a => a -> a -> a
($+) Int
09 Int
00) Bool
False -- Kwajalein Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MEZ" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- Mitteleuropaeische Zeit
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MEWT" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- Middle European Winter Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"METDST" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
True -- Middle Europe Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MET" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- Middle European Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MEST" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
False -- Middle European Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MDT" (forall a. Num a => a -> a -> a
($-) Int
06 Int
00) Bool
True -- Mountain Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MAWT" (forall a. Num a => a -> a -> a
($+) Int
06 Int
00) Bool
False -- Mawson (Antarctica) Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"MART" (forall a. Num a => a -> a -> a
($-) Int
09 Int
30) Bool
False -- Marquesas Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"LIGT" (forall a. Num a => a -> a -> a
($+) Int
10 Int
00) Bool
False -- Melbourne, Australia
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"KST" (forall a. Num a => a -> a -> a
($+) Int
09 Int
00) Bool
False -- Korea Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"JT" (forall a. Num a => a -> a -> a
($+) Int
07 Int
30) Bool
False -- Java Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"JST" (forall a. Num a => a -> a -> a
($+) Int
09 Int
00) Bool
False -- Japan Standard Time, Russia zone 8
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"IT" (forall a. Num a => a -> a -> a
($+) Int
03 Int
30) Bool
False -- Iran Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"IST" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
False -- Israel Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"IRT" (forall a. Num a => a -> a -> a
($+) Int
03 Int
30) Bool
False -- Iran Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"IOT" (forall a. Num a => a -> a -> a
($+) Int
05 Int
00) Bool
False -- Indian Chagos Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"IDLW" (forall a. Num a => a -> a -> a
($-) Int
12 Int
00) Bool
False -- International Date Line, West
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"IDLE" (forall a. Num a => a -> a -> a
($+) Int
12 Int
00) Bool
False -- International Date Line, East
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"HST" (forall a. Num a => a -> a -> a
($-) Int
10 Int
00) Bool
False -- Hawaii Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"HMT" (forall a. Num a => a -> a -> a
($+) Int
03 Int
00) Bool
False -- Hellas Mediterranean Time (?)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"HDT" (forall a. Num a => a -> a -> a
($-) Int
09 Int
00) Bool
True -- Hawaii/Alaska Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"GST" (forall a. Num a => a -> a -> a
($+) Int
10 Int
00) Bool
False -- Guam Standard Time, Russia zone 9
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"GMT" (forall a. Num a => a -> a -> a
($+) Int
00 Int
00) Bool
False --  Greenwich Mean Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"FWT" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
False -- French Winter Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"FST" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- French Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"FNT" (forall a. Num a => a -> a -> a
($-) Int
02 Int
00) Bool
False -- Fernando de Noronha Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"FNST" (forall a. Num a => a -> a -> a
($-) Int
01 Int
00) Bool
False -- Fernando de Noronha Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"EST" (forall a. Num a => a -> a -> a
($-) Int
05 Int
00) Bool
False -- Eastern Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"EETDST" (forall a. Num a => a -> a -> a
($+) Int
03 Int
00) Bool
True -- Eastern Europe Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"EET" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
False -- Eastern European Time, Russia zone 1
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"EDT" (forall a. Num a => a -> a -> a
($-) Int
04 Int
00) Bool
True -- Eastern Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"EAT" (forall a. Num a => a -> a -> a
($+) Int
03 Int
00) Bool
False -- Antananarivo, Comoro Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"EAST" (forall a. Num a => a -> a -> a
($+) Int
10 Int
00) Bool
False -- East Australian Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"EAST" (forall a. Num a => a -> a -> a
($+) Int
04 Int
00) Bool
False -- Antananarivo Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"DNT" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- Dansk Normal Tid
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CXT" (forall a. Num a => a -> a -> a
($+) Int
07 Int
00) Bool
False -- Christmas (Island) Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CST" (forall a. Num a => a -> a -> a
($-) Int
06 Int
00) Bool
False -- Central Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CETDST" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
True -- Central European Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CET" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- Central European Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CEST" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
False -- Central European Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CDT" (forall a. Num a => a -> a -> a
($-) Int
05 Int
00) Bool
True -- Central Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CCT" (forall a. Num a => a -> a -> a
($+) Int
08 Int
00) Bool
False -- China Coastal Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CAT" (forall a. Num a => a -> a -> a
($-) Int
10 Int
00) Bool
False -- Central Alaska Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CAST" (forall a. Num a => a -> a -> a
($+) Int
09 Int
30) Bool
False -- Central Australia Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"CADT" (forall a. Num a => a -> a -> a
($+) Int
10 Int
30) Bool
True -- Central Australia Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"BT" (forall a. Num a => a -> a -> a
($+) Int
03 Int
00) Bool
False -- Baghdad Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"BST" (forall a. Num a => a -> a -> a
($+) Int
01 Int
00) Bool
False -- British Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"BRT" (forall a. Num a => a -> a -> a
($-) Int
03 Int
00) Bool
False -- Brasilia Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"BRST" (forall a. Num a => a -> a -> a
($-) Int
02 Int
00) Bool
False -- Brasilia Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"BDST" (forall a. Num a => a -> a -> a
($+) Int
02 Int
00) Bool
False -- British Double Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AWT" (forall a. Num a => a -> a -> a
($-) Int
03 Int
00) Bool
False -- (unknown)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AWST" (forall a. Num a => a -> a -> a
($+) Int
08 Int
00) Bool
False -- Australia Western Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AWSST" (forall a. Num a => a -> a -> a
($+) Int
09 Int
00) Bool
False -- Australia Western Summer Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AST" (forall a. Num a => a -> a -> a
($-) Int
04 Int
00) Bool
False -- Atlantic Standard Time (Canada)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"ALMT" (forall a. Num a => a -> a -> a
($+) Int
06 Int
00) Bool
False -- Almaty Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"ALMST" (forall a. Num a => a -> a -> a
($+) Int
07 Int
00) Bool
False -- Almaty Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AKST" (forall a. Num a => a -> a -> a
($-) Int
09 Int
00) Bool
False -- Alaska Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AKDT" (forall a. Num a => a -> a -> a
($-) Int
08 Int
00) Bool
True -- Alaska Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AHST" (forall a. Num a => a -> a -> a
($-) Int
10 Int
00) Bool
False -- Alaska/Hawaii Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AFT" (forall a. Num a => a -> a -> a
($+) Int
04 Int
30) Bool
False -- Afghanistan Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AEST" (forall a. Num a => a -> a -> a
($+) Int
10 Int
00) Bool
False -- Australia Eastern Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"AESST" (forall a. Num a => a -> a -> a
($+) Int
11 Int
00) Bool
False -- Australia Eastern Summer Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"ADT" (forall a. Num a => a -> a -> a
($-) Int
03 Int
00) Bool
True -- Atlantic Daylight-Saving Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"ACT" (forall a. Num a => a -> a -> a
($-) Int
05 Int
00) Bool
False -- Atlantic/Porto Acre Standard Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"ACST" (forall a. Num a => a -> a -> a
($-) Int
04 Int
00) Bool
False -- Atlantic/Porto Acre Summer Time
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
"ACSST" (forall a. Num a => a -> a -> a
($+) Int
10 Int
30) Bool
False -- Central Australia Summer Standard Time
  where
    zone :: [Char] -> Int -> Bool -> Parser TimeZone
zone [Char]
name Int
offset Bool
dst = Int -> Bool -> [Char] -> TimeZone
TimeZone Int
offset Bool
dst [Char]
name forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
P.string ([Char] -> ByteString
S.pack [Char]
name)
    $+ :: a -> a -> a
($+) a
h a
m = a
h forall a. Num a => a -> a -> a
* a
60 forall a. Num a => a -> a -> a
+ a
m
    $- :: a -> a -> a
($-) a
h a
m = forall a. Num a => a -> a
negate (a
h forall a. Num a => a -> a -> a
* a
60 forall a. Num a => a -> a -> a
+ a
m)

-- -------------------------------------------------------------------------- --
-- Orphan Read Instances

instance Read UTCTime where
    readsPrec :: Int -> ReadS UTCTime
readsPrec Int
_ = forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False forall a b. (a -> b) -> a -> b
$
        forall t. ParseTime t => [Char] -> ReadS t
readsTime [Char]
"%Y-%m-%d %H:%M:%S%Q %Z"
    {-# INLINEABLE readsPrec #-}

-- -------------------------------------------------------------------------- --
-- Orphan Show Instances

instance Show UTCTime where
    showsPrec :: Int -> UTCTime -> ShowS
showsPrec Int
_ = forall t. FormatTime t => [Char] -> t -> ShowS
formatTimeS [Char]
"%Y-%m-%d %H:%M:%S%Q %Z"

instance Show NominalDiffTime where
    showsPrec :: Int -> NominalDiffTime -> ShowS
showsPrec Int
p (NominalDiffTime Micros
a) [Char]
rest = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Micros
a (Char
's' forall a. a -> [a] -> [a]
: [Char]
rest)

-- -------------------------------------------------------------------------- --
-- Orphan Aeson instances

instance ToJSON UTCTime where
    toJSON :: UTCTime -> Value
toJSON UTCTime
t = Text -> Value
String forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => [Char] -> t -> [Char]
formatTime [Char]
"%FT%T%QZ" UTCTime
t
    {-# INLINE toJSON #-}

instance FromJSON UTCTime where
    parseJSON :: Value -> Parser UTCTime
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"UTCTime" forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case [Char] -> [Char] -> Maybe UTCTime
parseTime [Char]
"%FT%T%QZ" (Text -> [Char]
T.unpack Text
t) of
          Just UTCTime
d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
d
          Maybe UTCTime
_      -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"could not parse ISO-8601 date"
    {-# INLINE parseJSON #-}

-- -------------------------------------------------------------------------- --
-- TimeParse Lenses

tpCentury :: Lens' TimeParse Int
tpCentury :: Lens' TimeParse Int
tpCentury = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpCentury (\TimeParse
a Int
b -> TimeParse
a { _tpCentury :: Int
_tpCentury = Int
b })
{-# INLINE tpCentury #-}

tpCenturyYear :: Lens' TimeParse Int
tpCenturyYear :: Lens' TimeParse Int
tpCenturyYear = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpCenturyYear (\TimeParse
a Int
b -> TimeParse
a { _tpCenturyYear :: Int
_tpCenturyYear = Int
b })
{-# INLINE tpCenturyYear #-}

tpMonth :: Lens' TimeParse Int
tpMonth :: Lens' TimeParse Int
tpMonth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpMonth (\TimeParse
a Int
b -> TimeParse
a { _tpMonth :: Int
_tpMonth = Int
b })
{-# INLINE tpMonth #-}

tpWeekOfYear :: Lens' TimeParse Int
tpWeekOfYear :: Lens' TimeParse Int
tpWeekOfYear = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpWeekOfYear (\TimeParse
a Int
b -> TimeParse
a { _tpWeekOfYear :: Int
_tpWeekOfYear = Int
b })
{-# INLINE tpWeekOfYear #-}

tpDayOfMonth :: Lens' TimeParse Int
tpDayOfMonth :: Lens' TimeParse Int
tpDayOfMonth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpDayOfMonth (\TimeParse
a Int
b -> TimeParse
a { _tpDayOfMonth :: Int
_tpDayOfMonth = Int
b })
{-# INLINE tpDayOfMonth #-}

tpDayOfYear :: Lens' TimeParse Int
tpDayOfYear :: Lens' TimeParse Int
tpDayOfYear = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpDayOfYear (\TimeParse
a Int
b -> TimeParse
a { _tpDayOfYear :: Int
_tpDayOfYear = Int
b })
{-# INLINE tpDayOfYear #-}

tpDayOfWeek :: Lens' TimeParse Int
tpDayOfWeek :: Lens' TimeParse Int
tpDayOfWeek = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpDayOfWeek (\TimeParse
a Int
b -> TimeParse
a { _tpDayOfWeek :: Int
_tpDayOfWeek = Int
b })
{-# INLINE tpDayOfWeek #-}

tpFlags :: Lens' TimeParse Int
tpFlags :: Lens' TimeParse Int
tpFlags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpFlags (\TimeParse
a Int
b -> TimeParse
a { _tpFlags :: Int
_tpFlags = Int
b })
{-# INLINE tpFlags #-}

tpHour :: Lens' TimeParse Int
tpHour :: Lens' TimeParse Int
tpHour = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpHour (\TimeParse
a Int
b -> TimeParse
a { _tpHour :: Int
_tpHour = Int
b })
{-# INLINE tpHour #-}

tpMinute :: Lens' TimeParse Int
tpMinute :: Lens' TimeParse Int
tpMinute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpMinute (\TimeParse
a Int
b -> TimeParse
a { _tpMinute :: Int
_tpMinute = Int
b })
{-# INLINE tpMinute #-}

tpSecond :: Lens' TimeParse Int
tpSecond :: Lens' TimeParse Int
tpSecond = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> Int
_tpSecond (\TimeParse
a Int
b -> TimeParse
a { _tpSecond :: Int
_tpSecond = Int
b })
{-# INLINE tpSecond #-}

tpSecFrac :: Lens' TimeParse NominalDiffTime
tpSecFrac :: Lens' TimeParse NominalDiffTime
tpSecFrac = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> NominalDiffTime
_tpSecFrac (\TimeParse
a NominalDiffTime
b -> TimeParse
a { _tpSecFrac :: NominalDiffTime
_tpSecFrac = NominalDiffTime
b })
{-# INLINE tpSecFrac #-}

tpPOSIXTime :: Lens' TimeParse NominalDiffTime
tpPOSIXTime :: Lens' TimeParse NominalDiffTime
tpPOSIXTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> NominalDiffTime
_tpPOSIXTime (\TimeParse
a NominalDiffTime
b -> TimeParse
a { _tpPOSIXTime :: NominalDiffTime
_tpPOSIXTime = NominalDiffTime
b })
{-# INLINE tpPOSIXTime #-}

tpTimeZone :: Lens' TimeParse TimeZone
tpTimeZone :: Lens' TimeParse TimeZone
tpTimeZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TimeParse -> TimeZone
_tpTimeZone (\TimeParse
a TimeZone
b -> TimeParse
a { _tpTimeZone :: TimeZone
_tpTimeZone = TimeZone
b })
{-# INLINE tpTimeZone #-}