{-# language BangPatterns #-}
{-# language CPP #-}
{-# language DeriveGeneric #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language MultiParamTypeClasses #-}
{-# language NumericUnderscores #-}
{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeInType #-}
{-# language UnboxedTuples #-}

{-| Chronos is a performance-oriented time library for Haskell, with a
    straightforward API. The main differences between this
    and the <http://hackage.haskell.org/package/time time> library
    are:

      * Chronos uses machine integers where possible. This means
        that time-related arithmetic should be faster, with the
        drawback that the types are incapable of representing times
        that are very far in the future or the past (because Chronos
        provides nanosecond, rather than picosecond, resolution).
        For most users, this is not a hindrance.
      * Chronos provides 'ToJSON'/'FromJSON' instances for serialisation.
      * Chronos provides 'UVector.Unbox' instances for working with unboxed vectors.
      * Chronos provides 'Prim' instances for working with byte arrays/primitive arrays.
      * Chronos uses normal non-overloaded haskell functions for
        encoding and decoding time. It provides <http://hackage.haskell.org/package/attoparsec attoparsec> parsers for both 'Text' and
        'ByteString'. Additionally, Chronos provides functions for
        encoding time to 'Text' or 'ByteString'. The <http://hackage.haskell.org/package/time time> library accomplishes these with the
        <http://hackage.haskell.org/package/time-1.9.3/docs/Data-Time-Format.html Data.Time.Format> module, which uses UNIX-style datetime
        format strings. The approach taken by Chronos is faster and
        catches more mistakes at compile time, at the cost of being
        less expressive.
 -}

module Chronos
  ( -- * Functions
    -- ** Current
    now
  , today
  , tomorrow
  , yesterday
  , todayDayOfWeek
  , yesterdayDayOfWeek
  , tomorrowDayOfWeek
  , timeToDayOfWeek
  , epoch
    -- ** Duration
  , stopwatch
  , stopwatch_
    -- ** Construction
  , datetimeFromYmdhms
  , timeFromYmdhms
    -- ** Conversion
  , timeToDatetime
  , datetimeToTime
  , datetimeToDayOfWeek
  , dateToDayOfWeek
  , timeToOffsetDatetime
  , offsetDatetimeToTime
  , timeToDayTruncate
  , dayToTimeMidnight
  , dayToDate
  , dateToDay
  , dayToOrdinalDate
  , ordinalDateToDay
  , monthDateToDayOfYear
  , dayOfYearToMonthDay
    -- ** Build Timespan
  , second
  , minute
  , hour
  , day
  , week
    -- ** Matching
  , buildDayOfWeekMatch
  , buildMonthMatch
  , buildUnboxedMonthMatch
  , caseDayOfWeek
  , caseMonth
  , caseUnboxedMonth
    -- ** Format
    -- $format
  , w3c
  , slash
  , hyphen
  , compact
  , timeParts
    -- ** Months
  , january
  , february
  , march
  , april
  , may
  , june
  , july
  , august
  , september
  , october
  , november
  , december
    -- ** Days of Week
  , sunday
  , monday
  , tuesday
  , wednesday
  , thursday
  , friday
  , saturday
    -- ** Utility
  , daysInMonth
  , isLeapYear
  , observedOffsets
    -- * Textual Conversion
    -- ** Date
    -- *** Text
  , builder_Ymd
  , builder_Dmy
  , builder_HMS
  , parser_Ymd
  , parser_Ymd_lenient
  , parser_Mdy
  , parser_Mdy_lenient
  , parser_Dmy
  , parser_Dmy_lenient
    -- *** UTF-8 ByteString
  , builderUtf8_Ymd
  , parserUtf8_Ymd
    -- ** Time of Day
    -- *** Text
  , builder_IMS_p
  , builder_IMSp
  , parser_HMS
  , parser_HMS_opt_S
    -- *** UTF-8 ByteString
  , builderUtf8_HMS
  , builderUtf8_IMS_p
  , builderUtf8_IMSp
  , parserUtf8_HMS
  , parserUtf8_HMS_opt_S
  , zeptoUtf8_HMS
    -- ** Datetime
    -- *** Text
  , builder_DmyHMS
  , builder_DmyIMSp
  , builder_DmyIMS_p
  , builder_YmdHMS
  , builder_YmdIMSp
  , builder_YmdIMS_p
  , builderW3C
  , builderIso8601
  , encodeIso8601
  , encode_Ymd
  , encode_Dmy
  , encode_DmyHMS
  , encode_DmyIMS_p
  , encode_YmdHMS
  , encode_YmdIMS_p
  , parser_DmyHMS
  , parser_DmyHMS_lenient
  , parser_YmdHMS
  , parser_YmdHMS_lenient
  , parser_YmdHMS_opt_S
  , parser_YmdHMS_opt_S_lenient
  , parser_DmyHMS_opt_S
  , parser_DmyHMS_opt_S_lenient
  , parser_MdyHMS
  , parser_MdyHMS_lenient
  , parser_MdyHMS_opt_S
  , parser_MdyHMS_opt_S_lenient
  , parser_lenient
  , decode_DmyHMS
  , decode_DmyHMS_lenient
  , decode_MdyHMS
  , decode_MdyHMS_lenient
  , decode_MdyHMS_opt_S
  , decode_MdyHMS_opt_S_lenient
  , decode_YmdHMS
  , decode_YmdHMS_lenient
  , decode_YmdHMS_opt_S
  , decode_YmdHMS_opt_S_lenient
  , decode_DmyHMS_opt_S
  , decode_DmyHMS_opt_S_lenient
  , decode_lenient
    -- *** UTF-8 ByteString
  , encodeUtf8_YmdHMS
  , encodeUtf8_YmdIMS_p
  , builderUtf8_YmdHMS
  , builderUtf8_YmdIMSp
  , builderUtf8_YmdIMS_p
  , builderUtf8W3C
  , decodeUtf8_YmdHMS
  , decodeUtf8_YmdHMS_opt_S
  , parserUtf8_YmdHMS
  , parserUtf8_YmdHMS_opt_S
  , zeptoUtf8_YmdHMS
    -- *** UTF-8 Bytes
  , boundedBuilderUtf8BytesIso8601Zoneless
  , decodeUtf8BytesIso8601Zoneless
  , decodeUtf8BytesIso8601ZonelessSpaced
    -- *** Short Text
  , decodeShortTextIso8601Zulu
  , decodeShortTextIso8601Zoneless
  , encodeShortTextIso8601Zulu
  , encodeShortTextIso8601Zoneless
    -- ** Offset Datetime
    -- *** Text
  , encode_YmdHMSz
  , encode_DmyHMSz
  , builder_YmdHMSz
  , builder_DmyHMSz
  , parser_YmdHMSz
  , parser_DmyHMSz
  , builder_YmdIMS_p_z
  , builder_DmyIMS_p_z
  , builderW3Cz
    -- *** UTF-8 ByteString
  , builderUtf8_YmdHMSz
  , parserUtf8_YmdHMSz
  , builderUtf8_YmdIMS_p_z
  , builderUtf8W3Cz
    -- *** UTF-8 Bytes
  , parserUtf8BytesIso8601
  , boundedBuilderUtf8BytesIso8601
  , decodeUtf8BytesIso8601
    -- *** ShortText
  , decodeShortTextIso8601
  , encodeShortTextIso8601
    -- ** Offset
    -- *** Text
  , encodeOffset
  , builderOffset
  , decodeOffset
  , parserOffset
    -- *** UTF-8 ByteString
  , encodeOffsetUtf8
  , builderOffsetUtf8
  , decodeOffsetUtf8
  , parserOffsetUtf8
    -- ** Timespan
    -- *** Text
  , encodeTimespan
  , builderTimespan
    -- *** UTF-8 ByteString
  , encodeTimespanUtf8
  , builderTimespanUtf8
    -- ** TimeInterval
  , within
  , timeIntervalToTimespan
  , whole
  , singleton
  , lowerBound
  , upperBound
  , width
  , timeIntervalBuilder
  , (...)
    -- * Types
  , Day(..)
  , DayOfWeek(..)
  , DayOfMonth(..)
  , DayOfYear(..)
  , Month(..)
  , Year(..)
  , Offset(..)
  , Time(..)
  , DayOfWeekMatch(..)
  , MonthMatch(..)
  , UnboxedMonthMatch(..)
  , Timespan(..)
  , SubsecondPrecision(..)
  , Date(..)
  , OrdinalDate(..)
  , MonthDate(..)
  , Datetime(..)
  , OffsetDatetime(..)
  , TimeOfDay(..)
  , DatetimeFormat(..)
  , OffsetFormat(..)
  , DatetimeLocale(..)
  , MeridiemLocale(..)
  , TimeInterval(..)
  , TimeParts(..)
    -- * Lenses
  , _timeToDatetime
  , _datetimeToTime
  , _dayToDate
  , _dateToDay
  , _getDay
  , _getDayOfWeek
  , _getDayOfMonth
  , _getDayOfYear
  , _getMonth
  , _getOffset
  , _getTime
  , _getTimespan
  , _dateYear
  , _dateMonth
  , _dateDay
  , _ordinalDateYear
  , _ordinalDateDayOfYear
  , _monthDateMonth
  , _monthDateDay
  , _datetimeDate
  , _datetimeTime
  , _offsetDatetimeDatetime
  , _offsetDatetimeOffset
  , _timeOfDayHour
  , _timeOfDayMinute
  , _timeOfDayNanoseconds
  ) where

import Control.Applicative
import Control.DeepSeq (NFData(..), deepseq)
import Control.Exception (evaluate)
import Control.Monad
import Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
import Data.Attoparsec.Text (Parser)
import Data.Bool (bool)
import Data.Bytes (Bytes)
import Data.ByteString (ByteString)
import Data.Char (isDigit)
import Data.Foldable
import Data.Hashable (Hashable)
import Data.Int (Int64)
import Data.Primitive
import Data.Text (Text)
import Data.Text.Short (ShortText)
import Data.Vector (Vector)
import Data.Word (Word64, Word8)
import Foreign.Storable
import GHC.Clock (getMonotonicTimeNSec)
import GHC.Generics (Generic)
import Torsor
import qualified Arithmetic.Lte as Lte
import qualified Arithmetic.Nat as Nat
import qualified Data.Aeson as AE
import qualified Data.Aeson.Encoding as AEE
import qualified Data.Aeson.Types as AET
import qualified Data.Attoparsec.ByteString.Char8 as AB
import qualified Data.Attoparsec.Text as AT
import qualified Data.Attoparsec.Zepto as Z
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Builder.Bounded as Bounded
import qualified Data.Bytes.Parser as BVP
import qualified Data.Bytes.Parser.Latin as Latin
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Short.Internal as SBS
import qualified Data.Semigroup as SG
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.Builder.Int as TB
import qualified Data.Text.Read as Text
import qualified Data.Text.Short as TS
import qualified Data.Text.Short.Unsafe as TS
import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as GVector
import qualified Data.Vector.Generic.Mutable as MGVector
import qualified Data.Vector.Primitive as PVector
import qualified Data.Vector.Unboxed as UVector

#ifdef mingw32_HOST_OS
import System.Win32.Time (SYSTEMTIME(..))
import qualified System.Win32.Time as W32
#else
import Chronos.Internal.CTimespec (getPosixNanoseconds)
#endif

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as AK
#endif

-- $setup
-- >>> import Test.QuickCheck hiding (within)
-- >>> import Test.QuickCheck.Gen
-- >>> import Data.Maybe (isJust)
-- >>> :set -XStandaloneDeriving
-- >>> :set -XGeneralizedNewtypeDeriving
-- >>> :set -XScopedTypeVariables
--
-- >>> deriving instance Arbitrary Time
-- >>> :{
--   instance Arbitrary TimeInterval where
--     arbitrary = do
--       t0 <- arbitrary
--       t1 <- suchThat arbitrary (>= t0)
--       pure (TimeInterval t0 t1)
--   instance Arbitrary TimeOfDay where
--     arbitrary = TimeOfDay
--       <$> choose (0,23)
--       <*> choose (0,59)
--       <*> choose (0, 60000000000 - 1)
--   instance Arbitrary Date where
--     arbitrary = Date
--       <$> fmap Year (choose (1800,2100))
--       <*> fmap Month (choose (0,11))
--       <*> fmap DayOfMonth (choose (1,28))
--   instance Arbitrary Datetime where
--     arbitrary = Datetime <$> arbitrary <*> arbitrary
--   instance Arbitrary OffsetDatetime where
--     arbitrary = OffsetDatetime <$> arbitrary <*> arbitrary
--   instance Arbitrary DatetimeFormat where
--     arbitrary = DatetimeFormat
--       <$> arbitrary
--       <*> elements [ Nothing, Just '/', Just ':', Just '-']
--       <*> arbitrary
--   instance Arbitrary OffsetFormat where
--     arbitrary = arbitraryBoundedEnum
--     shrink = genericShrink
--   instance Arbitrary Offset where
--     arbitrary = fmap Offset (choose ((-24) * 60, 24 * 60))
--   instance Arbitrary SubsecondPrecision where
--     arbitrary = frequency
--       [ (1, pure SubsecondPrecisionAuto)
--       , (1, SubsecondPrecisionFixed <$> choose (0,9))
--       ]
--   instance Arbitrary Day where
--     arbitrary = fmap Day (choose (0,50000))
-- :}
--

-- | A 'Timespan' representing a single second.
second :: Timespan
second :: Timespan
second = Int64 -> Timespan
Timespan Int64
1000000000

-- | A 'Timespan' representing a single minute.
minute :: Timespan
minute :: Timespan
minute = Int64 -> Timespan
Timespan Int64
60000000000

-- | A 'Timespan' representing a single hour.
hour :: Timespan
hour :: Timespan
hour = Int64 -> Timespan
Timespan Int64
3600000000000

-- | A 'Timespan' representing a single day.
day :: Timespan
day :: Timespan
day = Int64 -> Timespan
Timespan Int64
86400000000000

-- | A 'Timespan' representing a single week.
week :: Timespan
week :: Timespan
week = Int64 -> Timespan
Timespan Int64
604800000000000

-- | Convert 'Time' to 'Datetime'.
--
--   prop> \(t :: Time) -> (datetimeToTime (timeToDatetime t)) == t
timeToDatetime :: Time -> Datetime
timeToDatetime :: Time -> Datetime
timeToDatetime = UtcTime -> Datetime
utcTimeToDatetime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> UtcTime
toUtc

-- | Convert 'Datetime' to 'Time'.
--
--   prop> \(d :: Datetime) -> timeToDatetime (datetimeToTime d) == d
datetimeToTime :: Datetime -> Time
datetimeToTime :: Datetime -> Time
datetimeToTime = UtcTime -> Time
fromUtc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> UtcTime
datetimeToUtcTime

-- | A lens-compatible variant of half of the `timeToDatetime`/`datetimeToTime` isomorphism.
--
-- __Note__: We do not provide an iso as that requires a dependence on the `profunctor`
-- package.
_timeToDatetime :: forall f . Functor f => (Datetime -> f Datetime) -> Time -> f Time
_timeToDatetime :: forall (f :: * -> *).
Functor f =>
(Datetime -> f Datetime) -> Time -> f Time
_timeToDatetime Datetime -> f Datetime
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Datetime -> Time
datetimeToTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> f Datetime
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Datetime
timeToDatetime

-- | A lens-compatible variant of half of the `timeToDatetime`/`datetimeToTime` isomorphism.
--
-- __Note__: We do not provide an iso as that requires a dependence on the `profunctor`
-- package.
_datetimeToTime :: forall f . Functor f => (Time -> f Time) -> Datetime -> f Datetime
_datetimeToTime :: forall (f :: * -> *).
Functor f =>
(Time -> f Time) -> Datetime -> f Datetime
_datetimeToTime Time -> f Time
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Time -> Datetime
timeToDatetime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> f Time
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> Time
datetimeToTime

-- | Convert 'Datetime' to 'DayOfWeek'
datetimeToDayOfWeek :: Datetime -> DayOfWeek
datetimeToDayOfWeek :: Datetime -> DayOfWeek
datetimeToDayOfWeek (Datetime Date
date TimeOfDay
_) = Date -> DayOfWeek
dateToDayOfWeek Date
date

-- | Convert 'Date' to 'DayOfWeek'
dateToDayOfWeek :: Date -> DayOfWeek
dateToDayOfWeek :: Date -> DayOfWeek
dateToDayOfWeek (Date Year
year Month
month DayOfMonth
date) =
  let k :: Int
k = DayOfMonth -> Int
getDayOfMonth DayOfMonth
date
      m :: Int
m = ((Month -> Int
getMonth Month
month forall a. Num a => a -> a -> a
+ Int
10) forall a. Integral a => a -> a -> a
`mod` Int
12) forall a. Num a => a -> a -> a
+ Int
1
      y :: Int
y = Int
adjustedYear forall a. Integral a => a -> a -> a
`mod` Int
100
      c :: Int
c = Int
adjustedYear forall a. Integral a => a -> a -> a
`div` Int
100
      adjustedYear :: Int
adjustedYear = if Int
m forall a. Ord a => a -> a -> Bool
>= Int
11 then Year -> Int
getYear Year
year forall a. Num a => a -> a -> a
- Int
1 else Year -> Int
getYear Year
year
  in Int -> DayOfWeek
DayOfWeek forall a b. (a -> b) -> a -> b
$ (Int
k forall a. Num a => a -> a -> a
+ (forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ ((Double
2.6 :: Double) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) forall a. Num a => a -> a -> a
- Double
0.2) forall a. Num a => a -> a -> a
- (Int
2forall a. Num a => a -> a -> a
*Int
c) forall a. Num a => a -> a -> a
+ Int
y forall a. Num a => a -> a -> a
+ (Int
y forall a. Integral a => a -> a -> a
`div` Int
4) forall a. Num a => a -> a -> a
+ (Int
c forall a. Integral a => a -> a -> a
`div` Int
4)) forall a. Integral a => a -> a -> a
`mod` Int
7

-- | Convert 'Time' to 'OffsetDatetime' by providing an 'Offset'.
timeToOffsetDatetime :: Offset -> Time -> OffsetDatetime
timeToOffsetDatetime :: Offset -> Time -> OffsetDatetime
timeToOffsetDatetime Offset
offset = Offset -> UtcTime -> OffsetDatetime
utcTimeToOffsetDatetime Offset
offset forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> UtcTime
toUtc

-- | Convert 'OffsetDatetime' to 'Time'.
offsetDatetimeToTime :: OffsetDatetime -> Time
offsetDatetimeToTime :: OffsetDatetime -> Time
offsetDatetimeToTime = UtcTime -> Time
fromUtc forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetDatetime -> UtcTime
offsetDatetimeToUtcTime

-- | Convert 'Time' to 'Day'. This function is lossy; consequently, it
--   does not roundtrip with 'dayToTimeMidnight'.
timeToDayTruncate :: Time -> Day
timeToDayTruncate :: Time -> Day
timeToDayTruncate (Time Int64
i) = Int -> Day
Day (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Integral a => a -> a -> a
div Int64
i Int64
86400000000000) forall a. Num a => a -> a -> a
+ Int
40587)

-- | Convert midnight of the given 'Day' to 'Time'.
dayToTimeMidnight :: Day -> Time
dayToTimeMidnight :: Day -> Time
dayToTimeMidnight (Day Int
d) = Int64 -> Time
Time (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
d forall a. Num a => a -> a -> a
- Int
40587) forall a. Num a => a -> a -> a
* Int64
86400000000000)

-- | Convert 'Day' to a 'Date'.
--
--   prop> \(d :: Day) -> dateToDay (dayToDate d) == d
dayToDate :: Day -> Date
dayToDate :: Day -> Date
dayToDate Day
theDay = Year -> Month -> DayOfMonth -> Date
Date Year
year Month
month DayOfMonth
dayOfMonth
  where
  OrdinalDate Year
year DayOfYear
yd = Day -> OrdinalDate
dayToOrdinalDate Day
theDay
  MonthDate Month
month DayOfMonth
dayOfMonth = Bool -> DayOfYear -> MonthDate
dayOfYearToMonthDay (Year -> Bool
isLeapYear Year
year) DayOfYear
yd

-- | Convert a 'Date' to a 'Day'.
--
--   prop> \(d :: Date) -> dayToDate (dateToDay d) == d
dateToDay :: Date -> Day
dateToDay :: Date -> Day
dateToDay (Date Year
y Month
m DayOfMonth
d) = OrdinalDate -> Day
ordinalDateToDay forall a b. (a -> b) -> a -> b
$ Year -> DayOfYear -> OrdinalDate
OrdinalDate Year
y
  (Bool -> MonthDate -> DayOfYear
monthDateToDayOfYear (Year -> Bool
isLeapYear Year
y) (Month -> DayOfMonth -> MonthDate
MonthDate Month
m DayOfMonth
d))

-- | A lens-compatible variant of half of the `dayToDate`/`dateToDay` isomorphism.
--
-- __Note__: We do not provide an iso as that requires a dependence on the `profunctor`
-- package.
_dayToDate :: forall f . Functor f => (Date -> f Date) -> Day -> f Day
_dayToDate :: forall (f :: * -> *). Functor f => (Date -> f Date) -> Day -> f Day
_dayToDate Date -> f Date
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Date -> Day
dateToDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> f Date
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Date
dayToDate

-- | A lens-compatible variant of half of the `dayToDate`/`dateToDay` isomorphism.
--
-- __Note__: We do not provide an iso as that requires a dependence on the `profunctor`
-- package.
_dateToDay :: forall f . Functor f => (Day -> f Day) -> Date -> f Date
_dateToDay :: forall (f :: * -> *). Functor f => (Day -> f Day) -> Date -> f Date
_dateToDay Day -> f Day
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> Date
dayToDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> f Day
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Day
dateToDay

-- | Construct a 'Datetime' from year, month, day, hour, minute, second:
--
--   >>> datetimeFromYmdhms 2014 2 26 17 58 52
--   Datetime {datetimeDate = Date {dateYear = Year {getYear = 2014}, dateMonth = Month {getMonth = 1}, dateDay = DayOfMonth {getDayOfMonth = 26}}, datetimeTime = TimeOfDay {timeOfDayHour = 17, timeOfDayMinute = 58, timeOfDayNanoseconds = 52000000000}}
datetimeFromYmdhms ::
     Int -- ^ Year
  -> Int -- ^ Month
  -> Int -- ^ Day
  -> Int -- ^ Hour
  -> Int -- ^ Minute
  -> Int -- ^ Second
  -> Datetime
datetimeFromYmdhms :: Int -> Int -> Int -> Int -> Int -> Int -> Datetime
datetimeFromYmdhms Int
y Int
m Int
d Int
h Int
m' Int
s = Date -> TimeOfDay -> Datetime
Datetime
  (Year -> Month -> DayOfMonth -> Date
Date
     (Int -> Year
Year forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
     (Int -> Month
Month Int
mx)
     (Int -> DayOfMonth
DayOfMonth forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
  )
  (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay
     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m')
     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s forall a. Num a => a -> a -> a
* Int64
1000000000)
  )
  where
  mx :: Int
mx = if Int
m forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
m forall a. Ord a => a -> a -> Bool
<= Int
12
    then forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
m forall a. Num a => a -> a -> a
- Int
1)
    else Int
0

-- | Construct a 'Time' from year, month, day, hour, minute, second:
--
--   >>> timeFromYmdhms 2014 2 26 17 58 52
--   Time {getTime = 1393437532000000000}
timeFromYmdhms ::
     Int -- ^ Year
  -> Int -- ^ Month
  -> Int -- ^ Day
  -> Int -- ^ Hour
  -> Int -- ^ Minute
  -> Int -- ^ Second
  -> Time
timeFromYmdhms :: Int -> Int -> Int -> Int -> Int -> Int -> Time
timeFromYmdhms Int
y Int
m Int
d Int
h Int
m' Int
s = Datetime -> Time
datetimeToTime (Int -> Int -> Int -> Int -> Int -> Int -> Datetime
datetimeFromYmdhms Int
y Int
m Int
d Int
h Int
m' Int
s)

-- | Gets the current 'Day'. This does not take the user\'s
--   time zone into account.
today :: IO Day
today :: IO Day
today = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Time -> Day
timeToDayTruncate IO Time
now

-- | Gets the 'Day' of tomorrow.
tomorrow :: IO Day
tomorrow :: IO Day
tomorrow = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall p v. Torsor p v => v -> p -> p
add Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Day
timeToDayTruncate) IO Time
now

-- | Gets the 'Day' of yesterday.
yesterday :: IO Day
yesterday :: IO Day
yesterday = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall p v. Torsor p v => v -> p -> p
add (-Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Day
timeToDayTruncate) IO Time
now

-- | Get the current time from the system clock.
now :: IO Time
#ifdef mingw32_HOST_OS
now = do
  SYSTEMTIME{..} <- W32.getSystemTime
  let date = Date
        { dateYear  = Year       (fromIntegral wYear)
        , dateMonth = Month      (fromIntegral wMonth - 1)
        , dateDay   = DayOfMonth (fromIntegral wDay)
        }
  let secNano = (fromIntegral wSecond :: Int64) * 1000000000
      msNano  = (fromIntegral wMilliseconds :: Int64) * 1000000
      nano    = secNano + msNano
  let time = TimeOfDay
        { timeOfDayHour        = fromIntegral wHour
        , timeOfDayMinute      = fromIntegral wMinute
        , timeOfDayNanoseconds = fromIntegral nano
        }
  let dt = Datetime date time
  pure $ datetimeToTime dt
#else
now :: IO Time
now = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Time
Time IO Int64
getPosixNanoseconds
#endif

-- | Convert from 'Time' to 'DayOfWeek'.
timeToDayOfWeek :: Time -> DayOfWeek
timeToDayOfWeek :: Time -> DayOfWeek
timeToDayOfWeek (Time Int64
time) = Int -> DayOfWeek
DayOfWeek forall a b. (a -> b) -> a -> b
$
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Int ((Int64
time forall a. Integral a => a -> a -> a
`div` Int64
86400000000000) forall a. Num a => a -> a -> a
+ Int64
4) forall a. Integral a => a -> a -> a
`mod` Int
7)

-- | Get the current 'DayOfWeek' from the system clock.
todayDayOfWeek :: IO DayOfWeek
todayDayOfWeek :: IO DayOfWeek
todayDayOfWeek = Time -> DayOfWeek
timeToDayOfWeek forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Time
now

-- | Get the yesterday\'s 'DayOfWeek' from the system clock.
yesterdayDayOfWeek :: IO DayOfWeek
yesterdayDayOfWeek :: IO DayOfWeek
yesterdayDayOfWeek =
  Time -> DayOfWeek
timeToDayOfWeek forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall p v. Torsor p v => v -> p -> p
add (Int64 -> Timespan
Timespan (-Int64
86400000000000))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Time
now

-- | Get the tomorrow\'s 'DayOfWeek' from the system clock.
tomorrowDayOfWeek :: IO DayOfWeek
tomorrowDayOfWeek :: IO DayOfWeek
tomorrowDayOfWeek =
  Time -> DayOfWeek
timeToDayOfWeek forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall p v. Torsor p v => v -> p -> p
add (Int64 -> Timespan
Timespan (Int64
86400000000000))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Time
now

-- | The Unix epoch, that is 1970-01-01 00:00:00.
epoch :: Time
epoch :: Time
epoch = Int64 -> Time
Time Int64
0

-- | Measures the time it takes to run an action and evaluate
--   its result to WHNF. This measurement uses a monotonic clock
--   instead of the standard system clock.
stopwatch :: IO a -> IO (Timespan, a)
stopwatch :: forall a. IO a -> IO (Timespan, a)
stopwatch IO a
action = do
  Word64
start <- IO Word64
getMonotonicTimeNSec
  a
a <- IO a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
evaluate
  Word64
end <- IO Word64
getMonotonicTimeNSec
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int64 -> Timespan
Timespan (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
end forall a. Num a => a -> a -> a
- Word64
start))), a
a)

-- | Measures the time it takes to run an action. The result
--   is discarded. This measurement uses a monotonic clock
--   instead of the standard system clock.
stopwatch_ :: IO a -> IO Timespan
stopwatch_ :: forall a. IO a -> IO Timespan
stopwatch_ IO a
action = do
  Word64
start <- IO Word64
getMonotonicTimeNSec
  a
_ <- IO a
action
  Word64
end <- IO Word64
getMonotonicTimeNSec
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Timespan
Timespan (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
end forall a. Num a => a -> a -> a
- Word64
start)))

-- UtcTime. Used internally only.
data UtcTime = UtcTime
  {-# UNPACK #-} !Day -- day
  {-# UNPACK #-} !Int64 -- nanoseconds

toUtc :: Time -> UtcTime
toUtc :: Time -> UtcTime
toUtc (Time Int64
i) = let (Int64
d,Int64
t) = forall a. Integral a => a -> a -> (a, a)
divMod Int64
i (Timespan -> Int64
getTimespan Timespan
day)
 in Day -> Int64 -> UtcTime
UtcTime (forall p v. Torsor p v => v -> p -> p
add (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
d) Day
epochDay) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
t)

fromUtc :: UtcTime -> Time
fromUtc :: UtcTime -> Time
fromUtc (UtcTime Day
d Int64
ns') = Int64 -> Time
Time forall a b. (a -> b) -> a -> b
$ Timespan -> Int64
getTimespan forall a b. (a -> b) -> a -> b
$ forall v. Additive v => v -> v -> v
plus
  (forall v s. Scaling v s => s -> v -> v
scale (Int -> Int64
intToInt64 (forall p v. Torsor p v => p -> p -> v
difference Day
d Day
epochDay)) Timespan
day)
  (if Timespan
ns forall a. Ord a => a -> a -> Bool
> Timespan
day then Timespan
day else Timespan
ns)
  where ns :: Timespan
ns = Int64 -> Timespan
Timespan Int64
ns'

intToInt64 :: Int -> Int64
intToInt64 :: Int -> Int64
intToInt64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral

epochDay :: Day
epochDay :: Day
epochDay = Int -> Day
Day Int
40587

dayLengthInt64 :: Int64
dayLengthInt64 :: Int64
dayLengthInt64 = Timespan -> Int64
getTimespan Timespan
day

nanosecondsInMinute :: Int64
nanosecondsInMinute :: Int64
nanosecondsInMinute = Int64
60000000000

-- | All UTC time offsets. See <https://en.wikipedia.org/wiki/List_of_UTC_time_offsets List of UTC time offsets>.
observedOffsets :: Vector Offset
observedOffsets :: Vector Offset
observedOffsets = forall a. [a] -> Vector a
Vector.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> Offset
Offset
  [ -Int
1200
  , -Int
1100
  , -Int
1000
  , -Int
930
  , -Int
900
  , -Int
800
  , -Int
700
  , -Int
600
  , -Int
500
  , -Int
400
  , -Int
330
  , -Int
300
  , -Int
230
  , -Int
200
  , -Int
100
  , Int
0
  , Int
100
  , Int
200
  , Int
300
  , Int
330
  , Int
400
  , Int
430
  , Int
500
  , Int
530
  , Int
545
  , Int
600
  , Int
630
  , Int
700
  , Int
800
  , Int
845
  , Int
900
  , Int
930
  , Int
1000
  , Int
1030
  , Int
1100
  , Int
1200
  , Int
1245
  , Int
1300
  , Int
1345
  , Int
1400
  ]

-- | The first argument in the resulting tuple in a day
--   adjustment. It should be either -1, 0, or 1, as no
--   offset should ever exceed 24 hours.
offsetTimeOfDay :: Offset -> TimeOfDay -> (Int, TimeOfDay)
offsetTimeOfDay :: Offset -> TimeOfDay -> (Int, TimeOfDay)
offsetTimeOfDay (Offset Int
offset) (TimeOfDay Int
h Int
m Int64
s) =
  (Int
dayAdjustment,Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h'' Int
m'' Int64
s)
  where
  (!Int
dayAdjustment, !Int
h'') = forall a. Integral a => a -> a -> (a, a)
divMod Int
h' Int
24
  (!Int
hourAdjustment, !Int
m'') = forall a. Integral a => a -> a -> (a, a)
divMod Int
m' Int
60
  m' :: Int
m' = Int
m forall a. Num a => a -> a -> a
+ Int
offset
  h' :: Int
h' = Int
h forall a. Num a => a -> a -> a
+ Int
hourAdjustment

nanosecondsSinceMidnightToTimeOfDay :: Int64 -> TimeOfDay
nanosecondsSinceMidnightToTimeOfDay :: Int64 -> TimeOfDay
nanosecondsSinceMidnightToTimeOfDay Int64
ns =
  if Int64
ns forall a. Ord a => a -> a -> Bool
>= Int64
dayLengthInt64
    then Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
23 Int
59 (Int64
nanosecondsInMinute forall a. Num a => a -> a -> a
+ (Int64
ns forall a. Num a => a -> a -> a
- Int64
dayLengthInt64))
    else Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h' Int
m' Int64
ns'
  where
  (!Int64
mInt64,!Int64
ns') = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
ns Int64
nanosecondsInMinute
  !m :: Int
m = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
mInt64
  (!Int
h',!Int
m')  = forall a. Integral a => a -> a -> (a, a)
quotRem Int
m Int
60

timeOfDayToNanosecondsSinceMidnight :: TimeOfDay -> Int64
timeOfDayToNanosecondsSinceMidnight :: TimeOfDay -> Int64
timeOfDayToNanosecondsSinceMidnight (TimeOfDay Int
h Int
m Int64
ns) =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h forall a. Num a => a -> a -> a
* Int64
3600000000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
* Int64
60000000000 forall a. Num a => a -> a -> a
+ Int64
ns

-- datetimeToOffsetDatetime :: Offset -> Datetime -> OffsetDatetime
-- datetimeToOffsetDatetime offset

utcTimeToOffsetDatetime :: Offset -> UtcTime -> OffsetDatetime
utcTimeToOffsetDatetime :: Offset -> UtcTime -> OffsetDatetime
utcTimeToOffsetDatetime Offset
offset (UtcTime (Day Int
d) Int64
nanoseconds) =
  let (!Int
dayAdjustment,!TimeOfDay
tod) = Offset -> TimeOfDay -> (Int, TimeOfDay)
offsetTimeOfDay Offset
offset (Int64 -> TimeOfDay
nanosecondsSinceMidnightToTimeOfDay Int64
nanoseconds)
      !date :: Date
date = Day -> Date
dayToDate (Int -> Day
Day (Int
d forall a. Num a => a -> a -> a
+ Int
dayAdjustment))
   in Datetime -> Offset -> OffsetDatetime
OffsetDatetime (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
tod) Offset
offset

utcTimeToDatetime :: UtcTime -> Datetime
utcTimeToDatetime :: UtcTime -> Datetime
utcTimeToDatetime (UtcTime Day
d Int64
nanoseconds) =
  let !tod :: TimeOfDay
tod = Int64 -> TimeOfDay
nanosecondsSinceMidnightToTimeOfDay Int64
nanoseconds
      !date :: Date
date = Day -> Date
dayToDate Day
d
   in Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
tod

datetimeToUtcTime :: Datetime -> UtcTime
datetimeToUtcTime :: Datetime -> UtcTime
datetimeToUtcTime (Datetime Date
date TimeOfDay
timeOfDay) =
  Day -> Int64 -> UtcTime
UtcTime (Date -> Day
dateToDay Date
date) (TimeOfDay -> Int64
timeOfDayToNanosecondsSinceMidnight TimeOfDay
timeOfDay)

offsetDatetimeToUtcTime :: OffsetDatetime -> UtcTime
offsetDatetimeToUtcTime :: OffsetDatetime -> UtcTime
offsetDatetimeToUtcTime (OffsetDatetime (Datetime Date
date TimeOfDay
timeOfDay) (Offset Int
off)) =
  let (!Int
dayAdjustment,!TimeOfDay
tod) = Offset -> TimeOfDay -> (Int, TimeOfDay)
offsetTimeOfDay (Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Int
off) TimeOfDay
timeOfDay
      !(Day !Int
theDay) = Date -> Day
dateToDay Date
date
   in Day -> Int64 -> UtcTime
UtcTime
        (Int -> Day
Day (Int
theDay forall a. Num a => a -> a -> a
+ Int
dayAdjustment))
        (TimeOfDay -> Int64
timeOfDayToNanosecondsSinceMidnight TimeOfDay
tod)

-- | Convert a 'MonthDate' to a 'DayOfYear'.
monthDateToDayOfYear ::
     Bool -- ^ Is it a leap year?
  -> MonthDate
  -> DayOfYear
monthDateToDayOfYear :: Bool -> MonthDate -> DayOfYear
monthDateToDayOfYear Bool
isLeap (MonthDate month :: Month
month@(Month Int
m) (DayOfMonth Int
dayOfMonth)) =
  Int -> DayOfYear
DayOfYear ((forall a. Integral a => a -> a -> a
div (Int
367 forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
+ Int
1) 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
day')
  where
  day' :: Int
day' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall t. Ord t => t -> t -> t -> t
clip Int
1 (Bool -> Month -> Int
daysInMonth Bool
isLeap Month
month) Int
dayOfMonth
  k :: Int
k = if Month
month forall a. Ord a => a -> a -> Bool
< Int -> Month
Month Int
2 then Int
0 else if Bool
isLeap then -Int
1 else -Int
2

-- | Convert an 'OrdinalDate' to a 'Day'.
ordinalDateToDay :: OrdinalDate -> Day
ordinalDateToDay :: OrdinalDate -> Day
ordinalDateToDay (OrdinalDate year :: Year
year@(Year Int
y') DayOfYear
theDay) = Int -> Day
Day Int
mjd where
  y :: Int
y = Int
y' forall a. Num a => a -> a -> a
- Int
1
  mjd :: Int
mjd = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfYear -> Int
getDayOfYear forall a b. (a -> b) -> a -> b
$
           (forall t. Ord t => t -> t -> t -> t
clip (Int -> DayOfYear
DayOfYear Int
1) (if Year -> Bool
isLeapYear Year
year then Int -> DayOfYear
DayOfYear Int
366 else Int -> DayOfYear
DayOfYear Int
365) DayOfYear
theDay)
        )
      forall a. Num a => a -> a -> a
+ (Int
365 forall a. Num a => a -> a -> a
* Int
y)
      forall a. Num a => a -> a -> a
+ (forall a. Integral a => a -> a -> a
div Int
y Int
4) forall a. Num a => a -> a -> a
- (forall a. Integral a => a -> a -> a
div Int
y Int
100)
      forall a. Num a => a -> a -> a
+ (forall a. Integral a => a -> a -> a
div Int
y Int
400) forall a. Num a => a -> a -> a
- Int
678576

-- | Is the 'Year' a leap year?
--
--   >>> isLeapYear (Year 1996)
--   True
--
--   >>> isLeapYear (Year 2019)
--   False
isLeapYear :: Year -> Bool
isLeapYear :: Year -> Bool
isLeapYear (Year Int
year) = (forall a. Integral a => a -> a -> a
mod Int
year Int
4 forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
&& ((forall a. Integral a => a -> a -> a
mod Int
year Int
400 forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Integral a => a -> a -> a
mod Int
year Int
100 forall a. Eq a => a -> a -> Bool
== Int
0))

-- | Convert a 'DayOfYear' to a 'MonthDate'.
dayOfYearToMonthDay ::
     Bool -- ^ Is it a leap year?
  -> DayOfYear
  -> MonthDate
dayOfYearToMonthDay :: Bool -> DayOfYear -> MonthDate
dayOfYearToMonthDay Bool
isLeap DayOfYear
dayOfYear =
  let (!DayOfYear
doyUpperBound,!Vector Month
monthTable,!Vector DayOfMonth
dayTable) =
        if Bool
isLeap
          then (Int -> DayOfYear
DayOfYear Int
366, Vector Month
leapYearDayOfYearMonthTable, Vector DayOfMonth
leapYearDayOfYearDayOfMonthTable)
          else (Int -> DayOfYear
DayOfYear Int
365, Vector Month
normalYearDayOfYearMonthTable, Vector DayOfMonth
normalYearDayOfYearDayOfMonthTable)
      DayOfYear Int
clippedDay = forall t. Ord t => t -> t -> t -> t
clip (Int -> DayOfYear
DayOfYear Int
1) DayOfYear
doyUpperBound DayOfYear
dayOfYear
      clippedDayInt :: Int
clippedDayInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
clippedDay :: Int
      month :: Month
month = forall a. Unbox a => Vector a -> Int -> a
UVector.unsafeIndex Vector Month
monthTable Int
clippedDayInt
      theDay :: DayOfMonth
theDay = forall a. Unbox a => Vector a -> Int -> a
UVector.unsafeIndex Vector DayOfMonth
dayTable Int
clippedDayInt
   in Month -> DayOfMonth -> MonthDate
MonthDate Month
month DayOfMonth
theDay

-- | Convert a 'Day' to an 'OrdinalDate'.
dayToOrdinalDate :: Day -> OrdinalDate
dayToOrdinalDate :: Day -> OrdinalDate
dayToOrdinalDate (Day Int
mjd) = Year -> DayOfYear -> OrdinalDate
OrdinalDate (Int -> Year
Year forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
year) (Int -> DayOfYear
DayOfYear forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
yd) where
  a :: Int64
a = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mjd :: Int64) forall a. Num a => a -> a -> a
+ Int64
678575
  quadcent :: Int64
quadcent = forall a. Integral a => a -> a -> a
div Int64
a Int64
146097
  b :: Int64
b = forall a. Integral a => a -> a -> a
mod Int64
a Int64
146097
  cent :: Int64
cent = forall a. Ord a => a -> a -> a
min (forall a. Integral a => a -> a -> a
div Int64
b Int64
36524) Int64
3
  c :: Int64
c = Int64
b forall a. Num a => a -> a -> a
- (Int64
cent forall a. Num a => a -> a -> a
* Int64
36524)
  quad :: Int64
quad = forall a. Integral a => a -> a -> a
div Int64
c Int64
1461
  d :: Int64
d = forall a. Integral a => a -> a -> a
mod Int64
c Int64
1461
  y :: Int64
y = forall a. Ord a => a -> a -> a
min (forall a. Integral a => a -> a -> a
div Int64
d Int64
365) Int64
3
  yd :: Int64
yd = (Int64
d forall a. Num a => a -> a -> a
- (Int64
y forall a. Num a => a -> a -> a
* Int64
365) forall a. Num a => a -> a -> a
+ Int64
1)
  year :: Int64
year = Int64
quadcent forall a. Num a => a -> a -> a
* Int64
400 forall a. Num a => a -> a -> a
+ Int64
cent forall a. Num a => a -> a -> a
* Int64
100 forall a. Num a => a -> a -> a
+ Int64
quad forall a. Num a => a -> a -> a
* Int64
4 forall a. Num a => a -> a -> a
+ Int64
y forall a. Num a => a -> a -> a
+ Int64
1

{- $format

The formats provided is this module are language-agnostic.
To find meridiem formats and month formats, look in a
language-specific module.

-}

-- | The W3C 'DatetimeFormat'.
--
--   >>> encode_YmdHMS SubsecondPrecisionAuto w3c (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))
--   "2014-02-26T17:58:52"
--
--  prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS w3c (encode_YmdHMS s w3c dt))
w3c :: DatetimeFormat
w3c :: DatetimeFormat
w3c = Maybe Char -> Maybe Char -> Maybe Char -> DatetimeFormat
DatetimeFormat (forall a. a -> Maybe a
Just Char
'-') (forall a. a -> Maybe a
Just Char
'T') (forall a. a -> Maybe a
Just Char
':')

-- | A 'DatetimeFormat' that separates the members of
--   the 'Date' by slashes.
--
--   >>> encode_YmdHMS SubsecondPrecisionAuto slash (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))
--   "2014/02/26 17:58:52"
--
--   prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS slash (encode_YmdHMS s slash dt))
slash :: DatetimeFormat
slash :: DatetimeFormat
slash = Maybe Char -> Maybe Char -> Maybe Char -> DatetimeFormat
DatetimeFormat (forall a. a -> Maybe a
Just Char
'/') (forall a. a -> Maybe a
Just Char
' ') (forall a. a -> Maybe a
Just Char
':')

-- | A 'DatetimeFormat' that separates the members of
--   the 'Date' by hyphens.
--
--   >>> encode_YmdHMS SubsecondPrecisionAuto hyphen (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))
--   "2014-02-26 17:58:52"
--
--   prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS hyphen (encode_YmdHMS s hyphen dt))
hyphen :: DatetimeFormat
hyphen :: DatetimeFormat
hyphen = Maybe Char -> Maybe Char -> Maybe Char -> DatetimeFormat
DatetimeFormat (forall a. a -> Maybe a
Just Char
'-') (forall a. a -> Maybe a
Just Char
' ') (forall a. a -> Maybe a
Just Char
':')

-- | A 'DatetimeFormat' with no separators, except for a
--   `T` between the 'Date' and 'Time'.
--
--   >>> encode_YmdHMS SubsecondPrecisionAuto compact (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))
--   "20140226T175852"
--
--   prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS compact (encode_YmdHMS s compact dt))
compact :: DatetimeFormat
compact :: DatetimeFormat
compact = Maybe Char -> Maybe Char -> Maybe Char -> DatetimeFormat
DatetimeFormat forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Char
'T') forall a. Maybe a
Nothing

-- | Return the number of days in a given month.
daysInMonth ::
     Bool -- ^ Is this a leap year?
  -> Month -- ^ Month of year
  -> Int
daysInMonth :: Bool -> Month -> Int
daysInMonth Bool
isLeap Month
m = if Bool
isLeap
  then forall a. MonthMatch a -> Month -> a
caseMonth MonthMatch Int
leapYearMonthLength Month
m
  else forall a. MonthMatch a -> Month -> a
caseMonth MonthMatch Int
normalYearMonthLength Month
m

leapYearMonthLength :: MonthMatch Int
leapYearMonthLength :: MonthMatch Int
leapYearMonthLength = forall a.
a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> MonthMatch a
buildMonthMatch Int
31 Int
29 Int
31 Int
30 Int
31 Int
30 Int
31 Int
31 Int
30 Int
31 Int
30 Int
31

normalYearMonthLength :: MonthMatch Int
normalYearMonthLength :: MonthMatch Int
normalYearMonthLength = forall a.
a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> MonthMatch a
buildMonthMatch Int
31 Int
28 Int
31 Int
30 Int
31 Int
30 Int
31 Int
31 Int
30 Int
31 Int
30 Int
31

leapYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth
leapYearDayOfYearDayOfMonthTable :: Vector DayOfMonth
leapYearDayOfYearDayOfMonthTable = forall a. Unbox a => [a] -> Vector a
UVector.fromList forall a b. (a -> b) -> a -> b
$ (Int -> DayOfMonth
DayOfMonth Int
1forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
29)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
30)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
30)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
30)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
30)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  ]
{-# NOINLINE leapYearDayOfYearDayOfMonthTable #-}

normalYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth
normalYearDayOfYearDayOfMonthTable :: Vector DayOfMonth
normalYearDayOfYearDayOfMonthTable = forall a. Unbox a => [a] -> Vector a
UVector.fromList forall a b. (a -> b) -> a -> b
$ (Int -> DayOfMonth
DayOfMonth Int
1forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
28)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
30)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
30)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
30)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
30)
  , forall a. Enum a => a -> a -> [a]
enumFromTo (Int -> DayOfMonth
DayOfMonth Int
1) (Int -> DayOfMonth
DayOfMonth Int
31)
  ]
{-# NOINLINE normalYearDayOfYearDayOfMonthTable #-}

leapYearDayOfYearMonthTable :: UVector.Vector Month
leapYearDayOfYearMonthTable :: Vector Month
leapYearDayOfYearMonthTable = forall a. Unbox a => [a] -> Vector a
UVector.fromList forall a b. (a -> b) -> a -> b
$ (Int -> Month
Month Int
0forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
0)
  , forall a. Int -> a -> [a]
replicate Int
29 (Int -> Month
Month Int
1)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
2)
  , forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
3)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
4)
  , forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
5)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
6)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
7)
  , forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
8)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
9)
  , forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
10)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
11)
  ]
{-# NOINLINE leapYearDayOfYearMonthTable #-}

normalYearDayOfYearMonthTable :: UVector.Vector Month
normalYearDayOfYearMonthTable :: Vector Month
normalYearDayOfYearMonthTable = forall a. Unbox a => [a] -> Vector a
UVector.fromList forall a b. (a -> b) -> a -> b
$ (Int -> Month
Month Int
0forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
0)
  , forall a. Int -> a -> [a]
replicate Int
28 (Int -> Month
Month Int
1)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
2)
  , forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
3)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
4)
  , forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
5)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
6)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
7)
  , forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
8)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
9)
  , forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
10)
  , forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
11)
  ]
{-# NOINLINE normalYearDayOfYearMonthTable #-}

-- | Build a 'MonthMatch' from twelve (12) values.
buildMonthMatch :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> MonthMatch a
buildMonthMatch :: forall a.
a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> MonthMatch a
buildMonthMatch a
a a
b a
c a
d a
e a
f a
g a
h a
i a
j a
k a
l =
  forall a. Vector a -> MonthMatch a
MonthMatch (forall a. Int -> [a] -> Vector a
Vector.fromListN Int
12 [a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i,a
j,a
k,a
l])

-- | Match a 'Month' against a 'MonthMatch'.
caseMonth :: MonthMatch a -> Month -> a
caseMonth :: forall a. MonthMatch a -> Month -> a
caseMonth (MonthMatch Vector a
v) (Month Int
ix) = forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector a
v Int
ix

-- | Build an 'UnboxedMonthMatch' from twelve (12) values.
buildUnboxedMonthMatch :: UVector.Unbox a => a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> UnboxedMonthMatch a
buildUnboxedMonthMatch :: forall a.
Unbox a =>
a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> UnboxedMonthMatch a
buildUnboxedMonthMatch a
a a
b a
c a
d a
e a
f a
g a
h a
i a
j a
k a
l =
  forall a. Vector a -> UnboxedMonthMatch a
UnboxedMonthMatch (forall a. Unbox a => Int -> [a] -> Vector a
UVector.fromListN Int
12 [a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i,a
j,a
k,a
l])

-- | Match a 'Month' against an 'UnboxedMonthMatch'.
caseUnboxedMonth :: UVector.Unbox a => UnboxedMonthMatch a -> Month -> a
caseUnboxedMonth :: forall a. Unbox a => UnboxedMonthMatch a -> Month -> a
caseUnboxedMonth (UnboxedMonthMatch Vector a
v) (Month Int
ix) = forall a. Unbox a => Vector a -> Int -> a
UVector.unsafeIndex Vector a
v Int
ix

-- | Build a 'DayOfWeekMatch' from seven (7) values.
buildDayOfWeekMatch :: a -> a -> a -> a -> a -> a -> a -> DayOfWeekMatch a
buildDayOfWeekMatch :: forall a. a -> a -> a -> a -> a -> a -> a -> DayOfWeekMatch a
buildDayOfWeekMatch a
a a
b a
c a
d a
e a
f a
g =
  forall a. Vector a -> DayOfWeekMatch a
DayOfWeekMatch (forall a. Int -> [a] -> Vector a
Vector.fromListN Int
7 [a
a,a
b,a
c,a
d,a
e,a
f,a
g])

-- | Match a 'DayOfWeek' against a 'DayOfWeekMatch'.
caseDayOfWeek :: DayOfWeekMatch a -> DayOfWeek -> a
caseDayOfWeek :: forall a. DayOfWeekMatch a -> DayOfWeek -> a
caseDayOfWeek (DayOfWeekMatch Vector a
v) (DayOfWeek Int
ix) = forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector a
v Int
ix

-- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder'
--   corresponding to Year\/Month\/Day encoding.
builder_Ymd :: Maybe Char -> Date -> TB.Builder
builder_Ymd :: Maybe Char -> Date -> Builder
builder_Ymd Maybe Char
msep (Date Year
y Month
m DayOfMonth
d) = case Maybe Char
msep of
  Maybe Char
Nothing ->
       Year -> Builder
yearToZeroPaddedDigit Year
y
    forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigit Month
m
    forall a. Semigroup a => a -> a -> a
<> DayOfMonth -> Builder
zeroPadDayOfMonth DayOfMonth
d
  Just Char
sep -> let sepBuilder :: Builder
sepBuilder = Char -> Builder
TB.singleton Char
sep in
       Year -> Builder
yearToZeroPaddedDigit Year
y
    forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
    forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigit Month
m
    forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
    forall a. Semigroup a => a -> a -> a
<> DayOfMonth -> Builder
zeroPadDayOfMonth DayOfMonth
d

-- | Given a 'Date' and a separator, construct a 'Text.Text'
--   corresponding to a Year\/Month\/Day encoding.
--
--   >>> encode_Ymd (Just ':') (Date (Year 2022) january (DayOfMonth 13))
--   "2022:01:13"
encode_Ymd :: Maybe Char -> Date -> Text
encode_Ymd :: Maybe Char -> Date -> Text
encode_Ymd Maybe Char
msep = Text -> Text
LT.toStrictforall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> Date -> Builder
builder_Ymd Maybe Char
msep

-- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder'
--   corresponding to a Day\/Month\/Year encoding.
builder_Dmy :: Maybe Char -> Date -> TB.Builder
builder_Dmy :: Maybe Char -> Date -> Builder
builder_Dmy Maybe Char
msep (Date Year
y Month
m DayOfMonth
d) = case Maybe Char
msep of
  Maybe Char
Nothing ->
       DayOfMonth -> Builder
zeroPadDayOfMonth DayOfMonth
d
    forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigit Month
m
    forall a. Semigroup a => a -> a -> a
<> Year -> Builder
yearToZeroPaddedDigit Year
y
  Just Char
sep -> let sepBuilder :: Builder
sepBuilder = Char -> Builder
TB.singleton Char
sep in
       DayOfMonth -> Builder
zeroPadDayOfMonth DayOfMonth
d
    forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
    forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigit Month
m
    forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
    forall a. Semigroup a => a -> a -> a
<> Year -> Builder
yearToZeroPaddedDigit Year
y

-- | Given a 'Date' and a separator, construct a 'Text.Text'
--   corresponding to a Day\/Month\/Year encoding.
--
--   >>> encode_Dmy (Just ':') (Date (Year 2022) january (DayOfMonth 13))
--   "13:01:2022"
encode_Dmy :: Maybe Char -> Date -> Text
encode_Dmy :: Maybe Char -> Date -> Text
encode_Dmy Maybe Char
msep = Text -> Text
LT.toStrictforall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> Date -> Builder
builder_Dmy Maybe Char
msep

-- | Parse a Year\/Month\/Day-encoded 'Date' that uses the
--   given separator.
parser_Ymd :: Maybe Char -> Parser Date
parser_Ymd :: Maybe Char -> Parser Date
parser_Ymd Maybe Char
msep = do
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
12) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d forall a. Ord a => a -> a -> Bool
> Int
31) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month forall a b. (a -> b) -> a -> b
$ Int
m forall a. Num a => a -> a -> a
- Int
1) (Int -> DayOfMonth
DayOfMonth Int
d))

-- | Parse a Year\/Month\/Day-encoded 'Date' that either has no separators or
--   uses any non-numeric character for each separator.
parser_Ymd_lenient :: Parser Date
parser_Ymd_lenient :: Parser Date
parser_Ymd_lenient = do
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  Maybe ()
sep1 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
parserLenientSeparator
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
12) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  Maybe ()
sep2 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
parserLenientSeparator
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d forall a. Ord a => a -> a -> Bool
> Int
31) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  case (Maybe ()
sep1, Maybe ()
sep2) of
    (Maybe ()
Nothing, Just ()
_) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Just ()
_, Maybe ()
Nothing) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Maybe (), Maybe ())
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month forall a b. (a -> b) -> a -> b
$ Int
m forall a. Num a => a -> a -> a
- Int
1) (Int -> DayOfMonth
DayOfMonth Int
d))

-- | Parse a Month\/Day\/Year-encoded 'Date' that uses the
--   given separator.
parser_Mdy :: Maybe Char -> Parser Date
parser_Mdy :: Maybe Char -> Parser Date
parser_Mdy Maybe Char
msep = do
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
12) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d forall a. Ord a => a -> a -> Bool
> Int
31) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month forall a b. (a -> b) -> a -> b
$ Int
m forall a. Num a => a -> a -> a
- Int
1) (Int -> DayOfMonth
DayOfMonth Int
d))

-- | Parse a Month\/Day\/Year-encoded 'Date' that either has no separators or
-- uses any non-numeric character for each separator.
parser_Mdy_lenient :: Parser Date
parser_Mdy_lenient :: Parser Date
parser_Mdy_lenient = do
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
12) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  Maybe ()
sep1 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
parserLenientSeparator
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d forall a. Ord a => a -> a -> Bool
> Int
31) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  Maybe ()
sep2 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
parserLenientSeparator
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  case (Maybe ()
sep1, Maybe ()
sep2) of
    (Maybe ()
Nothing, Just ()
_) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Just ()
_, Maybe ()
Nothing) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Maybe (), Maybe ())
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month forall a b. (a -> b) -> a -> b
$ Int
m forall a. Num a => a -> a -> a
- Int
1) (Int -> DayOfMonth
DayOfMonth Int
d))

-- | Parse a Day\/Month\/Year-encoded 'Date' that uses the
--   given separator.
parser_Dmy :: Maybe Char -> Parser Date
parser_Dmy :: Maybe Char -> Parser Date
parser_Dmy Maybe Char
msep = do
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d forall a. Ord a => a -> a -> Bool
> Int
31) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
12) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month forall a b. (a -> b) -> a -> b
$ Int
m forall a. Num a => a -> a -> a
- Int
1) (Int -> DayOfMonth
DayOfMonth Int
d))

-- | Parse a Day\/Month\/Year-encoded 'Date' that either has no separators or
--   uses any non-numeric character for each separator.
parser_Dmy_lenient :: Parser Date
parser_Dmy_lenient :: Parser Date
parser_Dmy_lenient = do
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d forall a. Ord a => a -> a -> Bool
> Int
31) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  Maybe ()
sep1 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
parserLenientSeparator
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
12) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  Maybe ()
sep2 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
parserLenientSeparator
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  case (Maybe ()
sep1, Maybe ()
sep2) of
    (Maybe ()
Nothing, Just ()
_) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Just ()
_, Maybe ()
Nothing) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Maybe (), Maybe ())
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month forall a b. (a -> b) -> a -> b
$ Int
m forall a. Num a => a -> a -> a
- Int
1) (Int -> DayOfMonth
DayOfMonth Int
d))

-- | Given a 'Date' and a separator, construct a 'ByteString' 'BB.Builder'
--   corresponding to a Day\/Month\/Year encoding.
builderUtf8_Ymd :: Maybe Char -> Date -> BB.Builder
builderUtf8_Ymd :: Maybe Char -> Date -> Builder
builderUtf8_Ymd Maybe Char
msep (Date Year
y Month
m DayOfMonth
d) = case Maybe Char
msep of
  Maybe Char
Nothing ->
       Year -> Builder
yearToZeroPaddedDigitBS Year
y
    forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigitBS Month
m
    forall a. Semigroup a => a -> a -> a
<> DayOfMonth -> Builder
zeroPadDayOfMonthBS DayOfMonth
d
  Just Char
sep -> let sepBuilder :: Builder
sepBuilder = Char -> Builder
BB.char7 Char
sep in
       Year -> Builder
yearToZeroPaddedDigitBS Year
y
    forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
    forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigitBS Month
m
    forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
    forall a. Semigroup a => a -> a -> a
<> DayOfMonth -> Builder
zeroPadDayOfMonthBS DayOfMonth
d

-- | Parse a Year\/Month\/Day-encoded 'Date' that uses the
--   given separator.
parserUtf8_Ymd :: Maybe Char -> AB.Parser Date
parserUtf8_Ymd :: Maybe Char -> Parser Date
parserUtf8_Ymd Maybe Char
msep = do
  Int
y <- Int -> Parser Int
parseFixedDigitsIntBS Int
4
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AB.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
12) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AB.char Maybe Char
msep
  Int
d <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d forall a. Ord a => a -> a -> Bool
> Int
31) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month forall a b. (a -> b) -> a -> b
$ Int
m forall a. Num a => a -> a -> a
- Int
1) (Int -> DayOfMonth
DayOfMonth Int
d))

-- | Given a 'SubsecondPrecision' and a separator, construct a
--   'Text' 'TB.Builder' corresponding to an Hour\/Minute\/Second
--   encoding.
builder_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder
builder_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_HMS SubsecondPrecision
sp Maybe Char
msep (TimeOfDay Int
h Int
m Int64
ns) =
     Int -> Builder
indexTwoDigitTextBuilder Int
h
  forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilder_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator,
--   construct a 'Text' 'TB.Builder' according to an IMS encoding.
--
--   This differs from 'builder_IMSp' in that their is a space
--   between the seconds and locale.
builder_IMS_p :: MeridiemLocale Text -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder
builder_IMS_p :: MeridiemLocale Text
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_IMS_p MeridiemLocale Text
meridiemLocale SubsecondPrecision
sp Maybe Char
msep (TimeOfDay Int
h Int
m Int64
ns) =
     Int -> Builder
internalBuilder_I Int
h
  forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilder_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns
  forall a. Semigroup a => a -> a -> a
<> Builder
" "
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale Text -> Int -> Builder
internalBuilder_p MeridiemLocale Text
meridiemLocale Int
h

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator,
--   construct a 'Text' 'TB.Builder' according to an IMS encoding.
builder_IMSp :: MeridiemLocale Text -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder
builder_IMSp :: MeridiemLocale Text
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_IMSp MeridiemLocale Text
meridiemLocale SubsecondPrecision
sp Maybe Char
msep (TimeOfDay Int
h Int
m Int64
ns) =
     Int -> Builder
internalBuilder_I Int
h
  forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilder_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale Text -> Int -> Builder
internalBuilder_p MeridiemLocale Text
meridiemLocale Int
h

internalBuilder_I :: Int -> TB.Builder
internalBuilder_I :: Int -> Builder
internalBuilder_I Int
h =
  Int -> Builder
indexTwoDigitTextBuilder forall a b. (a -> b) -> a -> b
$ if Int
h forall a. Ord a => a -> a -> Bool
> Int
12
    then Int
h forall a. Num a => a -> a -> a
- Int
12
    else if Int
h forall a. Eq a => a -> a -> Bool
== Int
0
      then Int
12
      else Int
h

internalBuilder_p :: MeridiemLocale Text -> Int -> TB.Builder
internalBuilder_p :: MeridiemLocale Text -> Int -> Builder
internalBuilder_p (MeridiemLocale Text
am Text
pm) Int
h = if Int
h forall a. Ord a => a -> a -> Bool
> Int
11
  then Text -> Builder
TB.fromText Text
pm
  else Text -> Builder
TB.fromText Text
am

-- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that uses
--   the given separator.
parser_HMS :: Maybe Char -> Parser TimeOfDay
parser_HMS :: Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
msep = do
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h forall a. Ord a => a -> a -> Bool
> Int
23) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
> Int
59) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)

parserLenientSeparator :: Parser ()
parserLenientSeparator :: Parser ()
parserLenientSeparator = (Char -> Bool) -> Parser Char
AT.satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that either has no
--   separators or uses any given non-numeric character for each separator.
parser_HMS_lenient :: Parser TimeOfDay
parser_HMS_lenient :: Parser TimeOfDay
parser_HMS_lenient = do
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h forall a. Ord a => a -> a -> Bool
> Int
23) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  Parser ()
parserLenientSeparator
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
> Int
59) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  Parser ()
parserLenientSeparator
  Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)

-- | Parses text that is formatted as either of the following:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
parser_HMS_opt_S :: Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S :: Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
msep = do
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h forall a. Ord a => a -> a -> Bool
> Int
23) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
> Int
59) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  Maybe Char
mc <- Parser (Maybe Char)
AT.peekChar
  case Maybe Char
mc of
    Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
0)
    Just Char
c -> case Maybe Char
msep of
      Just Char
sep -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
sep
        then do
          Char
_ <- Parser Char
AT.anyChar -- should be the separator
          Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
0)
      -- if there is no separator, we will try to parse the
      -- remaining part as seconds. We commit to trying to
      -- parse as seconds if we see any number as the next
      -- character.
      Maybe Char
Nothing -> if Char -> Bool
isDigit Char
c
        then do
          Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
0)

-- | Parses text that is formatted as either of the following with either no
-- separators or any non-numeric characters for each separator:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
parser_HMS_opt_S_lenient :: Parser TimeOfDay
parser_HMS_opt_S_lenient :: Parser TimeOfDay
parser_HMS_opt_S_lenient = do
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h forall a. Ord a => a -> a -> Bool
> Int
23) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  Parser ()
parserLenientSeparator
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
> Int
59) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  Maybe Char
mc <- Parser (Maybe Char)
AT.peekChar
  case Maybe Char
mc of
    Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
0)
    Just Char
c | Bool -> Bool
not (Char -> Bool
isDigit Char
c) -> do
      Char
_ <- Parser Char
AT.anyChar -- should be the separator
      Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
    Just Char
_ -> do
      Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)

parseSecondsAndNanoseconds :: Parser Int64
parseSecondsAndNanoseconds :: Parser Int64
parseSecondsAndNanoseconds = do
  Int
s' <- Int -> Parser Int
parseFixedDigits Int
2
  let s :: Int64
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s' :: Int64
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
s forall a. Ord a => a -> a -> Bool
> Int64
60) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"seconds must be between 0 and 60")
  Int64
nanoseconds <-
    ( do Char
_ <- Char -> Parser Char
AT.char Char
'.'
         Int
numberOfZeroes <- Parser Int
countZeroes
         Parser (Maybe Char)
AT.peekChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
           Just Char
c | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' -> do
             Int64
x <- forall a. Integral a => Parser a
AT.decimal
             let totalDigits :: Int
totalDigits = forall a. Integral a => a -> Int
countDigits Int64
x forall a. Num a => a -> a -> a
+ Int
numberOfZeroes
                 result :: Int64
result = if Int
totalDigits forall a. Eq a => a -> a -> Bool
== Int
9
                   then Int64
x
                   else if Int
totalDigits forall a. Ord a => a -> a -> Bool
< Int
9
                     then Int64
x forall a. Num a => a -> a -> a
* Int -> Int64
raiseTenTo (Int
9 forall a. Num a => a -> a -> a
- Int
totalDigits)
                     else forall a. Integral a => a -> a -> a
quot Int64
x (Int -> Int64
raiseTenTo (Int
totalDigits forall a. Num a => a -> a -> a
- Int
9))
             forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
result)
           Maybe Char
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
    ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
s forall a. Num a => a -> a -> a
* Int64
1000000000 forall a. Num a => a -> a -> a
+ Int64
nanoseconds)

countZeroes :: AT.Parser Int
countZeroes :: Parser Int
countZeroes = forall {t}. Num t => t -> Parser Text t
go Int
0 where
  go :: t -> Parser Text t
go !t
i = do
    Maybe Char
m <- Parser (Maybe Char)
AT.peekChar
    case Maybe Char
m of
      Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure t
i
      Just Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'0'
        then Parser Char
AT.anyChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> t -> Parser Text t
go (t
i forall a. Num a => a -> a -> a
+ t
1)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure t
i

nanosecondsBuilder :: Int64 -> TB.Builder
nanosecondsBuilder :: Int64 -> Builder
nanosecondsBuilder Int64
w
  | Int64
w forall a. Eq a => a -> a -> Bool
== Int64
0 = forall a. Monoid a => a
mempty
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99999999 = Builder
"." forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9999999 = Builder
".0" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
999999 = Builder
".00" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99999 = Builder
".000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9999 = Builder
".0000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
999 = Builder
".00000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99 = Builder
".000000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9 = Builder
".0000000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Bool
otherwise = Builder
".00000000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w

microsecondsBuilder :: Int64 -> TB.Builder
microsecondsBuilder :: Int64 -> Builder
microsecondsBuilder Int64
w
  | Int64
w forall a. Eq a => a -> a -> Bool
== Int64
0 = forall a. Monoid a => a
mempty
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99999 = Builder
"." forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9999 = Builder
".0" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
999 = Builder
".00" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99 = Builder
".000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9 = Builder
".0000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Bool
otherwise = Builder
".00000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w

millisecondsBuilder :: Int64 -> TB.Builder
millisecondsBuilder :: Int64 -> Builder
millisecondsBuilder Int64
w
  | Int64
w forall a. Eq a => a -> a -> Bool
== Int64
0 = forall a. Monoid a => a
mempty
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99 = Builder
"." forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9 = Builder
".0" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Bool
otherwise = Builder
".00" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
w

prettyNanosecondsBuilder :: SubsecondPrecision -> Int64 -> TB.Builder
prettyNanosecondsBuilder :: SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilder SubsecondPrecision
sp Int64
nano = case SubsecondPrecision
sp of
  SubsecondPrecision
SubsecondPrecisionAuto
    | Int64
milliRem forall a. Eq a => a -> a -> Bool
== Int64
0 -> Int64 -> Builder
millisecondsBuilder Int64
milli
    | Int64
microRem forall a. Eq a => a -> a -> Bool
== Int64
0 -> Int64 -> Builder
microsecondsBuilder Int64
micro
    | Bool
otherwise -> Int64 -> Builder
nanosecondsBuilder Int64
nano
  SubsecondPrecisionFixed Int
d -> if Int
d forall a. Eq a => a -> a -> Bool
== Int
0
    then forall a. Monoid a => a
mempty
    else
      let newSubsecondPart :: Int64
newSubsecondPart = forall a. Integral a => a -> a -> a
quot Int64
nano (Int -> Int64
raiseTenTo (Int
9 forall a. Num a => a -> a -> a
- Int
d))
       in Builder
"."
          forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText (Int -> Text -> Text
Text.replicate (Int
d forall a. Num a => a -> a -> a
- forall a. Integral a => a -> Int
countDigits Int64
newSubsecondPart) Text
"0")
          forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int64
newSubsecondPart
  where
  (Int64
milli,Int64
milliRem) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
nano Int64
1000000
  (Int64
micro,Int64
microRem) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
nano Int64
1000

-- | Encode a 'Timespan' as 'Text' using the given 'SubsecondPrecision'.
encodeTimespan :: SubsecondPrecision -> Timespan -> Text
encodeTimespan :: SubsecondPrecision -> Timespan -> Text
encodeTimespan SubsecondPrecision
sp =
  Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubsecondPrecision -> Timespan -> Builder
builderTimespan SubsecondPrecision
sp

-- | Construct a 'Text' 'TB.Builder' corresponding to an encoding
--   of the given 'Timespan' using the given 'SubsecondPrecision'.
builderTimespan :: SubsecondPrecision -> Timespan -> TB.Builder
builderTimespan :: SubsecondPrecision -> Timespan -> Builder
builderTimespan SubsecondPrecision
sp (Timespan Int64
ns) =
  forall a. Integral a => a -> Builder
TB.decimal Int64
sInt64 forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilder SubsecondPrecision
sp Int64
nsRemainder
  where
  (!Int64
sInt64,!Int64
nsRemainder) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
ns Int64
1000000000

internalBuilder_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> TB.Builder
internalBuilder_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilder_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns = case Maybe Char
msep of
  Maybe Char
Nothing -> Int -> Builder
indexTwoDigitTextBuilder Int
m
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
s
          forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilder SubsecondPrecision
sp Int64
nsRemainder
  Just Char
sep -> let sepBuilder :: Builder
sepBuilder = Char -> Builder
TB.singleton Char
sep in
             Builder
sepBuilder
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
m
          forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
s
          forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilder SubsecondPrecision
sp Int64
nsRemainder
  where
  (!Int64
sInt64,!Int64
nsRemainder) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
ns Int64
1000000000
  !s :: Int
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
sInt64

-- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct a
--   'Text' 'TB.Builder' corresponding to a
--   Day\/Month\/Year,Hour\/Minute\/Second encoding of the given 'Datetime'.
builder_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder
builder_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_DmyHMS SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
  case Maybe Char
msep of
    Maybe Char
Nothing -> Maybe Char -> Date -> Builder
builder_Dmy Maybe Char
mdateSep Date
date
            forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_HMS SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time
    Just Char
sep -> Maybe Char -> Date -> Builder
builder_Dmy Maybe Char
mdateSep Date
date
             forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
sep
             forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_HMS SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision',
--   and a 'DatetimeFormat', construct a 'Text' 'TB.Builder'
--   corresponding to a Day\/Month\/Year,IMS encoding of the given
--   'Datetime'. This differs from 'builder_DmyIMSp' in that
--   it adds a space between the locale and seconds.
builder_DmyIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder
builder_DmyIMS_p :: MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_DmyIMS_p MeridiemLocale Text
locale SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
     Maybe Char -> Date -> Builder
builder_Dmy Maybe Char
mdateSep Date
date
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Char -> Builder
TB.singleton Maybe Char
msep
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale Text
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_IMS_p MeridiemLocale Text
locale SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision',
--   and a 'DatetimeFormat', construct a 'Text' 'TB.Builder'
--   corresponding to a Day\/Month\/Year,IMS encoding of the given
--   'Datetime'.
builder_DmyIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder
builder_DmyIMSp :: MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_DmyIMSp MeridiemLocale Text
locale SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
     Maybe Char -> Date -> Builder
builder_Dmy Maybe Char
mdateSep Date
date
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Char -> Builder
TB.singleton Maybe Char
msep
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale Text
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_IMS_p MeridiemLocale Text
locale SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Given a 'SubsecondPrecision' and 'DatetimeFormat', construct
--   'Text' that corresponds to a Day\/Month\/Year,Hour\/Minute\/Second
--   encoding of the given 'Datetime'.
encode_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_DmyHMS SubsecondPrecision
sp DatetimeFormat
format =
  Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_DmyHMS SubsecondPrecision
sp DatetimeFormat
format

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a
--   'DatetimeFormat', construct 'Text' that corresponds to a
--   Day\/Month\/Year,IMS encoding of the given 'Datetime'. This
--   inserts a space between the locale and seconds.
encode_DmyIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_DmyIMS_p :: MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_DmyIMS_p MeridiemLocale Text
a SubsecondPrecision
sp DatetimeFormat
b = Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_DmyIMS_p MeridiemLocale Text
a SubsecondPrecision
sp DatetimeFormat
b

-- | Given a 'SubsecondPrecision' and 'DatetimeFormat', construct
--   'Text' that corresponds to a Year\/Month\/Day,Hour\/Minute\/Second
--   encoding of the given 'Datetime'.
encode_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_YmdHMS SubsecondPrecision
sp DatetimeFormat
format =
  Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_YmdHMS SubsecondPrecision
sp DatetimeFormat
format

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a
--   'DatetimeFormat', construct 'Text' that corresponds to a
--   Year\/Month\/Day,IMS encoding of the given 'Datetime'. This
--   inserts a space between the locale and seconds.
encode_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_YmdIMS_p :: MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_YmdIMS_p MeridiemLocale Text
a SubsecondPrecision
sp DatetimeFormat
b = Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_YmdIMS_p MeridiemLocale Text
a SubsecondPrecision
sp DatetimeFormat
b

-- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct
--   a 'Text' 'TB.Builder' corresponding to a
--   Year\/Month\/Day,Hour\/Minute\/Second encoding of the given 'Datetime'.
builder_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder
builder_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_YmdHMS SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
  case Maybe Char
msep of
    Maybe Char
Nothing -> Maybe Char -> Date -> Builder
builder_Ymd Maybe Char
mdateSep Date
date
            forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_HMS SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time
    Just Char
sep -> Maybe Char -> Date -> Builder
builder_Ymd Maybe Char
mdateSep Date
date
             forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
sep
             forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_HMS SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a
--   'DatetimeFormat', construct a 'Text' 'TB.Builder' that
--   corresponds to a Year\/Month\/Day,IMS encoding of the
--   given 'Datetime'. This inserts a space between the locale
--   and seconds.
builder_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder
builder_YmdIMS_p :: MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_YmdIMS_p MeridiemLocale Text
locale SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
     Maybe Char -> Date -> Builder
builder_Ymd Maybe Char
mdateSep Date
date
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Char -> Builder
TB.singleton Maybe Char
msep
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale Text
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_IMS_p MeridiemLocale Text
locale SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a
--   'DatetimeFormat', construct a 'Text' 'TB.Builder' that
--   corresponds to a Year\/Month\/Day,IMS encoding of the
--   given 'Datetime'.
builder_YmdIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder
builder_YmdIMSp :: MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_YmdIMSp MeridiemLocale Text
locale SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
     Maybe Char -> Date -> Builder
builder_Ymd Maybe Char
mdateSep Date
date
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Char -> Builder
TB.singleton Maybe Char
msep
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale Text
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builder_IMS_p MeridiemLocale Text
locale SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Construct a 'Text' 'TB.Builder' corresponding to the W3C
--   encoding of the given 'Datetime'.
--
--   Deprecated. This is just a poorly named alias for 'builderIso8601'.
builderW3C :: Datetime -> TB.Builder
builderW3C :: Datetime -> Builder
builderW3C = Datetime -> Builder
builderIso8601

-- | Construct a 'Text' 'TB.Builder' corresponding to the ISO-8601
--   encoding of the given 'Datetime'.
builderIso8601 :: Datetime -> TB.Builder
builderIso8601 :: Datetime -> Builder
builderIso8601 = SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_YmdHMS SubsecondPrecision
SubsecondPrecisionAuto DatetimeFormat
w3c

-- | Construct 'Text' corresponding to the ISO-8601
--   encoding of the given 'Datetime'.
--
--   >>> encodeIso8601 (datetimeFromYmdhms 2014 2 26 17 58 52)
--   "2014-02-26T17:58:52"
encodeIso8601 :: Datetime -> Text
encodeIso8601 :: Datetime -> Text
encodeIso8601 = Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> Builder
builderIso8601

-- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime'
--   from 'Text' that was encoded with the given 'DatetimeFormat'.
decode_YmdHMS :: DatetimeFormat -> Text -> Maybe Datetime
decode_YmdHMS :: DatetimeFormat -> Text -> Maybe Datetime
decode_YmdHMS DatetimeFormat
format =
  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 -> Text -> Either String a
AT.parseOnly (DatetimeFormat -> Parser Datetime
parser_YmdHMS DatetimeFormat
format)

-- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with either no separators or any non-numeric
--   character for each separator.
decode_YmdHMS_lenient :: Text -> Maybe Datetime
decode_YmdHMS_lenient :: Text -> Maybe Datetime
decode_YmdHMS_lenient =
  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 -> Text -> Either String a
AT.parseOnly Parser Datetime
parser_YmdHMS_lenient

-- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime'
--   that was encoded with the given 'DatetimeFormat'.
parser_DmyHMS :: DatetimeFormat -> Parser Datetime
parser_DmyHMS :: DatetimeFormat -> Parser Datetime
parser_DmyHMS (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
parser_Dmy Maybe Char
mdateSep
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

-- | Parses text that is formatted as either of the following:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
parser_DmyHMS_opt_S :: DatetimeFormat -> Parser Datetime
parser_DmyHMS_opt_S :: DatetimeFormat -> Parser Datetime
parser_DmyHMS_opt_S (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
parser_Dmy Maybe Char
mdateSep
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

-- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with either no separators or any non-numeric
--   character for each separator, such as:
--
-- 01-05-2017T23:13:05
-- 01-05-2017 23:13:05
-- 01/05/2017 23:13:05
-- 01y01/2018x23;50&29
parser_DmyHMS_lenient :: Parser Datetime
parser_DmyHMS_lenient :: Parser Datetime
parser_DmyHMS_lenient = do
  Maybe Date
mdate <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Dmy forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Dmy_lenient forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
parserLenientSeparator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
parser_HMS_lenient

-- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with either no separators or any non-numeric
--   character for each separator and with either of the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
parser_DmyHMS_opt_S_lenient :: Parser Datetime
parser_DmyHMS_opt_S_lenient :: Parser Datetime
parser_DmyHMS_opt_S_lenient = do
  Maybe Date
mdate <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Dmy forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Dmy_lenient forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
parserLenientSeparator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
parser_HMS_opt_S_lenient

-- | Decodes Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
-- 'Text' that is encoded with either no separators or any non-numeric
-- characters as separators, such as:
--
-- 2017-01-05T23:13:05
-- 2017-01-05 23:13:05
-- 2017/01/05 23:13:05
-- 2018x01y01/23;50&29
decode_DmyHMS_lenient :: Text -> Maybe Datetime
decode_DmyHMS_lenient :: Text -> Maybe Datetime
decode_DmyHMS_lenient = 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 -> Text -> Either String a
AT.parseOnly Parser Datetime
parser_DmyHMS_lenient

-- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime'
--   from 'Text' that was encoded with the given 'DatetimeFormat'.
decode_DmyHMS :: DatetimeFormat -> Text -> Maybe Datetime
decode_DmyHMS :: DatetimeFormat -> Text -> Maybe Datetime
decode_DmyHMS DatetimeFormat
format =
  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 -> Text -> Either String a
AT.parseOnly (DatetimeFormat -> Parser Datetime
parser_DmyHMS DatetimeFormat
format)

-- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with with the given 'DatetimeFormat' and with
--   either of the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
decode_DmyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime
decode_DmyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime
decode_DmyHMS_opt_S DatetimeFormat
format =
  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 -> Text -> Either String a
AT.parseOnly (DatetimeFormat -> Parser Datetime
parser_DmyHMS_opt_S DatetimeFormat
format)

-- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with either no separators or any non-numeric
--   character for each separator and with either of the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
decode_DmyHMS_opt_S_lenient :: Text -> Maybe Datetime
decode_DmyHMS_opt_S_lenient :: Text -> Maybe Datetime
decode_DmyHMS_opt_S_lenient =
  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 -> Text -> Either String a
AT.parseOnly Parser Datetime
parser_DmyHMS_opt_S_lenient


-- | Parses a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime'
--   that was encoded using the given 'DatetimeFormat'.
parser_MdyHMS :: DatetimeFormat -> Parser Datetime
parser_MdyHMS :: DatetimeFormat -> Parser Datetime
parser_MdyHMS (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
parser_Mdy Maybe Char
mdateSep
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

-- | Parses a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' that was
--   encoded with either no separators or any non-numeric character for each
--   separator.
parser_MdyHMS_lenient :: Parser Datetime
parser_MdyHMS_lenient :: Parser Datetime
parser_MdyHMS_lenient = do
  Maybe Date
mdate <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Mdy forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Mdy_lenient forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
parserLenientSeparator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
parser_HMS_lenient

-- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with with the given 'DatetimeFormat' and with
--   either of the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero.
parser_MdyHMS_opt_S :: DatetimeFormat -> Parser Datetime
parser_MdyHMS_opt_S :: DatetimeFormat -> Parser Datetime
parser_MdyHMS_opt_S (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
parser_Mdy Maybe Char
mdateSep
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

-- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with either no separators or any non-numeric
--   character for each separator and with either of the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero.
parser_MdyHMS_opt_S_lenient :: Parser Datetime
parser_MdyHMS_opt_S_lenient :: Parser Datetime
parser_MdyHMS_opt_S_lenient = do
  Maybe Date
mdate <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Mdy forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Mdy_lenient forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
parserLenientSeparator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
parser_HMS_opt_S_lenient

-- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime'
--   from 'Text' that was encoded with the given 'DatetimeFormat'.
decode_MdyHMS :: DatetimeFormat -> Text -> Maybe Datetime
decode_MdyHMS :: DatetimeFormat -> Text -> Maybe Datetime
decode_MdyHMS DatetimeFormat
format =
  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 -> Text -> Either String a
AT.parseOnly (DatetimeFormat -> Parser Datetime
parser_MdyHMS DatetimeFormat
format)

-- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' with either no separators or any non-numeric character for each
--   separator.
decode_MdyHMS_lenient :: Text -> Maybe Datetime
decode_MdyHMS_lenient :: Text -> Maybe Datetime
decode_MdyHMS_lenient =
  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 -> Text -> Either String a
AT.parseOnly Parser Datetime
parser_MdyHMS_lenient

-- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with the given 'DatetimeFormat' and with either of
--   the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero.
decode_MdyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime
decode_MdyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime
decode_MdyHMS_opt_S DatetimeFormat
format =
  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 -> Text -> Either String a
AT.parseOnly (DatetimeFormat -> Parser Datetime
parser_MdyHMS_opt_S DatetimeFormat
format)

-- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' with either no separators or any non-numeric character for each
--   separator and with either of the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero.
decode_MdyHMS_opt_S_lenient :: Text -> Maybe Datetime
decode_MdyHMS_opt_S_lenient :: Text -> Maybe Datetime
decode_MdyHMS_opt_S_lenient =
  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 -> Text -> Either String a
AT.parseOnly Parser Datetime
parser_MdyHMS_opt_S_lenient

-- | Parses a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime'
--   that was encoded using the given 'DatetimeFormat'.
parser_YmdHMS :: DatetimeFormat -> Parser Datetime
parser_YmdHMS :: DatetimeFormat -> Parser Datetime
parser_YmdHMS (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
parser_Ymd Maybe Char
mdateSep
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

-- | Parses a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' that was
--   encoded with either no separators or any non-numeric character for each
--   separator.
parser_YmdHMS_lenient :: Parser Datetime
parser_YmdHMS_lenient :: Parser Datetime
parser_YmdHMS_lenient = do
  Maybe Date
mdate <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Ymd forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Ymd_lenient forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
parserLenientSeparator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
parser_HMS_lenient

-- | Parses a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with the given 'DatetimeFormat' and with either of
--   the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
parser_YmdHMS_opt_S :: DatetimeFormat -> Parser Datetime
parser_YmdHMS_opt_S :: DatetimeFormat -> Parser Datetime
parser_YmdHMS_opt_S (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
parser_Ymd Maybe Char
mdateSep
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

-- | Parses a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with either no separators or any non-numeric
--   character for each separator and with either of the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
parser_YmdHMS_opt_S_lenient :: Parser Datetime
parser_YmdHMS_opt_S_lenient :: Parser Datetime
parser_YmdHMS_opt_S_lenient = do
  Maybe Date
mdate <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Ymd forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Ymd_lenient forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
parserLenientSeparator forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
parser_HMS_opt_S_lenient

-- | Decode a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with the given 'DatetimeFormat' and with either of
--   the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
decode_YmdHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime
decode_YmdHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime
decode_YmdHMS_opt_S DatetimeFormat
format =
  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 -> Text -> Either String a
AT.parseOnly (DatetimeFormat -> Parser Datetime
parser_YmdHMS_opt_S DatetimeFormat
format)

-- | Decode a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from
--   'Text' that was encoded with either no separators or any non-numeric
--   character for each separator and with either of the following time formats:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
decode_YmdHMS_opt_S_lenient :: Text -> Maybe Datetime
decode_YmdHMS_opt_S_lenient :: Text -> Maybe Datetime
decode_YmdHMS_opt_S_lenient =
  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 -> Text -> Either String a
AT.parseOnly Parser Datetime
parser_YmdHMS_opt_S_lenient

-- | Parses a 'Datetime' from 'Text' that was encoded with any of the following
-- formats and with either no separators or any non-numeric character for each
-- separator.
--
-- * @%Y-%M-%D %H:%M@
-- * @%Y-%M-%D %H:%M:%S@
-- * @%D-%M-%Y %H:%M@
-- * @%D-%M-%Y %H:%M:%S@
-- * @%M-%D-%Y %H:%M@
-- * @%M-%D-%Y %H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is not provided,
-- it is assumed to be zero. Note that this is the least performant parser due
-- to backtracking
parser_lenient :: Parser Datetime
parser_lenient :: Parser Datetime
parser_lenient = Parser Datetime
parser_YmdHMS_opt_S_lenient forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Datetime
parser_DmyHMS_opt_S_lenient forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Datetime
parser_MdyHMS_opt_S_lenient

-- | Parses text that was encoded in DMY, YMD, or MDY format with optional
-- seconds and any non-numeric character as separators.
decode_lenient :: Text -> Maybe Datetime
decode_lenient :: Text -> Maybe Datetime
decode_lenient =
  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 -> Text -> Either String a
AT.parseOnly Parser Datetime
parser_lenient
---------------
-- ByteString stuff
---------------

-- | Given a 'SubsecondPrecision' and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an Hour\/Minute\/Second encoding of the given 'TimeOfDay'.
builderUtf8_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder
builderUtf8_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builderUtf8_HMS SubsecondPrecision
sp Maybe Char
msep (TimeOfDay Int
h Int
m Int64
ns) =
     Int -> Builder
indexTwoDigitByteStringBuilder Int
h
  forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilderUtf8_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an IMS encoding of the given 'TimeOfDay'. This differs from 'builderUtf8_IMSp' in that
-- there is a space between the seconds and locale.
builderUtf8_IMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder
builderUtf8_IMS_p :: MeridiemLocale ByteString
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builderUtf8_IMS_p MeridiemLocale ByteString
meridiemLocale SubsecondPrecision
sp Maybe Char
msep (TimeOfDay Int
h Int
m Int64
ns) =
     Int -> Builder
internalBuilderUtf8_I Int
h
  forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilderUtf8_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns
  forall a. Semigroup a => a -> a -> a
<> Builder
" "
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale ByteString -> Int -> Builder
internalBuilderUtf8_p MeridiemLocale ByteString
meridiemLocale Int
h

internalBuilderUtf8_I :: Int -> BB.Builder
internalBuilderUtf8_I :: Int -> Builder
internalBuilderUtf8_I Int
h =
  Int -> Builder
indexTwoDigitByteStringBuilder forall a b. (a -> b) -> a -> b
$ if Int
h forall a. Ord a => a -> a -> Bool
> Int
12
    then Int
h forall a. Num a => a -> a -> a
- Int
12
    else if Int
h forall a. Eq a => a -> a -> Bool
== Int
0
      then Int
12
      else Int
h

internalBuilderUtf8_p :: MeridiemLocale ByteString -> Int -> BB.Builder
internalBuilderUtf8_p :: MeridiemLocale ByteString -> Int -> Builder
internalBuilderUtf8_p (MeridiemLocale ByteString
am ByteString
pm) Int
h = if Int
h forall a. Ord a => a -> a -> Bool
> Int
11
  then ByteString -> Builder
BB.byteString ByteString
pm
  else ByteString -> Builder
BB.byteString ByteString
am

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an IMS encoding of the given 'TimeOfDay'.
builderUtf8_IMSp :: MeridiemLocale ByteString -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder
builderUtf8_IMSp :: MeridiemLocale ByteString
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builderUtf8_IMSp MeridiemLocale ByteString
meridiemLocale SubsecondPrecision
sp Maybe Char
msep (TimeOfDay Int
h Int
m Int64
ns) =
     Int -> Builder
internalBuilderUtf8_I Int
h
  forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilderUtf8_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale ByteString -> Int -> Builder
internalBuilderUtf8_p MeridiemLocale ByteString
meridiemLocale Int
h

-- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that uses
--   the given separator.
parserUtf8_HMS :: Maybe Char -> AB.Parser TimeOfDay
parserUtf8_HMS :: Maybe Char -> Parser TimeOfDay
parserUtf8_HMS Maybe Char
msep = do
  Int
h <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h forall a. Ord a => a -> a -> Bool
> Int
23) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AB.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
> Int
59) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AB.char Maybe Char
msep
  Int64
ns <- Parser Int64
parseSecondsAndNanosecondsUtf8
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)

-- | Parses text that is formatted as either of the following:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
parserUtf8_HMS_opt_S :: Maybe Char -> AB.Parser TimeOfDay
parserUtf8_HMS_opt_S :: Maybe Char -> Parser TimeOfDay
parserUtf8_HMS_opt_S Maybe Char
msep = do
  Int
h <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h forall a. Ord a => a -> a -> Bool
> Int
23) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AB.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
> Int
59) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  Maybe Char
mc <- Parser (Maybe Char)
AB.peekChar
  case Maybe Char
mc of
    Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
0)
    Just Char
c -> case Maybe Char
msep of
      Just Char
sep -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
sep
        then do
          Char
_ <- Parser Char
AB.anyChar -- should be the separator
          Int64
ns <- Parser Int64
parseSecondsAndNanosecondsUtf8
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
0)
      -- if there is no separator, we will try to parse the
      -- remaining part as seconds. We commit to trying to
      -- parse as seconds if we see any number as the next
      -- character.
      Maybe Char
Nothing -> if Char -> Bool
isDigit Char
c
        then do
          Int64
ns <- Parser Int64
parseSecondsAndNanosecondsUtf8
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
0)

parseSecondsAndNanosecondsUtf8 :: AB.Parser Int64
parseSecondsAndNanosecondsUtf8 :: Parser Int64
parseSecondsAndNanosecondsUtf8 = do
  Int
s' <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  let !s :: Int64
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s' :: Int64
  -- TODO: whoops, this should probably be gt 59, not 60
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
s forall a. Ord a => a -> a -> Bool
> Int64
60) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"seconds must be between 0 and 60")
  Int64
nanoseconds <-
    ( do Char
_ <- Char -> Parser Char
AB.char Char
'.'
         Int
numberOfZeroes <- Parser Int
countZeroesUtf8
         Parser (Maybe Char)
AB.peekChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
           Just Char
c | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' -> do
             Int64
x <- forall a. Integral a => Parser a
AB.decimal
             let totalDigits :: Int
totalDigits = forall a. Integral a => a -> Int
countDigits Int64
x forall a. Num a => a -> a -> a
+ Int
numberOfZeroes
                 result :: Int64
result = if Int
totalDigits forall a. Eq a => a -> a -> Bool
== Int
9
                   then Int64
x
                   else if Int
totalDigits forall a. Ord a => a -> a -> Bool
< Int
9
                     then Int64
x forall a. Num a => a -> a -> a
* Int -> Int64
raiseTenTo (Int
9 forall a. Num a => a -> a -> a
- Int
totalDigits)
                     else forall a. Integral a => a -> a -> a
quot Int64
x (Int -> Int64
raiseTenTo (Int
totalDigits forall a. Num a => a -> a -> a
- Int
9))
             forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
result)
           Maybe Char
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
    ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
s forall a. Num a => a -> a -> a
* Int64
1000000000 forall a. Num a => a -> a -> a
+ Int64
nanoseconds)

countZeroesUtf8 :: AB.Parser Int
countZeroesUtf8 :: Parser Int
countZeroesUtf8 = forall {t}. Num t => t -> Parser ByteString t
go Int
0 where
  go :: t -> Parser ByteString t
go !t
i = do
    Maybe Char
m <- Parser (Maybe Char)
AB.peekChar
    case Maybe Char
m of
      Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure t
i
      Just Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'0'
        then Parser Char
AB.anyChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> t -> Parser ByteString t
go (t
i forall a. Num a => a -> a -> a
+ t
1)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure t
i

nanosecondsBuilderUtf8 :: Int64 -> BB.Builder
nanosecondsBuilderUtf8 :: Int64 -> Builder
nanosecondsBuilderUtf8 Int64
w
  | Int64
w forall a. Eq a => a -> a -> Bool
== Int64
0 = forall a. Monoid a => a
mempty
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99999999 = Builder
"." forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9999999 = Builder
".0" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
999999 = Builder
".00" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99999 = Builder
".000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9999 = Builder
".0000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
999 = Builder
".00000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99 = Builder
".000000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9 = Builder
".0000000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Bool
otherwise = Builder
".00000000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w

microsecondsBuilderUtf8 :: Int64 -> BB.Builder
microsecondsBuilderUtf8 :: Int64 -> Builder
microsecondsBuilderUtf8 Int64
w
  | Int64
w forall a. Eq a => a -> a -> Bool
== Int64
0 = forall a. Monoid a => a
mempty
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99999 = Builder
"." forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9999 = Builder
".0" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
999 = Builder
".00" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99 = Builder
".000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9 = Builder
".0000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Bool
otherwise = Builder
".00000" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w

millisecondsBuilderUtf8 :: Int64 -> BB.Builder
millisecondsBuilderUtf8 :: Int64 -> Builder
millisecondsBuilderUtf8 Int64
w
  | Int64
w forall a. Eq a => a -> a -> Bool
== Int64
0 = forall a. Monoid a => a
mempty
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
99 = Builder
"." forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w forall a. Ord a => a -> a -> Bool
> Int64
9 = Builder
".0" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Bool
otherwise = Builder
".00" forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w

prettyNanosecondsBuilderUtf8 :: SubsecondPrecision -> Int64 -> BB.Builder
prettyNanosecondsBuilderUtf8 :: SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilderUtf8 SubsecondPrecision
sp Int64
nano = case SubsecondPrecision
sp of
  SubsecondPrecision
SubsecondPrecisionAuto
    | Int64
milliRem forall a. Eq a => a -> a -> Bool
== Int64
0 -> Int64 -> Builder
millisecondsBuilderUtf8 Int64
milli
    | Int64
microRem forall a. Eq a => a -> a -> Bool
== Int64
0 -> Int64 -> Builder
microsecondsBuilderUtf8 Int64
micro
    | Bool
otherwise -> Int64 -> Builder
nanosecondsBuilderUtf8 Int64
nano
  SubsecondPrecisionFixed Int
d -> if Int
d forall a. Eq a => a -> a -> Bool
== Int
0
    then forall a. Monoid a => a
mempty
    else
      let newSubsecondPart :: Int64
newSubsecondPart = forall a. Integral a => a -> a -> a
quot Int64
nano (Int -> Int64
raiseTenTo (Int
9 forall a. Num a => a -> a -> a
- Int
d))
       in Char -> Builder
BB.char7 Char
'.'
          forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString (Int -> Char -> ByteString
BC.replicate (Int
d forall a. Num a => a -> a -> a
- forall a. Integral a => a -> Int
countDigits Int64
newSubsecondPart) Char
'0')
          forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
newSubsecondPart
  where
  (Int64
milli,Int64
milliRem) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
nano Int64
1000000
  (Int64
micro,Int64
microRem) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
nano Int64
1000

-- | Given a 'SubsecondPrecision', construct a 'ByteString' corresponding
--   to an encoding of the given 'Timespan'.
encodeTimespanUtf8 :: SubsecondPrecision -> Timespan -> ByteString
encodeTimespanUtf8 :: SubsecondPrecision -> Timespan -> ByteString
encodeTimespanUtf8 SubsecondPrecision
sp =
  ByteString -> ByteString
LB.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubsecondPrecision -> Timespan -> Builder
builderTimespanUtf8 SubsecondPrecision
sp

-- | Given a 'SubsecondPrecision', construct a 'ByteString' 'BB.Builder'
--   corresponding to an encoding of the given 'Timespan'.
builderTimespanUtf8 :: SubsecondPrecision -> Timespan -> BB.Builder
builderTimespanUtf8 :: SubsecondPrecision -> Timespan -> Builder
builderTimespanUtf8 SubsecondPrecision
sp (Timespan Int64
ns) =
  Int64 -> Builder
int64Builder Int64
sInt64 forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilderUtf8 SubsecondPrecision
sp Int64
nsRemainder
  where
  (!Int64
sInt64,!Int64
nsRemainder) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
ns Int64
1000000000

int64Builder :: Int64 -> BB.Builder
int64Builder :: Int64 -> Builder
int64Builder = Integer -> Builder
BB.integerDec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

internalBuilderUtf8_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> BB.Builder
internalBuilderUtf8_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilderUtf8_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns = case Maybe Char
msep of
  Maybe Char
Nothing -> Int -> Builder
indexTwoDigitByteStringBuilder Int
m
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
s
          forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilderUtf8 SubsecondPrecision
sp Int64
nsRemainder
  Just Char
sep -> let sepBuilder :: Builder
sepBuilder = Char -> Builder
BB.char7 Char
sep in
             Builder
sepBuilder
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
m
          forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
s
          forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilderUtf8 SubsecondPrecision
sp Int64
nsRemainder
  where
  (!Int64
sInt64,!Int64
nsRemainder) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
ns Int64
1000000000
  !s :: Int
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
sInt64

-- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct
--   a 'ByteString' corresponding to a Year\/Month\/Day,Hour\/Minute\/Second
--   encoding of the given 'Datetime'.
encodeUtf8_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString
encodeUtf8_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString
encodeUtf8_YmdHMS SubsecondPrecision
sp DatetimeFormat
format =
  ByteString -> ByteString
LB.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdHMS SubsecondPrecision
sp DatetimeFormat
format

-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a 'DatetimeFormat',
--   construct a 'ByteString' corresponding to a Year\/Month\/Day,IMS encoding
--   of the given 'Datetime'. This inserts a space between the locale and
--   seconds.
encodeUtf8_YmdIMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString
encodeUtf8_YmdIMS_p :: MeridiemLocale ByteString
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString
encodeUtf8_YmdIMS_p MeridiemLocale ByteString
a SubsecondPrecision
sp DatetimeFormat
b = ByteString -> ByteString
LB.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeridiemLocale ByteString
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdIMS_p MeridiemLocale ByteString
a SubsecondPrecision
sp DatetimeFormat
b

-- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct
--   a 'ByteString' 'BB.Builder' corresponding to a
--   Year\/Month\/Day,Hour\/Minute\/Second encoding of the
--   given 'Datetime'.
builderUtf8_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder
builderUtf8_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdHMS SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
  case Maybe Char
msep of
    Maybe Char
Nothing -> Maybe Char -> Date -> Builder
builderUtf8_Ymd Maybe Char
mdateSep Date
date
            forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builderUtf8_HMS SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time
    Just Char
sep -> Maybe Char -> Date -> Builder
builderUtf8_Ymd Maybe Char
mdateSep Date
date
             forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
sep
             forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builderUtf8_HMS SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct
--   a 'ByteString' 'BB.Builder' corresponding to a
--   Year\/Month\/Day,IMS encoding of the given 'Datetime'. This inserts
--   a space between the locale and seconds.
builderUtf8_YmdIMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder
builderUtf8_YmdIMS_p :: MeridiemLocale ByteString
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdIMS_p MeridiemLocale ByteString
locale SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
     Maybe Char -> Date -> Builder
builderUtf8_Ymd Maybe Char
mdateSep Date
date
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Char -> Builder
BB.char7 Maybe Char
msep
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale ByteString
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builderUtf8_IMS_p MeridiemLocale ByteString
locale SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct
--   a 'ByteString' 'BB.Builder' corresponding to a
--   Year\/Month\/Day,IMS encoding of the given 'Datetime'.
builderUtf8_YmdIMSp :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder
builderUtf8_YmdIMSp :: MeridiemLocale ByteString
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdIMSp MeridiemLocale ByteString
locale SubsecondPrecision
sp (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) (Datetime Date
date TimeOfDay
time) =
     Maybe Char -> Date -> Builder
builderUtf8_Ymd Maybe Char
mdateSep Date
date
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Char -> Builder
BB.char7 Maybe Char
msep
  forall a. Semigroup a => a -> a -> a
<> MeridiemLocale ByteString
-> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder
builderUtf8_IMS_p MeridiemLocale ByteString
locale SubsecondPrecision
sp Maybe Char
mtimeSep TimeOfDay
time

-- | Construct a 'ByteString' 'BB.Builder' corresponding to
--   a W3C encoding of the given 'Datetime'.
builderUtf8W3C :: Datetime -> BB.Builder
builderUtf8W3C :: Datetime -> Builder
builderUtf8W3C = SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdHMS SubsecondPrecision
SubsecondPrecisionAuto (Maybe Char -> Maybe Char -> Maybe Char -> DatetimeFormat
DatetimeFormat (forall a. a -> Maybe a
Just Char
'-') (forall a. a -> Maybe a
Just Char
'T') (forall a. a -> Maybe a
Just Char
':'))

-- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' from
--   a 'ByteString'.
decodeUtf8_YmdHMS :: DatetimeFormat -> ByteString -> Maybe Datetime
decodeUtf8_YmdHMS :: DatetimeFormat -> ByteString -> Maybe Datetime
decodeUtf8_YmdHMS DatetimeFormat
format =
  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 String a
AB.parseOnly (DatetimeFormat -> Parser Datetime
parserUtf8_YmdHMS DatetimeFormat
format)

-- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' that was
--   encoded using the given 'DatetimeFormat'.
parserUtf8_YmdHMS :: DatetimeFormat -> AB.Parser Datetime
parserUtf8_YmdHMS :: DatetimeFormat -> Parser Datetime
parserUtf8_YmdHMS (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
parserUtf8_Ymd Maybe Char
mdateSep
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AB.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parserUtf8_HMS Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

-- | Parses text that is formatted as either of the following:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
parserUtf8_YmdHMS_opt_S :: DatetimeFormat -> AB.Parser Datetime
parserUtf8_YmdHMS_opt_S :: DatetimeFormat -> Parser Datetime
parserUtf8_YmdHMS_opt_S (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
parserUtf8_Ymd Maybe Char
mdateSep
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Char
AB.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parserUtf8_HMS_opt_S Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

-- | Parses text that is formatted as either of the following:
--
-- * @%H:%M@
-- * @%H:%M:%S@
--
-- That is, the seconds and subseconds part is optional. If it is
-- not provided, it is assumed to be zero. This format shows up
-- in Google Chrome\'s @datetime-local@ inputs.
decodeUtf8_YmdHMS_opt_S :: DatetimeFormat -> ByteString -> Maybe Datetime
decodeUtf8_YmdHMS_opt_S :: DatetimeFormat -> ByteString -> Maybe Datetime
decodeUtf8_YmdHMS_opt_S DatetimeFormat
format =
  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 String a
AB.parseOnly (DatetimeFormat -> Parser Datetime
parserUtf8_YmdHMS_opt_S DatetimeFormat
format)

-- | Given an 'OffsetFormat', a 'SubsecondPrecision', and
--   a 'DatetimeFormat', construct a 'Text' 'TB.Builder'
--   corresponding to a Year\/Month\/Day,Hour\/Minute\/Second encoding
--   of the given 'OffsetDatetime'.
builder_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder
builder_YmdHMSz :: OffsetFormat
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builder_YmdHMSz OffsetFormat
offsetFormat SubsecondPrecision
sp DatetimeFormat
datetimeFormat (OffsetDatetime Datetime
datetime Offset
offset) =
     SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_YmdHMS SubsecondPrecision
sp DatetimeFormat
datetimeFormat Datetime
datetime
  forall a. Semigroup a => a -> a -> a
<> OffsetFormat -> Offset -> Builder
builderOffset OffsetFormat
offsetFormat Offset
offset

-- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'OffsetDatetime'
--   that was encoded using the given 'OffsetFormat'
--   and 'DatetimeFormat'.
parser_YmdHMSz :: OffsetFormat -> DatetimeFormat -> Parser OffsetDatetime
parser_YmdHMSz :: OffsetFormat -> DatetimeFormat -> Parser OffsetDatetime
parser_YmdHMSz OffsetFormat
offsetFormat DatetimeFormat
datetimeFormat = Datetime -> Offset -> OffsetDatetime
OffsetDatetime
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatetimeFormat -> Parser Datetime
parser_YmdHMS DatetimeFormat
datetimeFormat
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OffsetFormat -> Parser Offset
parserOffset OffsetFormat
offsetFormat

-- | Given an 'OffsetFormat', a 'MeridiemLocale', a
--   'SubsecondPrecision', and 'DatetimeFormat', construct a
--   'Text' 'TB.Builder' corresponding to a Year\/Month\/Day,IMS-encoding
--   of the given 'OffsetDatetime'.
builder_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder
builder_YmdIMS_p_z :: OffsetFormat
-> MeridiemLocale Text
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builder_YmdIMS_p_z OffsetFormat
offsetFormat MeridiemLocale Text
meridiemLocale SubsecondPrecision
sp DatetimeFormat
datetimeFormat (OffsetDatetime Datetime
datetime Offset
offset) =
     MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_YmdIMS_p MeridiemLocale Text
meridiemLocale SubsecondPrecision
sp DatetimeFormat
datetimeFormat Datetime
datetime
  forall a. Semigroup a => a -> a -> a
<> Builder
" "
  forall a. Semigroup a => a -> a -> a
<> OffsetFormat -> Offset -> Builder
builderOffset OffsetFormat
offsetFormat Offset
offset

-- | Given an 'OffsetFormat', a 'SubsecondPrecision',
--   and a 'DatetimeFormat', construct 'Text' corresponding to
--   the Year\/Month\/Day,Hour\/Minute\/Second-encoding of
--   the given 'OffsetDatetime'.
encode_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Text
encode_YmdHMSz :: OffsetFormat
-> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Text
encode_YmdHMSz OffsetFormat
offsetFormat SubsecondPrecision
sp DatetimeFormat
datetimeFormat =
    Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetFormat
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builder_YmdHMSz OffsetFormat
offsetFormat SubsecondPrecision
sp DatetimeFormat
datetimeFormat

-- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a
--   'DatetimeFormat', construct a 'Text' 'TB.Builder' corresponding
--   to the Day\/Month\/Year,Hour\/Minute\/Second-encoding of
--   the given 'OffsetDatetime'.
builder_DmyHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder
builder_DmyHMSz :: OffsetFormat
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builder_DmyHMSz OffsetFormat
offsetFormat SubsecondPrecision
sp DatetimeFormat
datetimeFormat (OffsetDatetime Datetime
datetime Offset
offset) =
     SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_DmyHMS SubsecondPrecision
sp DatetimeFormat
datetimeFormat Datetime
datetime
  forall a. Semigroup a => a -> a -> a
<> OffsetFormat -> Offset -> Builder
builderOffset OffsetFormat
offsetFormat Offset
offset

-- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'OffsetDatetime'
--   that was encoded using the given 'OffsetFormat'
--   and 'DatetimeFormat'.
parser_DmyHMSz :: OffsetFormat -> DatetimeFormat -> AT.Parser OffsetDatetime
parser_DmyHMSz :: OffsetFormat -> DatetimeFormat -> Parser OffsetDatetime
parser_DmyHMSz OffsetFormat
offsetFormat DatetimeFormat
datetimeFormat = Datetime -> Offset -> OffsetDatetime
OffsetDatetime
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatetimeFormat -> Parser Datetime
parser_DmyHMS DatetimeFormat
datetimeFormat
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OffsetFormat -> Parser Offset
parserOffset OffsetFormat
offsetFormat

-- | Given an 'OffsetFormat', a 'MeridiemLocale', a
--   'SubsecondPrecision', and a 'DatetimeFormat', construct a 'Text'
--   'TB.Builder' corresponding to the Day\/Month\/Year,IMS encoding
--   of the given 'OffsetDatetime'.
builder_DmyIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder
builder_DmyIMS_p_z :: OffsetFormat
-> MeridiemLocale Text
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builder_DmyIMS_p_z OffsetFormat
offsetFormat MeridiemLocale Text
meridiemLocale SubsecondPrecision
sp DatetimeFormat
datetimeFormat (OffsetDatetime Datetime
datetime Offset
offset) =
      MeridiemLocale Text
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builder_DmyIMS_p MeridiemLocale Text
meridiemLocale SubsecondPrecision
sp DatetimeFormat
datetimeFormat Datetime
datetime
   forall a. Semigroup a => a -> a -> a
<> Builder
" "
   forall a. Semigroup a => a -> a -> a
<> OffsetFormat -> Offset -> Builder
builderOffset OffsetFormat
offsetFormat Offset
offset

-- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a
--   'DatetimeFormat', construct 'Text' corresponding to the
--   Day\/Month\/Year,Hour\/Minute\/Second encoding of the given
--   'OffsetDatetime'.
encode_DmyHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Text
encode_DmyHMSz :: OffsetFormat
-> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Text
encode_DmyHMSz OffsetFormat
offsetFormat SubsecondPrecision
sp DatetimeFormat
datetimeFormat =
    Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetFormat
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builder_DmyHMSz OffsetFormat
offsetFormat SubsecondPrecision
sp DatetimeFormat
datetimeFormat

-- | Construct a 'Text' 'TB.Builder' corresponding to the w3c-formatting
--   of the given 'OffsetDatetime'.
builderW3Cz :: OffsetDatetime -> TB.Builder
builderW3Cz :: OffsetDatetime -> Builder
builderW3Cz = OffsetFormat
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builder_YmdHMSz
  OffsetFormat
OffsetFormatColonOn
  SubsecondPrecision
SubsecondPrecisionAuto
  (Maybe Char -> Maybe Char -> Maybe Char -> DatetimeFormat
DatetimeFormat (forall a. a -> Maybe a
Just Char
'-') (forall a. a -> Maybe a
Just Char
'T') (forall a. a -> Maybe a
Just Char
':'))

-- | Encode an 'Offset' to 'Text' using the given 'OffsetFormat'.
encodeOffset :: OffsetFormat -> Offset -> Text
encodeOffset :: OffsetFormat -> Offset -> Text
encodeOffset OffsetFormat
fmt = Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetFormat -> Offset -> Builder
builderOffset OffsetFormat
fmt

-- | Construct a 'TB.Builder' corresponding to the given 'Offset'
--   encoded using the given 'OffsetFormat'.
builderOffset :: OffsetFormat -> Offset -> TB.Builder
builderOffset :: OffsetFormat -> Offset -> Builder
builderOffset OffsetFormat
x = case OffsetFormat
x of
  OffsetFormat
OffsetFormatColonOff -> Offset -> Builder
builderOffset_z
  OffsetFormat
OffsetFormatColonOn -> Offset -> Builder
builderOffset_z1
  OffsetFormat
OffsetFormatSecondsPrecision -> Offset -> Builder
builderOffset_z2
  OffsetFormat
OffsetFormatColonAuto -> Offset -> Builder
builderOffset_z3

-- | Decode an 'Offset' from 'Text' that was encoded
--   using the given 'OffsetFormat'.
decodeOffset :: OffsetFormat -> Text -> Maybe Offset
decodeOffset :: OffsetFormat -> Text -> Maybe Offset
decodeOffset OffsetFormat
fmt =
  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 -> Text -> Either String a
AT.parseOnly (OffsetFormat -> Parser Offset
parserOffset OffsetFormat
fmt forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
AT.endOfInput)

-- | Parse an 'Offset' that was encoded using the given 'OffsetFormat'.
parserOffset :: OffsetFormat -> Parser Offset
parserOffset :: OffsetFormat -> Parser Offset
parserOffset OffsetFormat
x = case OffsetFormat
x of
  OffsetFormat
OffsetFormatColonOff -> Parser Offset
parserOffset_z
  OffsetFormat
OffsetFormatColonOn -> Parser Offset
parserOffset_z1
  OffsetFormat
OffsetFormatSecondsPrecision -> Parser Offset
parserOffset_z2
  OffsetFormat
OffsetFormatColonAuto -> Parser Offset
parserOffset_z3

-- | True means positive, false means negative
parseSignedness :: Parser Bool
parseSignedness :: Parser Bool
parseSignedness = do
  Char
c <- Parser Char
AT.anyChar
  if Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    else if Char
c forall a. Eq a => a -> a -> Bool
== Char
'+'
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"while parsing offset, expected [+] or [-]"

parserOffset_z :: Parser Offset
parserOffset_z :: Parser Offset
parserOffset_z = do
  Bool
pos <- Parser Bool
parseSignedness
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  let !res :: Int
res = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
    then Int
res
    else forall a. Num a => a -> a
negate Int
res

parserOffset_z1 :: Parser Offset
parserOffset_z1 :: Parser Offset
parserOffset_z1 = do
  Bool
pos <- Parser Bool
parseSignedness
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  Char
_ <- Char -> Parser Char
AT.char Char
':'
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  let !res :: Int
res = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
    then Int
res
    else forall a. Num a => a -> a
negate Int
res

parserOffset_z2 :: AT.Parser Offset
parserOffset_z2 :: Parser Offset
parserOffset_z2 = do
  Bool
pos <- Parser Bool
parseSignedness
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  Char
_ <- Char -> Parser Char
AT.char Char
':'
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Text
_ <- Text -> Parser Text
AT.string Text
":00"
  let !res :: Int
res = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
    then Int
res
    else forall a. Num a => a -> a
negate Int
res

-- | This is generous in what it accepts. If you give
--   something like +04:00 as the offset, it will be
--   allowed, even though it could be shorter.
parserOffset_z3 :: AT.Parser Offset
parserOffset_z3 :: Parser Offset
parserOffset_z3 = do
  Bool
pos <- Parser Bool
parseSignedness
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  Maybe Char
mc <- Parser (Maybe Char)
AT.peekChar
  case Maybe Char
mc of
    Just Char
':' -> do
      Char
_ <- Parser Char
AT.anyChar -- should be a colon
      Int
m <- Int -> Parser Int
parseFixedDigits Int
2
      let !res :: Int
res = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
        then Int
res
        else forall a. Num a => a -> a
negate Int
res
    Maybe Char
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
      then Int
h forall a. Num a => a -> a -> a
* Int
60
      else Int
h forall a. Num a => a -> a -> a
* (-Int
60)

builderOffset_z :: Offset -> TB.Builder
builderOffset_z :: Offset -> Builder
builderOffset_z (Offset Int
i) =
  let (!Int
a,!Int
b) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if forall a. Num a => a -> a
signum Int
i forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
b

builderOffset_z1 :: Offset -> TB.Builder
builderOffset_z1 :: Offset -> Builder
builderOffset_z1 (Offset Int
i) =
  let (!Int
a,!Int
b) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if forall a. Num a => a -> a
signum Int
i forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
      forall a. Semigroup a => a -> a -> a
<> Builder
":"
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
b

builderOffset_z2 :: Offset -> TB.Builder
builderOffset_z2 :: Offset -> Builder
builderOffset_z2 (Offset Int
i) =
  let (!Int
a,!Int
b) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if forall a. Num a => a -> a
signum Int
i forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
      forall a. Semigroup a => a -> a -> a
<> Builder
":"
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
b
      forall a. Semigroup a => a -> a -> a
<> Builder
":00"

builderOffset_z3 :: Offset -> TB.Builder
builderOffset_z3 :: Offset -> Builder
builderOffset_z3 (Offset Int
i) =
  let (!Int
a,!Int
b) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if forall a. Num a => a -> a
signum Int
i forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in if Int
b forall a. Eq a => a -> a -> Bool
== Int
0
        then Builder
prefix
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
        else Builder
prefix
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
          forall a. Semigroup a => a -> a -> a
<> Builder
":"
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
b

-- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a
--   'DatetimeFormat', construct a 'ByteString' 'BB.Builder'
--   corresponding to the Year\/Month\/Day,Hour\/Minute\/Second
--   encoding of the given 'OffsetDatetime'.
builderUtf8_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> BB.Builder
builderUtf8_YmdHMSz :: OffsetFormat
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builderUtf8_YmdHMSz OffsetFormat
offsetFormat SubsecondPrecision
sp DatetimeFormat
datetimeFormat (OffsetDatetime Datetime
datetime Offset
offset) =
     SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdHMS SubsecondPrecision
sp DatetimeFormat
datetimeFormat Datetime
datetime
  forall a. Semigroup a => a -> a -> a
<> OffsetFormat -> Offset -> Builder
builderOffsetUtf8 OffsetFormat
offsetFormat Offset
offset

-- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'OffsetDatetime'
--   that was encoded using the given 'OffsetFormat' and
--   'DatetimeFormat'.
parserUtf8_YmdHMSz :: OffsetFormat -> DatetimeFormat -> AB.Parser OffsetDatetime
parserUtf8_YmdHMSz :: OffsetFormat -> DatetimeFormat -> Parser OffsetDatetime
parserUtf8_YmdHMSz OffsetFormat
offsetFormat DatetimeFormat
datetimeFormat = Datetime -> Offset -> OffsetDatetime
OffsetDatetime
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatetimeFormat -> Parser Datetime
parserUtf8_YmdHMS DatetimeFormat
datetimeFormat
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OffsetFormat -> Parser Offset
parserOffsetUtf8 OffsetFormat
offsetFormat

-- | Given an 'OffsetFormat', a 'MeridiemLocale, a 'SubsecondPrecision',
--   and a 'DatetimeFormat', construct a 'ByteString' 'BB.Builder'
--   corresponding to a Year\/Month\/Day,IMS-encoded 'OffsetDatetime'.
builderUtf8_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> BB.Builder
builderUtf8_YmdIMS_p_z :: OffsetFormat
-> MeridiemLocale ByteString
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builderUtf8_YmdIMS_p_z OffsetFormat
offsetFormat MeridiemLocale ByteString
meridiemLocale SubsecondPrecision
sp DatetimeFormat
datetimeFormat (OffsetDatetime Datetime
datetime Offset
offset) =
     MeridiemLocale ByteString
-> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdIMS_p MeridiemLocale ByteString
meridiemLocale SubsecondPrecision
sp DatetimeFormat
datetimeFormat Datetime
datetime
  forall a. Semigroup a => a -> a -> a
<> Builder
" "
  forall a. Semigroup a => a -> a -> a
<> OffsetFormat -> Offset -> Builder
builderOffsetUtf8 OffsetFormat
offsetFormat Offset
offset

-- | Construct a 'ByteString' 'BB.Builder' corresponding to the W3C
--   encoding of the given 'Datetime'.
builderUtf8W3Cz :: OffsetDatetime -> BB.Builder
builderUtf8W3Cz :: OffsetDatetime -> Builder
builderUtf8W3Cz = OffsetFormat
-> SubsecondPrecision
-> DatetimeFormat
-> OffsetDatetime
-> Builder
builderUtf8_YmdHMSz
  OffsetFormat
OffsetFormatColonOn
  SubsecondPrecision
SubsecondPrecisionAuto
  (Maybe Char -> Maybe Char -> Maybe Char -> DatetimeFormat
DatetimeFormat (forall a. a -> Maybe a
Just Char
'-') (forall a. a -> Maybe a
Just Char
'T') (forall a. a -> Maybe a
Just Char
':'))

-- | Encode an 'Offset' as a 'ByteString' using the given 'OffsetFormat'.
encodeOffsetUtf8 :: OffsetFormat -> Offset -> ByteString
encodeOffsetUtf8 :: OffsetFormat -> Offset -> ByteString
encodeOffsetUtf8 OffsetFormat
fmt = ByteString -> ByteString
LB.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetFormat -> Offset -> Builder
builderOffsetUtf8 OffsetFormat
fmt

-- | Decode an 'Offset' from a 'ByteString' that was encoded using the given
--   'OffsetFormat'.
decodeOffsetUtf8 :: OffsetFormat -> ByteString -> Maybe Offset
decodeOffsetUtf8 :: OffsetFormat -> ByteString -> Maybe Offset
decodeOffsetUtf8 OffsetFormat
fmt =
  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 String a
AB.parseOnly (OffsetFormat -> Parser Offset
parserOffsetUtf8 OffsetFormat
fmt)

-- | Construct a 'ByteString' 'BB.Builder' corresponding to the
--   encoding of an 'Offset' using the given 'OffsetFormat'.
builderOffsetUtf8 :: OffsetFormat -> Offset -> BB.Builder
builderOffsetUtf8 :: OffsetFormat -> Offset -> Builder
builderOffsetUtf8 OffsetFormat
x = case OffsetFormat
x of
  OffsetFormat
OffsetFormatColonOff -> Offset -> Builder
builderOffsetUtf8_z
  OffsetFormat
OffsetFormatColonOn -> Offset -> Builder
builderOffsetUtf8_z1
  OffsetFormat
OffsetFormatSecondsPrecision -> Offset -> Builder
builderOffsetUtf8_z2
  OffsetFormat
OffsetFormatColonAuto -> Offset -> Builder
builderOffsetUtf8_z3

-- | Parse an 'Offset' that was encoded using the given
--   'OffsetFormat'.
parserOffsetUtf8 :: OffsetFormat -> AB.Parser Offset
parserOffsetUtf8 :: OffsetFormat -> Parser Offset
parserOffsetUtf8 OffsetFormat
x = case OffsetFormat
x of
  OffsetFormat
OffsetFormatColonOff -> Parser Offset
parserOffsetUtf8_z
  OffsetFormat
OffsetFormatColonOn -> Parser Offset
parserOffsetUtf8_z1
  OffsetFormat
OffsetFormatSecondsPrecision -> Parser Offset
parserOffsetUtf8_z2
  OffsetFormat
OffsetFormatColonAuto -> Parser Offset
parserOffsetUtf8_z3

-- | True means positive, false means negative
parseSignednessUtf8 :: AB.Parser Bool
parseSignednessUtf8 :: Parser Bool
parseSignednessUtf8 = do
  Char
c <- Parser Char
AB.anyChar
  if Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    else if Char
c forall a. Eq a => a -> a -> Bool
== Char
'+'
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"while parsing offset, expected [+] or [-]"

parserOffsetUtf8_z :: AB.Parser Offset
parserOffsetUtf8_z :: Parser Offset
parserOffsetUtf8_z = do
  Bool
pos <- Parser Bool
parseSignednessUtf8
  Int
h <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  let !res :: Int
res = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
    then Int
res
    else forall a. Num a => a -> a
negate Int
res

parserOffsetUtf8_z1 :: AB.Parser Offset
parserOffsetUtf8_z1 :: Parser Offset
parserOffsetUtf8_z1 = do
  Bool
pos <- Parser Bool
parseSignednessUtf8
  Int
h <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Char
_ <- Char -> Parser Char
AB.char Char
':'
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  let !res :: Int
res = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
    then Int
res
    else forall a. Num a => a -> a
negate Int
res

parserOffsetUtf8_z2 :: AB.Parser Offset
parserOffsetUtf8_z2 :: Parser Offset
parserOffsetUtf8_z2 = do
  Bool
pos <- Parser Bool
parseSignednessUtf8
  Int
h <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Char
_ <- Char -> Parser Char
AB.char Char
':'
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  ByteString
_ <- ByteString -> Parser ByteString
AB.string ByteString
":00"
  let !res :: Int
res = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
    then Int
res
    else forall a. Num a => a -> a
negate Int
res

-- | This is generous in what it accepts. If you give
--   something like +04:00 as the offset, it will be
--   allowed, even though it could be shorter.
parserOffsetUtf8_z3 :: AB.Parser Offset
parserOffsetUtf8_z3 :: Parser Offset
parserOffsetUtf8_z3 = do
  Bool
pos <- Parser Bool
parseSignednessUtf8
  Int
h <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Maybe Char
mc <- Parser (Maybe Char)
AB.peekChar
  case Maybe Char
mc of
    Just Char
':' -> do
      Char
_ <- Parser Char
AB.anyChar -- should be a colon
      Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
      let !res :: Int
res = Int
h forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
m
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
        then Int
res
        else forall a. Num a => a -> a
negate Int
res
    Maybe Char
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset forall a b. (a -> b) -> a -> b
$ if Bool
pos
      then Int
h forall a. Num a => a -> a -> a
* Int
60
      else Int
h forall a. Num a => a -> a -> a
* (-Int
60)

builderOffsetUtf8_z :: Offset -> BB.Builder
builderOffsetUtf8_z :: Offset -> Builder
builderOffsetUtf8_z (Offset Int
i) =
  let (!Int
a,!Int
b) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if forall a. Num a => a -> a
signum Int
i forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
b

builderOffsetUtf8_z1 :: Offset -> BB.Builder
builderOffsetUtf8_z1 :: Offset -> Builder
builderOffsetUtf8_z1 (Offset Int
i) =
  let (!Int
a,!Int
b) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if forall a. Num a => a -> a
signum Int
i forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
      forall a. Semigroup a => a -> a -> a
<> Builder
":"
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
b

builderOffsetUtf8_z2 :: Offset -> BB.Builder
builderOffsetUtf8_z2 :: Offset -> Builder
builderOffsetUtf8_z2 (Offset Int
i) =
  let (!Int
a,!Int
b) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if forall a. Num a => a -> a
signum Int
i forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
      forall a. Semigroup a => a -> a -> a
<> Builder
":"
      forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
b
      forall a. Semigroup a => a -> a -> a
<> Builder
":00"

builderOffsetUtf8_z3 :: Offset -> BB.Builder
builderOffsetUtf8_z3 :: Offset -> Builder
builderOffsetUtf8_z3 (Offset Int
i) =
  let (!Int
a,!Int
b) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if forall a. Num a => a -> a
signum Int
i forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in if Int
b forall a. Eq a => a -> a -> Bool
== Int
0
        then Builder
prefix
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
        else Builder
prefix
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
          forall a. Semigroup a => a -> a -> a
<> Builder
":"
          forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
b

-- Zepto parsers

-- | Parse a 'Datetime' that was encoded using the
--   given 'DatetimeFormat'.
zeptoUtf8_YmdHMS :: DatetimeFormat -> Z.Parser Datetime
zeptoUtf8_YmdHMS :: DatetimeFormat -> Parser Datetime
zeptoUtf8_YmdHMS (DatetimeFormat Maybe Char
mdateSep Maybe Char
msep' Maybe Char
mtimeSep) = do
  Date
date <- Maybe Char -> Parser Date
zeptoUtf8_Ymd Maybe Char
mdateSep
  let msep :: Maybe ByteString
msep = Char -> ByteString
BC.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
msep'
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
zeptoUtf8_HMS Maybe Char
mtimeSep
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> TimeOfDay -> Datetime
Datetime Date
date TimeOfDay
time)

zeptoCountZeroes :: Z.Parser Int
zeptoCountZeroes :: Parser Int
zeptoCountZeroes = do
  ByteString
bs <- forall (m :: * -> *).
Monad m =>
(Word8 -> Bool) -> ZeptoT m ByteString
Z.takeWhile (Word8
0x30 forall a. Eq a => a -> a -> Bool
==)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! ByteString -> Int
BC.length ByteString
bs

-- | Parse a 'Date' that was encoded using
--   the given separator.
zeptoUtf8_Ymd :: Maybe Char -> Z.Parser Date
zeptoUtf8_Ymd :: Maybe Char -> Parser Date
zeptoUtf8_Ymd Maybe Char
msep' = do
  Int
y <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
4
  let msep :: Maybe ByteString
msep = Char -> ByteString
BC.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
msep'
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  Int
m <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
12) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  Int
d <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d forall a. Ord a => a -> a -> Bool
> Int
31) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month forall a b. (a -> b) -> a -> b
$ Int
m forall a. Num a => a -> a -> a
- Int
1) (Int -> DayOfMonth
DayOfMonth Int
d))

-- | Parse a 'TimeOfDay' that was encoded using
--   the given separator.
zeptoUtf8_HMS :: Maybe Char -> Z.Parser TimeOfDay
zeptoUtf8_HMS :: Maybe Char -> Parser TimeOfDay
zeptoUtf8_HMS Maybe Char
msep' = do
  Int
h <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h forall a. Ord a => a -> a -> Bool
> Int
23) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  let msep :: Maybe ByteString
msep = Char -> ByteString
BC.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
msep'
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  Int
m <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
2
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m forall a. Ord a => a -> a -> Bool
> Int
59) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  Int64
ns <- Parser Int64
zeptoSecondsAndNanosecondsUtf8
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)

zeptoFixedDigitsIntBS :: Int -> Z.Parser Int
zeptoFixedDigitsIntBS :: Int -> Parser Int
zeptoFixedDigitsIntBS Int
n = do
  ByteString
t <- forall (m :: * -> *). Monad m => Int -> ZeptoT m ByteString
Z.take Int
n
  case ByteString -> Maybe (Int, ByteString)
BC.readInt ByteString
t of
    Maybe (Int, ByteString)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"datetime decoding could not parse integral bytestring (a)"
    Just (Int
i,ByteString
r) -> if ByteString -> Bool
BC.null ByteString
r
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
      else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"datetime decoding could not parse integral bytestring (b)"

zeptoSecondsAndNanosecondsUtf8 :: Z.Parser Int64
zeptoSecondsAndNanosecondsUtf8 :: Parser Int64
zeptoSecondsAndNanosecondsUtf8 = do
  Int
s' <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
2
  let s :: Int64
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s' :: Int64
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
s forall a. Ord a => a -> a -> Bool
> Int64
60) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"seconds must be between 0 and 60")
  Int64
nanoseconds <-
    ( do ()
_ <- forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string ByteString
"."
         Int
numberOfZeroes <- Parser Int
zeptoCountZeroes
         Int64
x <- Parser Int64
zdecimal
         let totalDigits :: Int
totalDigits = forall a. Integral a => a -> Int
countDigits Int64
x forall a. Num a => a -> a -> a
+ Int
numberOfZeroes
             result :: Int64
result = if Int
totalDigits forall a. Eq a => a -> a -> Bool
== Int
9
               then Int64
x
               else if Int
totalDigits forall a. Ord a => a -> a -> Bool
< Int
9
                 then Int64
x forall a. Num a => a -> a -> a
* Int -> Int64
raiseTenTo (Int
9 forall a. Num a => a -> a -> a
- Int
totalDigits)
                 else forall a. Integral a => a -> a -> a
quot Int64
x (Int -> Int64
raiseTenTo (Int
totalDigits forall a. Num a => a -> a -> a
- Int
9))
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
result)
    ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
s forall a. Num a => a -> a -> a
* Int64
1000000000 forall a. Num a => a -> a -> a
+ Int64
nanoseconds)

zdecimal :: Z.Parser Int64
zdecimal :: Parser Int64
zdecimal = do
  ByteString
digits <- forall (m :: * -> *).
Monad m =>
(Word8 -> Bool) -> ZeptoT m ByteString
Z.takeWhile Word8 -> Bool
wordIsDigit
  case ByteString -> Maybe (Int, ByteString)
BC.readInt ByteString
digits of
    Maybe (Int, ByteString)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"somehow this didn't work"
    Just (Int
i,ByteString
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i

wordIsDigit :: Word8 -> Bool
wordIsDigit :: Word8 -> Bool
wordIsDigit Word8
a = Word8
0x30 forall a. Ord a => a -> a -> Bool
<= Word8
a Bool -> Bool -> Bool
&& Word8
a forall a. Ord a => a -> a -> Bool
<= Word8
0x39

-- | The 'Month' of January.
january :: Month
january :: Month
january = Int -> Month
Month Int
0

-- | The 'Month' of February.
february :: Month
february :: Month
february = Int -> Month
Month Int
1

-- | The 'Month' of March.
march :: Month
march :: Month
march = Int -> Month
Month Int
2

-- | The 'Month' of April.
april :: Month
april :: Month
april = Int -> Month
Month Int
3

-- | The 'Month' of May.
may :: Month
may :: Month
may = Int -> Month
Month Int
4

-- | The 'Month' of June.
june :: Month
june :: Month
june = Int -> Month
Month Int
5

-- | The 'Month' of July.
july :: Month
july :: Month
july = Int -> Month
Month Int
6

-- | The 'Month' of August.
august :: Month
august :: Month
august = Int -> Month
Month Int
7

-- | The 'Month' of September.
september :: Month
september :: Month
september = Int -> Month
Month Int
8

-- | The 'Month' of October.
october :: Month
october :: Month
october = Int -> Month
Month Int
9

-- | The 'Month' of November.
november :: Month
november :: Month
november = Int -> Month
Month Int
10

-- | The 'Month' of December.
december :: Month
december :: Month
december = Int -> Month
Month Int
11

-- | The 'DayOfWeek' Sunday.
sunday :: DayOfWeek
sunday :: DayOfWeek
sunday = Int -> DayOfWeek
DayOfWeek Int
0

-- | The 'DayOfWeek' Monday.
monday :: DayOfWeek
monday :: DayOfWeek
monday = Int -> DayOfWeek
DayOfWeek Int
1

-- | The 'DayOfWeek' Tuesday.
tuesday :: DayOfWeek
tuesday :: DayOfWeek
tuesday = Int -> DayOfWeek
DayOfWeek Int
2

-- | The 'DayOfWeek' Wednesday.
wednesday :: DayOfWeek
wednesday :: DayOfWeek
wednesday = Int -> DayOfWeek
DayOfWeek Int
3

-- | The 'DayOfWeek' Thursday.
thursday :: DayOfWeek
thursday :: DayOfWeek
thursday = Int -> DayOfWeek
DayOfWeek Int
4

-- | The 'DayOfWeek' Friday.
friday :: DayOfWeek
friday :: DayOfWeek
friday = Int -> DayOfWeek
DayOfWeek Int
5

-- | The 'DayOfWeek' Saturday.
saturday :: DayOfWeek
saturday :: DayOfWeek
saturday = Int -> DayOfWeek
DayOfWeek Int
6

countDigits :: (Integral a) => a -> Int
countDigits :: forall a. Integral a => a -> Int
countDigits a
v0
  | forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v64 forall a. Eq a => a -> a -> Bool
== a
v0 = forall {t}. Num t => t -> Word64 -> t
go Int
1 Word64
v64
  | Bool
otherwise              = Int -> Integer -> Int
goBig Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v0)
  where v64 :: Word64
v64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v0
        goBig :: Int -> Integer -> Int
goBig !Int
k (Integer
v :: Integer)
           | Integer
v forall a. Ord a => a -> a -> Bool
> Integer
big   = Int -> Integer -> Int
goBig (Int
k forall a. Num a => a -> a -> a
+ Int
19) (Integer
v forall a. Integral a => a -> a -> a
`quot` Integer
big)
           | Bool
otherwise = forall {t}. Num t => t -> Word64 -> t
go Int
k (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v)
        big :: Integer
big = Integer
10000000000000000000
        go :: t -> Word64 -> t
go !t
k (Word64
v :: Word64)
           | Word64
v forall a. Ord a => a -> a -> Bool
< Word64
10    = t
k
           | Word64
v forall a. Ord a => a -> a -> Bool
< Word64
100   = t
k forall a. Num a => a -> a -> a
+ t
1
           | Word64
v forall a. Ord a => a -> a -> Bool
< Word64
1000  = t
k forall a. Num a => a -> a -> a
+ t
2
           | Word64
v forall a. Ord a => a -> a -> Bool
< Word64
1000000000000 =
               t
k forall a. Num a => a -> a -> a
+ if Word64
v forall a. Ord a => a -> a -> Bool
< Word64
100000000
                   then if Word64
v forall a. Ord a => a -> a -> Bool
< Word64
1000000
                        then if Word64
v forall a. Ord a => a -> a -> Bool
< Word64
10000
                             then t
3
                             else t
4 forall a. Num a => a -> a -> a
+ forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
100000
                        else t
6 forall a. Num a => a -> a -> a
+ forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
10000000
                   else if Word64
v forall a. Ord a => a -> a -> Bool
< Word64
10000000000
                        then t
8 forall a. Num a => a -> a -> a
+ forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
1000000000
                        else t
10 forall a. Num a => a -> a -> a
+ forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
100000000000
           | Bool
otherwise = t -> Word64 -> t
go (t
k forall a. Num a => a -> a -> a
+ t
12) (Word64
v forall a. Integral a => a -> a -> a
`quot` Word64
1000000000000)
        fin :: a -> a -> a
fin a
v a
n = if a
v forall a. Ord a => a -> a -> Bool
>= a
n then a
1 else a
0

clip :: (Ord t) => t -> t -> t -> t
clip :: forall t. Ord t => t -> t -> t -> t
clip t
a t
_ t
x | t
x forall a. Ord a => a -> a -> Bool
< t
a = t
a
clip t
_ t
b t
x | t
x forall a. Ord a => a -> a -> Bool
> t
b = t
b
clip t
_ t
_ t
x = t
x

parseFixedDigits :: Int -> AT.Parser Int
parseFixedDigits :: Int -> Parser Int
parseFixedDigits Int
n = do
  Text
t <- Int -> Parser Text
AT.take Int
n
  case forall a. Integral a => Reader a
Text.decimal Text
t of
    Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Right (Int
i,Text
r) -> if Text -> Bool
Text.null Text
r
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
      else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"datetime decoding could not parse integral text"

parseFixedDigitsIntBS :: Int -> AB.Parser Int
parseFixedDigitsIntBS :: Int -> Parser Int
parseFixedDigitsIntBS Int
n = do
  ByteString
t <- Int -> Parser ByteString
AB.take Int
n
  case ByteString -> Maybe (Int, ByteString)
BC.readInt ByteString
t of
    Maybe (Int, ByteString)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"datetime decoding could not parse integral bytestring (a)"
    Just (Int
i,ByteString
r) -> if ByteString -> Bool
BC.null ByteString
r
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
      else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"datetime decoding could not parse integral bytestring (b)"

-- Only provide positive numbers to this function.
indexTwoDigitTextBuilder :: Int -> TB.Builder
indexTwoDigitTextBuilder :: Int -> Builder
indexTwoDigitTextBuilder Int
i = if Int
i forall a. Ord a => a -> a -> Bool
< Int
100
  then forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector Builder
twoDigitTextBuilder (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  else forall a. Integral a => a -> Builder
TB.decimal Int
i

-- | Only provide positive numbers to this function.
indexTwoDigitByteStringBuilder :: Int -> BB.Builder
indexTwoDigitByteStringBuilder :: Int -> Builder
indexTwoDigitByteStringBuilder Int
i = if Int
i forall a. Ord a => a -> a -> Bool
< Int
100
  then forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector Builder
twoDigitByteStringBuilder (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  else Int -> Builder
BB.intDec Int
i

twoDigitByteStringBuilder :: Vector BB.Builder
twoDigitByteStringBuilder :: Vector Builder
twoDigitByteStringBuilder = forall a. [a] -> Vector a
Vector.fromList
  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Builder
BB.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack) [String]
twoDigitStrings
{-# NOINLINE twoDigitByteStringBuilder #-}

twoDigitTextBuilder :: Vector TB.Builder
twoDigitTextBuilder :: Vector Builder
twoDigitTextBuilder = forall a. [a] -> Vector a
Vector.fromList
  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Builder
TB.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) [String]
twoDigitStrings
{-# NOINLINE twoDigitTextBuilder #-}

twoDigitStrings :: [String]
twoDigitStrings :: [String]
twoDigitStrings =
  [ String
"00",String
"01",String
"02",String
"03",String
"04",String
"05",String
"06",String
"07",String
"08",String
"09"
  , String
"10",String
"11",String
"12",String
"13",String
"14",String
"15",String
"16",String
"17",String
"18",String
"19"
  , String
"20",String
"21",String
"22",String
"23",String
"24",String
"25",String
"26",String
"27",String
"28",String
"29"
  , String
"30",String
"31",String
"32",String
"33",String
"34",String
"35",String
"36",String
"37",String
"38",String
"39"
  , String
"40",String
"41",String
"42",String
"43",String
"44",String
"45",String
"46",String
"47",String
"48",String
"49"
  , String
"50",String
"51",String
"52",String
"53",String
"54",String
"55",String
"56",String
"57",String
"58",String
"59"
  , String
"60",String
"61",String
"62",String
"63",String
"64",String
"65",String
"66",String
"67",String
"68",String
"69"
  , String
"70",String
"71",String
"72",String
"73",String
"74",String
"75",String
"76",String
"77",String
"78",String
"79"
  , String
"80",String
"81",String
"82",String
"83",String
"84",String
"85",String
"86",String
"87",String
"88",String
"89"
  , String
"90",String
"91",String
"92",String
"93",String
"94",String
"95",String
"96",String
"97",String
"98",String
"99"
  ]

raiseTenTo :: Int -> Int64
raiseTenTo :: Int -> Int64
raiseTenTo Int
i = if Int
i forall a. Ord a => a -> a -> Bool
> Int
15
  then Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i
  else forall a. Unbox a => Vector a -> Int -> a
UVector.unsafeIndex Vector Int64
tenRaisedToSmallPowers Int
i

tenRaisedToSmallPowers :: UVector.Vector Int64
tenRaisedToSmallPowers :: Vector Int64
tenRaisedToSmallPowers = forall a. Unbox a => [a] -> Vector a
UVector.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^) [Int
0 :: Int ..Int
15]

yearToZeroPaddedDigit :: Year -> TB.Builder
yearToZeroPaddedDigit :: Year -> Builder
yearToZeroPaddedDigit (Year Int
x)
  | Int
x forall a. Ord a => a -> a -> Bool
< Int
10 = Builder
"000" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int
x
  | Int
x forall a. Ord a => a -> a -> Bool
< Int
100 = Builder
"00" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int
x
  | Int
x forall a. Ord a => a -> a -> Bool
< Int
1000 = Builder
"0" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TB.decimal Int
x
  | Bool
otherwise = forall a. Integral a => a -> Builder
TB.decimal Int
x

monthToZeroPaddedDigit :: Month -> TB.Builder
monthToZeroPaddedDigit :: Month -> Builder
monthToZeroPaddedDigit (Month Int
x) =
  Int -> Builder
indexTwoDigitTextBuilder (Int
x forall a. Num a => a -> a -> a
+ Int
1)

zeroPadDayOfMonth :: DayOfMonth -> TB.Builder
zeroPadDayOfMonth :: DayOfMonth -> Builder
zeroPadDayOfMonth (DayOfMonth Int
d) = Int -> Builder
indexTwoDigitTextBuilder Int
d

yearToZeroPaddedDigitBS :: Year -> BB.Builder
yearToZeroPaddedDigitBS :: Year -> Builder
yearToZeroPaddedDigitBS (Year Int
x)
  | Int
x forall a. Ord a => a -> a -> Bool
< Int
10 = Builder
"000" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
x
  | Int
x forall a. Ord a => a -> a -> Bool
< Int
100 = Builder
"00" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
x
  | Int
x forall a. Ord a => a -> a -> Bool
< Int
1000 = Builder
"0" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
x
  | Bool
otherwise = Int -> Builder
BB.intDec Int
x

monthToZeroPaddedDigitBS :: Month -> BB.Builder
monthToZeroPaddedDigitBS :: Month -> Builder
monthToZeroPaddedDigitBS (Month Int
x) =
  Int -> Builder
indexTwoDigitByteStringBuilder (Int
x forall a. Num a => a -> a -> a
+ Int
1)

zeroPadDayOfMonthBS :: DayOfMonth -> BB.Builder
zeroPadDayOfMonthBS :: DayOfMonth -> Builder
zeroPadDayOfMonthBS (DayOfMonth Int
d) = Int -> Builder
indexTwoDigitByteStringBuilder Int
d

-- | Is the given 'Time' within the 'TimeInterval'?
within :: Time -> TimeInterval -> Bool
Time
t within :: Time -> TimeInterval -> Bool
`within` (TimeInterval Time
t0 Time
t1) = Time
t forall a. Ord a => a -> a -> Bool
>= Time
t0 Bool -> Bool -> Bool
&& Time
t forall a. Ord a => a -> a -> Bool
<= Time
t1

-- | Convert a 'TimeInterval' to a 'Timespan'. This is equivalent to 'width'.
timeIntervalToTimespan :: TimeInterval -> Timespan
timeIntervalToTimespan :: TimeInterval -> Timespan
timeIntervalToTimespan = TimeInterval -> Timespan
width

-- | The 'TimeInterval' that covers the entire range of 'Time's that Chronos supports.
--
--   prop> \(t :: Time) -> within t whole
whole :: TimeInterval
whole :: TimeInterval
whole = Time -> Time -> TimeInterval
TimeInterval forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound

-- | The singleton (degenerate) 'TimeInterval'.
singleton :: Time -> TimeInterval
singleton :: Time -> TimeInterval
singleton Time
x = Time -> Time -> TimeInterval
TimeInterval Time
x Time
x

-- | Get the lower bound of the 'TimeInterval'.
lowerBound :: TimeInterval -> Time
lowerBound :: TimeInterval -> Time
lowerBound (TimeInterval Time
t0 Time
_) = Time
t0

-- | Get the upper bound of the 'TimeInterval'.
upperBound :: TimeInterval -> Time
upperBound :: TimeInterval -> Time
upperBound (TimeInterval Time
_ Time
t1) = Time
t1

-- | The width of the 'TimeInterval'. This is equivalent to 'timeIntervalToTimespan'.
width :: TimeInterval -> Timespan
width :: TimeInterval -> Timespan
width (TimeInterval Time
x Time
y) = forall p v. Torsor p v => p -> p -> v
difference Time
y Time
x

-- | A smart constructor for 'TimeInterval'. In general, you should prefer using this
--   over the 'TimeInterval' constructor, since it maintains the invariant that
--   @'lowerBound' interval '<=' 'upperBound' interval@.
timeIntervalBuilder :: Time -> Time -> TimeInterval
timeIntervalBuilder :: Time -> Time -> TimeInterval
timeIntervalBuilder Time
x Time
y = case forall a. Ord a => a -> a -> Ordering
compare Time
x Time
y of
  Ordering
GT -> Time -> Time -> TimeInterval
TimeInterval Time
y Time
x
  Ordering
_ -> Time -> Time -> TimeInterval
TimeInterval Time
x Time
y

infix 3 ...

-- | An infix 'timeIntervalBuilder'.
(...) :: Time -> Time -> TimeInterval
... :: Time -> Time -> TimeInterval
(...) = Time -> Time -> TimeInterval
timeIntervalBuilder

-- | A day represented as the modified Julian date, the number of days
--   since midnight on November 17, 1858.
newtype Day = Day { Day -> Int
getDay :: Int }
  deriving (Int -> Day -> ShowS
[Day] -> ShowS
Day -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Day] -> ShowS
$cshowList :: [Day] -> ShowS
show :: Day -> String
$cshow :: Day -> String
showsPrec :: Int -> Day -> ShowS
$cshowsPrec :: Int -> Day -> ShowS
Show,ReadPrec [Day]
ReadPrec Day
Int -> ReadS Day
ReadS [Day]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Day]
$creadListPrec :: ReadPrec [Day]
readPrec :: ReadPrec Day
$creadPrec :: ReadPrec Day
readList :: ReadS [Day]
$creadList :: ReadS [Day]
readsPrec :: Int -> ReadS Day
$creadsPrec :: Int -> ReadS Day
Read,Day -> Day -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Day -> Day -> Bool
$c/= :: Day -> Day -> Bool
== :: Day -> Day -> Bool
$c== :: Day -> Day -> Bool
Eq,Eq Day
Day -> Day -> Bool
Day -> Day -> Ordering
Day -> Day -> Day
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Day -> Day -> Day
$cmin :: Day -> Day -> Day
max :: Day -> Day -> Day
$cmax :: Day -> Day -> Day
>= :: Day -> Day -> Bool
$c>= :: Day -> Day -> Bool
> :: Day -> Day -> Bool
$c> :: Day -> Day -> Bool
<= :: Day -> Day -> Bool
$c<= :: Day -> Day -> Bool
< :: Day -> Day -> Bool
$c< :: Day -> Day -> Bool
compare :: Day -> Day -> Ordering
$ccompare :: Day -> Day -> Ordering
Ord,Eq Day
Int -> Day -> Int
Day -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Day -> Int
$chash :: Day -> Int
hashWithSalt :: Int -> Day -> Int
$chashWithSalt :: Int -> Day -> Int
Hashable,Int -> Day
Day -> Int
Day -> [Day]
Day -> Day
Day -> Day -> [Day]
Day -> Day -> Day -> [Day]
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 :: Day -> Day -> Day -> [Day]
$cenumFromThenTo :: Day -> Day -> Day -> [Day]
enumFromTo :: Day -> Day -> [Day]
$cenumFromTo :: Day -> Day -> [Day]
enumFromThen :: Day -> Day -> [Day]
$cenumFromThen :: Day -> Day -> [Day]
enumFrom :: Day -> [Day]
$cenumFrom :: Day -> [Day]
fromEnum :: Day -> Int
$cfromEnum :: Day -> Int
toEnum :: Int -> Day
$ctoEnum :: Int -> Day
pred :: Day -> Day
$cpred :: Day -> Day
succ :: Day -> Day
$csucc :: Day -> Day
Enum,[Day] -> Encoding
[Day] -> Value
Day -> Encoding
Day -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Day] -> Encoding
$ctoEncodingList :: [Day] -> Encoding
toJSONList :: [Day] -> Value
$ctoJSONList :: [Day] -> Value
toEncoding :: Day -> Encoding
$ctoEncoding :: Day -> Encoding
toJSON :: Day -> Value
$ctoJSON :: Day -> Value
ToJSON,Value -> Parser [Day]
Value -> Parser Day
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Day]
$cparseJSONList :: Value -> Parser [Day]
parseJSON :: Value -> Parser Day
$cparseJSON :: Value -> Parser Day
FromJSON,Ptr Day -> IO Day
Ptr Day -> Int -> IO Day
Ptr Day -> Int -> Day -> IO ()
Ptr Day -> Day -> IO ()
Day -> Int
forall b. Ptr b -> Int -> IO Day
forall b. Ptr b -> Int -> Day -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Day -> Day -> IO ()
$cpoke :: Ptr Day -> Day -> IO ()
peek :: Ptr Day -> IO Day
$cpeek :: Ptr Day -> IO Day
pokeByteOff :: forall b. Ptr b -> Int -> Day -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Day -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Day
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Day
pokeElemOff :: Ptr Day -> Int -> Day -> IO ()
$cpokeElemOff :: Ptr Day -> Int -> Day -> IO ()
peekElemOff :: Ptr Day -> Int -> IO Day
$cpeekElemOff :: Ptr Day -> Int -> IO Day
alignment :: Day -> Int
$calignment :: Day -> Int
sizeOf :: Day -> Int
$csizeOf :: Day -> Int
Storable,Addr# -> Int# -> Day
ByteArray# -> Int# -> Day
Day -> Int#
forall s. Addr# -> Int# -> Int# -> Day -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, Day #)
forall s. Addr# -> Int# -> Day -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> Int# -> Day -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Day #)
forall s.
MutableByteArray# s -> Int# -> Day -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Day -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Day -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Day -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Day -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Day #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Day #)
indexOffAddr# :: Addr# -> Int# -> Day
$cindexOffAddr# :: Addr# -> Int# -> Day
setByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Day -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Day -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Day -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Day -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Day #)
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Day #)
indexByteArray# :: ByteArray# -> Int# -> Day
$cindexByteArray# :: ByteArray# -> Int# -> Day
alignment# :: Day -> Int#
$calignment# :: Day -> Int#
sizeOf# :: Day -> Int#
$csizeOf# :: Day -> Int#
Prim,Day -> ()
forall a. (a -> ()) -> NFData a
rnf :: Day -> ()
$crnf :: Day -> ()
NFData)

instance Torsor Day Int where
  add :: Int -> Day -> Day
add Int
i (Day Int
d) = Int -> Day
Day (Int
d forall a. Num a => a -> a -> a
+ Int
i)
  difference :: Day -> Day -> Int
difference (Day Int
a) (Day Int
b) = Int
a forall a. Num a => a -> a -> a
- Int
b

-- | a lens for accessing the `getDay` field.
_getDay :: Functor f => (Int -> f Int) -> Day -> f Day
_getDay :: forall (f :: * -> *). Functor f => (Int -> f Int) -> Day -> f Day
_getDay Int -> f Int
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Day
Day forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Int
getDay

-- | The day of the week.
newtype DayOfWeek = DayOfWeek { DayOfWeek -> Int
getDayOfWeek :: Int }
  deriving (Int -> DayOfWeek -> ShowS
[DayOfWeek] -> ShowS
DayOfWeek -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DayOfWeek] -> ShowS
$cshowList :: [DayOfWeek] -> ShowS
show :: DayOfWeek -> String
$cshow :: DayOfWeek -> String
showsPrec :: Int -> DayOfWeek -> ShowS
$cshowsPrec :: Int -> DayOfWeek -> ShowS
Show,ReadPrec [DayOfWeek]
ReadPrec DayOfWeek
Int -> ReadS DayOfWeek
ReadS [DayOfWeek]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DayOfWeek]
$creadListPrec :: ReadPrec [DayOfWeek]
readPrec :: ReadPrec DayOfWeek
$creadPrec :: ReadPrec DayOfWeek
readList :: ReadS [DayOfWeek]
$creadList :: ReadS [DayOfWeek]
readsPrec :: Int -> ReadS DayOfWeek
$creadsPrec :: Int -> ReadS DayOfWeek
Read,DayOfWeek -> DayOfWeek -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DayOfWeek -> DayOfWeek -> Bool
$c/= :: DayOfWeek -> DayOfWeek -> Bool
== :: DayOfWeek -> DayOfWeek -> Bool
$c== :: DayOfWeek -> DayOfWeek -> Bool
Eq,Eq DayOfWeek
DayOfWeek -> DayOfWeek -> Bool
DayOfWeek -> DayOfWeek -> Ordering
DayOfWeek -> DayOfWeek -> DayOfWeek
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DayOfWeek -> DayOfWeek -> DayOfWeek
$cmin :: DayOfWeek -> DayOfWeek -> DayOfWeek
max :: DayOfWeek -> DayOfWeek -> DayOfWeek
$cmax :: DayOfWeek -> DayOfWeek -> DayOfWeek
>= :: DayOfWeek -> DayOfWeek -> Bool
$c>= :: DayOfWeek -> DayOfWeek -> Bool
> :: DayOfWeek -> DayOfWeek -> Bool
$c> :: DayOfWeek -> DayOfWeek -> Bool
<= :: DayOfWeek -> DayOfWeek -> Bool
$c<= :: DayOfWeek -> DayOfWeek -> Bool
< :: DayOfWeek -> DayOfWeek -> Bool
$c< :: DayOfWeek -> DayOfWeek -> Bool
compare :: DayOfWeek -> DayOfWeek -> Ordering
$ccompare :: DayOfWeek -> DayOfWeek -> Ordering
Ord,Eq DayOfWeek
Int -> DayOfWeek -> Int
DayOfWeek -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: DayOfWeek -> Int
$chash :: DayOfWeek -> Int
hashWithSalt :: Int -> DayOfWeek -> Int
$chashWithSalt :: Int -> DayOfWeek -> Int
Hashable,DayOfWeek -> ()
forall a. (a -> ()) -> NFData a
rnf :: DayOfWeek -> ()
$crnf :: DayOfWeek -> ()
NFData)

-- | a lens for accessing the `getDayOfWeek` field.
_getDayOfWeek :: Functor f => (Int -> f Int) -> DayOfWeek -> f DayOfWeek
_getDayOfWeek :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> DayOfWeek -> f DayOfWeek
_getDayOfWeek Int -> f Int
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DayOfWeek
DayOfWeek forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek -> Int
getDayOfWeek

-- | The day of the month.
newtype DayOfMonth = DayOfMonth { DayOfMonth -> Int
getDayOfMonth :: Int }
  deriving (Int -> DayOfMonth -> ShowS
[DayOfMonth] -> ShowS
DayOfMonth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DayOfMonth] -> ShowS
$cshowList :: [DayOfMonth] -> ShowS
show :: DayOfMonth -> String
$cshow :: DayOfMonth -> String
showsPrec :: Int -> DayOfMonth -> ShowS
$cshowsPrec :: Int -> DayOfMonth -> ShowS
Show,ReadPrec [DayOfMonth]
ReadPrec DayOfMonth
Int -> ReadS DayOfMonth
ReadS [DayOfMonth]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DayOfMonth]
$creadListPrec :: ReadPrec [DayOfMonth]
readPrec :: ReadPrec DayOfMonth
$creadPrec :: ReadPrec DayOfMonth
readList :: ReadS [DayOfMonth]
$creadList :: ReadS [DayOfMonth]
readsPrec :: Int -> ReadS DayOfMonth
$creadsPrec :: Int -> ReadS DayOfMonth
Read,DayOfMonth -> DayOfMonth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DayOfMonth -> DayOfMonth -> Bool
$c/= :: DayOfMonth -> DayOfMonth -> Bool
== :: DayOfMonth -> DayOfMonth -> Bool
$c== :: DayOfMonth -> DayOfMonth -> Bool
Eq,Eq DayOfMonth
DayOfMonth -> DayOfMonth -> Bool
DayOfMonth -> DayOfMonth -> Ordering
DayOfMonth -> DayOfMonth -> DayOfMonth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DayOfMonth -> DayOfMonth -> DayOfMonth
$cmin :: DayOfMonth -> DayOfMonth -> DayOfMonth
max :: DayOfMonth -> DayOfMonth -> DayOfMonth
$cmax :: DayOfMonth -> DayOfMonth -> DayOfMonth
>= :: DayOfMonth -> DayOfMonth -> Bool
$c>= :: DayOfMonth -> DayOfMonth -> Bool
> :: DayOfMonth -> DayOfMonth -> Bool
$c> :: DayOfMonth -> DayOfMonth -> Bool
<= :: DayOfMonth -> DayOfMonth -> Bool
$c<= :: DayOfMonth -> DayOfMonth -> Bool
< :: DayOfMonth -> DayOfMonth -> Bool
$c< :: DayOfMonth -> DayOfMonth -> Bool
compare :: DayOfMonth -> DayOfMonth -> Ordering
$ccompare :: DayOfMonth -> DayOfMonth -> Ordering
Ord,Addr# -> Int# -> DayOfMonth
ByteArray# -> Int# -> DayOfMonth
DayOfMonth -> Int#
forall s.
Addr# -> Int# -> Int# -> DayOfMonth -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfMonth #)
forall s. Addr# -> Int# -> DayOfMonth -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfMonth -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfMonth #)
forall s.
MutableByteArray# s -> Int# -> DayOfMonth -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> DayOfMonth -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> DayOfMonth -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> DayOfMonth -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> DayOfMonth -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfMonth #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfMonth #)
indexOffAddr# :: Addr# -> Int# -> DayOfMonth
$cindexOffAddr# :: Addr# -> Int# -> DayOfMonth
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfMonth -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfMonth -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> DayOfMonth -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> DayOfMonth -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfMonth #)
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfMonth #)
indexByteArray# :: ByteArray# -> Int# -> DayOfMonth
$cindexByteArray# :: ByteArray# -> Int# -> DayOfMonth
alignment# :: DayOfMonth -> Int#
$calignment# :: DayOfMonth -> Int#
sizeOf# :: DayOfMonth -> Int#
$csizeOf# :: DayOfMonth -> Int#
Prim,Int -> DayOfMonth
DayOfMonth -> Int
DayOfMonth -> [DayOfMonth]
DayOfMonth -> DayOfMonth
DayOfMonth -> DayOfMonth -> [DayOfMonth]
DayOfMonth -> DayOfMonth -> DayOfMonth -> [DayOfMonth]
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 :: DayOfMonth -> DayOfMonth -> DayOfMonth -> [DayOfMonth]
$cenumFromThenTo :: DayOfMonth -> DayOfMonth -> DayOfMonth -> [DayOfMonth]
enumFromTo :: DayOfMonth -> DayOfMonth -> [DayOfMonth]
$cenumFromTo :: DayOfMonth -> DayOfMonth -> [DayOfMonth]
enumFromThen :: DayOfMonth -> DayOfMonth -> [DayOfMonth]
$cenumFromThen :: DayOfMonth -> DayOfMonth -> [DayOfMonth]
enumFrom :: DayOfMonth -> [DayOfMonth]
$cenumFrom :: DayOfMonth -> [DayOfMonth]
fromEnum :: DayOfMonth -> Int
$cfromEnum :: DayOfMonth -> Int
toEnum :: Int -> DayOfMonth
$ctoEnum :: Int -> DayOfMonth
pred :: DayOfMonth -> DayOfMonth
$cpred :: DayOfMonth -> DayOfMonth
succ :: DayOfMonth -> DayOfMonth
$csucc :: DayOfMonth -> DayOfMonth
Enum,DayOfMonth -> ()
forall a. (a -> ()) -> NFData a
rnf :: DayOfMonth -> ()
$crnf :: DayOfMonth -> ()
NFData)

-- | a lens for accessing the `getDayOfMonth` field.
_getDayOfMonth :: Functor f => (Int -> f Int) -> DayOfMonth -> f DayOfMonth
_getDayOfMonth :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> DayOfMonth -> f DayOfMonth
_getDayOfMonth Int -> f Int
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DayOfMonth
DayOfMonth forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfMonth -> Int
getDayOfMonth

-- | The day of the year.
newtype DayOfYear = DayOfYear { DayOfYear -> Int
getDayOfYear :: Int }
  deriving (Int -> DayOfYear -> ShowS
[DayOfYear] -> ShowS
DayOfYear -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DayOfYear] -> ShowS
$cshowList :: [DayOfYear] -> ShowS
show :: DayOfYear -> String
$cshow :: DayOfYear -> String
showsPrec :: Int -> DayOfYear -> ShowS
$cshowsPrec :: Int -> DayOfYear -> ShowS
Show,ReadPrec [DayOfYear]
ReadPrec DayOfYear
Int -> ReadS DayOfYear
ReadS [DayOfYear]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DayOfYear]
$creadListPrec :: ReadPrec [DayOfYear]
readPrec :: ReadPrec DayOfYear
$creadPrec :: ReadPrec DayOfYear
readList :: ReadS [DayOfYear]
$creadList :: ReadS [DayOfYear]
readsPrec :: Int -> ReadS DayOfYear
$creadsPrec :: Int -> ReadS DayOfYear
Read,DayOfYear -> DayOfYear -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DayOfYear -> DayOfYear -> Bool
$c/= :: DayOfYear -> DayOfYear -> Bool
== :: DayOfYear -> DayOfYear -> Bool
$c== :: DayOfYear -> DayOfYear -> Bool
Eq,Eq DayOfYear
DayOfYear -> DayOfYear -> Bool
DayOfYear -> DayOfYear -> Ordering
DayOfYear -> DayOfYear -> DayOfYear
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DayOfYear -> DayOfYear -> DayOfYear
$cmin :: DayOfYear -> DayOfYear -> DayOfYear
max :: DayOfYear -> DayOfYear -> DayOfYear
$cmax :: DayOfYear -> DayOfYear -> DayOfYear
>= :: DayOfYear -> DayOfYear -> Bool
$c>= :: DayOfYear -> DayOfYear -> Bool
> :: DayOfYear -> DayOfYear -> Bool
$c> :: DayOfYear -> DayOfYear -> Bool
<= :: DayOfYear -> DayOfYear -> Bool
$c<= :: DayOfYear -> DayOfYear -> Bool
< :: DayOfYear -> DayOfYear -> Bool
$c< :: DayOfYear -> DayOfYear -> Bool
compare :: DayOfYear -> DayOfYear -> Ordering
$ccompare :: DayOfYear -> DayOfYear -> Ordering
Ord,Addr# -> Int# -> DayOfYear
ByteArray# -> Int# -> DayOfYear
DayOfYear -> Int#
forall s.
Addr# -> Int# -> Int# -> DayOfYear -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfYear #)
forall s. Addr# -> Int# -> DayOfYear -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfYear -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfYear #)
forall s.
MutableByteArray# s -> Int# -> DayOfYear -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> DayOfYear -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> DayOfYear -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> DayOfYear -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> DayOfYear -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfYear #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfYear #)
indexOffAddr# :: Addr# -> Int# -> DayOfYear
$cindexOffAddr# :: Addr# -> Int# -> DayOfYear
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfYear -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfYear -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> DayOfYear -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> DayOfYear -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfYear #)
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfYear #)
indexByteArray# :: ByteArray# -> Int# -> DayOfYear
$cindexByteArray# :: ByteArray# -> Int# -> DayOfYear
alignment# :: DayOfYear -> Int#
$calignment# :: DayOfYear -> Int#
sizeOf# :: DayOfYear -> Int#
$csizeOf# :: DayOfYear -> Int#
Prim,DayOfYear -> ()
forall a. (a -> ()) -> NFData a
rnf :: DayOfYear -> ()
$crnf :: DayOfYear -> ()
NFData)

-- | a lens for accessing the `getDayOfYear` field.
_getDayOfYear :: Functor f => (Int -> f Int) -> DayOfYear -> f DayOfYear
_getDayOfYear :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> DayOfYear -> f DayOfYear
_getDayOfYear Int -> f Int
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DayOfYear
DayOfYear forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfYear -> Int
getDayOfYear

-- | The month of the year.
newtype Month = Month { Month -> Int
getMonth :: Int }
  deriving (Int -> Month -> ShowS
[Month] -> ShowS
Month -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Month] -> ShowS
$cshowList :: [Month] -> ShowS
show :: Month -> String
$cshow :: Month -> String
showsPrec :: Int -> Month -> ShowS
$cshowsPrec :: Int -> Month -> ShowS
Show,ReadPrec [Month]
ReadPrec Month
Int -> ReadS Month
ReadS [Month]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Month]
$creadListPrec :: ReadPrec [Month]
readPrec :: ReadPrec Month
$creadPrec :: ReadPrec Month
readList :: ReadS [Month]
$creadList :: ReadS [Month]
readsPrec :: Int -> ReadS Month
$creadsPrec :: Int -> ReadS Month
Read,Month -> Month -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Month -> Month -> Bool
$c/= :: Month -> Month -> Bool
== :: Month -> Month -> Bool
$c== :: Month -> Month -> Bool
Eq,Eq Month
Month -> Month -> Bool
Month -> Month -> Ordering
Month -> Month -> Month
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Month -> Month -> Month
$cmin :: Month -> Month -> Month
max :: Month -> Month -> Month
$cmax :: Month -> Month -> Month
>= :: Month -> Month -> Bool
$c>= :: Month -> Month -> Bool
> :: Month -> Month -> Bool
$c> :: Month -> Month -> Bool
<= :: Month -> Month -> Bool
$c<= :: Month -> Month -> Bool
< :: Month -> Month -> Bool
$c< :: Month -> Month -> Bool
compare :: Month -> Month -> Ordering
$ccompare :: Month -> Month -> Ordering
Ord,Addr# -> Int# -> Month
ByteArray# -> Int# -> Month
Month -> Int#
forall s. Addr# -> Int# -> Int# -> Month -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, Month #)
forall s. Addr# -> Int# -> Month -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> Month -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Month #)
forall s.
MutableByteArray# s -> Int# -> Month -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Month -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Month -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Month -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Month -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Month #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Month #)
indexOffAddr# :: Addr# -> Int# -> Month
$cindexOffAddr# :: Addr# -> Int# -> Month
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Month -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Month -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Month -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Month -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Month #)
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Month #)
indexByteArray# :: ByteArray# -> Int# -> Month
$cindexByteArray# :: ByteArray# -> Int# -> Month
alignment# :: Month -> Int#
$calignment# :: Month -> Int#
sizeOf# :: Month -> Int#
$csizeOf# :: Month -> Int#
Prim,Month -> ()
forall a. (a -> ()) -> NFData a
rnf :: Month -> ()
$crnf :: Month -> ()
NFData)

-- | a lens for accessing the `getMonth` field.
_getMonth :: Functor f => (Int -> f Int) -> Month -> f Month
_getMonth :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> Month -> f Month
_getMonth Int -> f Int
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Month
Month forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month -> Int
getMonth

instance Enum Month where
  fromEnum :: Month -> Int
fromEnum = Month -> Int
getMonth
  toEnum :: Int -> Month
toEnum = Int -> Month
Month
  succ :: Month -> Month
succ (Month Int
x) = if Int
x forall a. Ord a => a -> a -> Bool
< Int
11
    then Int -> Month
Month (Int
x forall a. Num a => a -> a -> a
+ Int
1)
    else forall a. HasCallStack => String -> a
error String
"Enum.succ{Month}: tried to take succ of December"
  pred :: Month -> Month
pred (Month Int
x) = if Int
x forall a. Ord a => a -> a -> Bool
> Int
0
    then Int -> Month
Month (Int
x forall a. Num a => a -> a -> a
- Int
1)
    else forall a. HasCallStack => String -> a
error String
"Enum.pred{Month}: tried to take pred of January"
  enumFrom :: Month -> [Month]
enumFrom Month
x = forall a. Enum a => a -> a -> [a]
enumFromTo Month
x (Int -> Month
Month Int
11)

-- | 'Month' starts at 0 and ends at 11 (January to December)
instance Bounded Month where
  minBound :: Month
minBound = Int -> Month
Month Int
0
  maxBound :: Month
maxBound = Int -> Month
Month Int
11

-- | The number of years elapsed since the beginning
--   of the Common Era.
newtype Year = Year { Year -> Int
getYear :: Int }
  deriving (Int -> Year -> ShowS
[Year] -> ShowS
Year -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Year] -> ShowS
$cshowList :: [Year] -> ShowS
show :: Year -> String
$cshow :: Year -> String
showsPrec :: Int -> Year -> ShowS
$cshowsPrec :: Int -> Year -> ShowS
Show,ReadPrec [Year]
ReadPrec Year
Int -> ReadS Year
ReadS [Year]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Year]
$creadListPrec :: ReadPrec [Year]
readPrec :: ReadPrec Year
$creadPrec :: ReadPrec Year
readList :: ReadS [Year]
$creadList :: ReadS [Year]
readsPrec :: Int -> ReadS Year
$creadsPrec :: Int -> ReadS Year
Read,Year -> Year -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Year -> Year -> Bool
$c/= :: Year -> Year -> Bool
== :: Year -> Year -> Bool
$c== :: Year -> Year -> Bool
Eq,Eq Year
Year -> Year -> Bool
Year -> Year -> Ordering
Year -> Year -> Year
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Year -> Year -> Year
$cmin :: Year -> Year -> Year
max :: Year -> Year -> Year
$cmax :: Year -> Year -> Year
>= :: Year -> Year -> Bool
$c>= :: Year -> Year -> Bool
> :: Year -> Year -> Bool
$c> :: Year -> Year -> Bool
<= :: Year -> Year -> Bool
$c<= :: Year -> Year -> Bool
< :: Year -> Year -> Bool
$c< :: Year -> Year -> Bool
compare :: Year -> Year -> Ordering
$ccompare :: Year -> Year -> Ordering
Ord, Year -> ()
forall a. (a -> ()) -> NFData a
rnf :: Year -> ()
$crnf :: Year -> ()
NFData)

-- | a lens for accessing the `getYear` field.
_getYear :: Functor f => (Int -> f Int) -> Year -> f Year
_getYear :: forall (f :: * -> *). Functor f => (Int -> f Int) -> Year -> f Year
_getYear Int -> f Int
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Year
Year forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> Int
getYear

-- | A <https://en.wikipedia.org/wiki/UTC_offset UTC offset>.
newtype Offset = Offset { Offset -> Int
getOffset :: Int }
  deriving (Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Offset] -> ShowS
$cshowList :: [Offset] -> ShowS
show :: Offset -> String
$cshow :: Offset -> String
showsPrec :: Int -> Offset -> ShowS
$cshowsPrec :: Int -> Offset -> ShowS
Show,ReadPrec [Offset]
ReadPrec Offset
Int -> ReadS Offset
ReadS [Offset]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Offset]
$creadListPrec :: ReadPrec [Offset]
readPrec :: ReadPrec Offset
$creadPrec :: ReadPrec Offset
readList :: ReadS [Offset]
$creadList :: ReadS [Offset]
readsPrec :: Int -> ReadS Offset
$creadsPrec :: Int -> ReadS Offset
Read,Offset -> Offset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c== :: Offset -> Offset -> Bool
Eq,Eq Offset
Offset -> Offset -> Bool
Offset -> Offset -> Ordering
Offset -> Offset -> Offset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Offset -> Offset -> Offset
$cmin :: Offset -> Offset -> Offset
max :: Offset -> Offset -> Offset
$cmax :: Offset -> Offset -> Offset
>= :: Offset -> Offset -> Bool
$c>= :: Offset -> Offset -> Bool
> :: Offset -> Offset -> Bool
$c> :: Offset -> Offset -> Bool
<= :: Offset -> Offset -> Bool
$c<= :: Offset -> Offset -> Bool
< :: Offset -> Offset -> Bool
$c< :: Offset -> Offset -> Bool
compare :: Offset -> Offset -> Ordering
$ccompare :: Offset -> Offset -> Ordering
Ord,Int -> Offset
Offset -> Int
Offset -> [Offset]
Offset -> Offset
Offset -> Offset -> [Offset]
Offset -> Offset -> Offset -> [Offset]
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 :: Offset -> Offset -> Offset -> [Offset]
$cenumFromThenTo :: Offset -> Offset -> Offset -> [Offset]
enumFromTo :: Offset -> Offset -> [Offset]
$cenumFromTo :: Offset -> Offset -> [Offset]
enumFromThen :: Offset -> Offset -> [Offset]
$cenumFromThen :: Offset -> Offset -> [Offset]
enumFrom :: Offset -> [Offset]
$cenumFrom :: Offset -> [Offset]
fromEnum :: Offset -> Int
$cfromEnum :: Offset -> Int
toEnum :: Int -> Offset
$ctoEnum :: Int -> Offset
pred :: Offset -> Offset
$cpred :: Offset -> Offset
succ :: Offset -> Offset
$csucc :: Offset -> Offset
Enum,Offset -> ()
forall a. (a -> ()) -> NFData a
rnf :: Offset -> ()
$crnf :: Offset -> ()
NFData)

-- | a lens for accessing the `getOffset` field.
_getOffset :: Functor f => (Int -> f Int) -> Offset -> f Offset
_getOffset :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> Offset -> f Offset
_getOffset Int -> f Int
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Offset
Offset forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offset -> Int
getOffset

-- | POSIX time with nanosecond resolution.
newtype Time = Time { Time -> Int64
getTime :: Int64 }
  deriving (Value -> Parser [Time]
Value -> Parser Time
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Time]
$cparseJSONList :: Value -> Parser [Time]
parseJSON :: Value -> Parser Time
$cparseJSON :: Value -> Parser Time
FromJSON,[Time] -> Encoding
[Time] -> Value
Time -> Encoding
Time -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Time] -> Encoding
$ctoEncodingList :: [Time] -> Encoding
toJSONList :: [Time] -> Value
$ctoJSONList :: [Time] -> Value
toEncoding :: Time -> Encoding
$ctoEncoding :: Time -> Encoding
toJSON :: Time -> Value
$ctoJSON :: Time -> Value
ToJSON,Eq Time
Int -> Time -> Int
Time -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Time -> Int
$chash :: Time -> Int
hashWithSalt :: Int -> Time -> Int
$chashWithSalt :: Int -> Time -> Int
Hashable,Time -> Time -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq,Eq Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmax :: Time -> Time -> Time
>= :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c< :: Time -> Time -> Bool
compare :: Time -> Time -> Ordering
$ccompare :: Time -> Time -> Ordering
Ord,Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Time] -> ShowS
$cshowList :: [Time] -> ShowS
show :: Time -> String
$cshow :: Time -> String
showsPrec :: Int -> Time -> ShowS
$cshowsPrec :: Int -> Time -> ShowS
Show,ReadPrec [Time]
ReadPrec Time
Int -> ReadS Time
ReadS [Time]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Time]
$creadListPrec :: ReadPrec [Time]
readPrec :: ReadPrec Time
$creadPrec :: ReadPrec Time
readList :: ReadS [Time]
$creadList :: ReadS [Time]
readsPrec :: Int -> ReadS Time
$creadsPrec :: Int -> ReadS Time
Read,Ptr Time -> IO Time
Ptr Time -> Int -> IO Time
Ptr Time -> Int -> Time -> IO ()
Ptr Time -> Time -> IO ()
Time -> Int
forall b. Ptr b -> Int -> IO Time
forall b. Ptr b -> Int -> Time -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Time -> Time -> IO ()
$cpoke :: Ptr Time -> Time -> IO ()
peek :: Ptr Time -> IO Time
$cpeek :: Ptr Time -> IO Time
pokeByteOff :: forall b. Ptr b -> Int -> Time -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Time -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Time
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Time
pokeElemOff :: Ptr Time -> Int -> Time -> IO ()
$cpokeElemOff :: Ptr Time -> Int -> Time -> IO ()
peekElemOff :: Ptr Time -> Int -> IO Time
$cpeekElemOff :: Ptr Time -> Int -> IO Time
alignment :: Time -> Int
$calignment :: Time -> Int
sizeOf :: Time -> Int
$csizeOf :: Time -> Int
Storable,Addr# -> Int# -> Time
ByteArray# -> Int# -> Time
Time -> Int#
forall s. Addr# -> Int# -> Int# -> Time -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, Time #)
forall s. Addr# -> Int# -> Time -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> Int# -> Time -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Time #)
forall s.
MutableByteArray# s -> Int# -> Time -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Time -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Time -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Time -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Time -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Time #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Time #)
indexOffAddr# :: Addr# -> Int# -> Time
$cindexOffAddr# :: Addr# -> Int# -> Time
setByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Time -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Time -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Time -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Time -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Time #)
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Time #)
indexByteArray# :: ByteArray# -> Int# -> Time
$cindexByteArray# :: ByteArray# -> Int# -> Time
alignment# :: Time -> Int#
$calignment# :: Time -> Int#
sizeOf# :: Time -> Int#
$csizeOf# :: Time -> Int#
Prim,Time
forall a. a -> a -> Bounded a
maxBound :: Time
$cmaxBound :: Time
minBound :: Time
$cminBound :: Time
Bounded, Time -> ()
forall a. (a -> ()) -> NFData a
rnf :: Time -> ()
$crnf :: Time -> ()
NFData)

-- | a lens for accessing the `getTime` field.
_getTime :: Functor f => (Int64 -> f Int64) -> Time -> f Time
_getTime :: forall (f :: * -> *).
Functor f =>
(Int64 -> f Int64) -> Time -> f Time
_getTime Int64 -> f Int64
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Time
Time forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> f Int64
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Int64
getTime

-- | Match a 'DayOfWeek'. By `match`, we mean that a 'DayOfWeekMatch'
--   is a mapping from the integer value of a 'DayOfWeek' to some value
--   of type @a@. You should construct a 'DayOfWeekMatch' with
--   'buildDayOfWeekMatch', and match it using 'caseDayOfWeek'.
newtype DayOfWeekMatch a = DayOfWeekMatch { forall a. DayOfWeekMatch a -> Vector a
getDayOfWeekMatch :: Vector a }
  deriving (DayOfWeekMatch a -> ()
forall a. NFData a => DayOfWeekMatch a -> ()
forall a. (a -> ()) -> NFData a
rnf :: DayOfWeekMatch a -> ()
$crnf :: forall a. NFData a => DayOfWeekMatch a -> ()
NFData)

-- | Match a 'Month'. By `match`, we mean that a 'MonthMatch' is
--   a mapping from the integer value of a 'Month' to some value of
--   type @a@. You should construct a 'MonthMatch' with
--   'buildMonthMatch', and match it using 'caseMonth'.
newtype MonthMatch a = MonthMatch { forall a. MonthMatch a -> Vector a
getMonthMatch :: Vector a }
  deriving (MonthMatch a -> ()
forall a. NFData a => MonthMatch a -> ()
forall a. (a -> ()) -> NFData a
rnf :: MonthMatch a -> ()
$crnf :: forall a. NFData a => MonthMatch a -> ()
NFData)

-- | Like 'MonthMatch', but the matched value can have an instance of
--   'UVector.Unbox'.
newtype UnboxedMonthMatch a = UnboxedMonthMatch { forall a. UnboxedMonthMatch a -> Vector a
getUnboxedMonthMatch :: UVector.Vector a }
  deriving (UnboxedMonthMatch a -> ()
forall a. UnboxedMonthMatch a -> ()
forall a. (a -> ()) -> NFData a
rnf :: UnboxedMonthMatch a -> ()
$crnf :: forall a. UnboxedMonthMatch a -> ()
NFData)

-- | A timespan. This is represented internally as a number
--   of nanoseconds.
newtype Timespan = Timespan { Timespan -> Int64
getTimespan :: Int64 }
  deriving (Int -> Timespan -> ShowS
[Timespan] -> ShowS
Timespan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timespan] -> ShowS
$cshowList :: [Timespan] -> ShowS
show :: Timespan -> String
$cshow :: Timespan -> String
showsPrec :: Int -> Timespan -> ShowS
$cshowsPrec :: Int -> Timespan -> ShowS
Show,ReadPrec [Timespan]
ReadPrec Timespan
Int -> ReadS Timespan
ReadS [Timespan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Timespan]
$creadListPrec :: ReadPrec [Timespan]
readPrec :: ReadPrec Timespan
$creadPrec :: ReadPrec Timespan
readList :: ReadS [Timespan]
$creadList :: ReadS [Timespan]
readsPrec :: Int -> ReadS Timespan
$creadsPrec :: Int -> ReadS Timespan
Read,Timespan -> Timespan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timespan -> Timespan -> Bool
$c/= :: Timespan -> Timespan -> Bool
== :: Timespan -> Timespan -> Bool
$c== :: Timespan -> Timespan -> Bool
Eq,Eq Timespan
Timespan -> Timespan -> Bool
Timespan -> Timespan -> Ordering
Timespan -> Timespan -> Timespan
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Timespan -> Timespan -> Timespan
$cmin :: Timespan -> Timespan -> Timespan
max :: Timespan -> Timespan -> Timespan
$cmax :: Timespan -> Timespan -> Timespan
>= :: Timespan -> Timespan -> Bool
$c>= :: Timespan -> Timespan -> Bool
> :: Timespan -> Timespan -> Bool
$c> :: Timespan -> Timespan -> Bool
<= :: Timespan -> Timespan -> Bool
$c<= :: Timespan -> Timespan -> Bool
< :: Timespan -> Timespan -> Bool
$c< :: Timespan -> Timespan -> Bool
compare :: Timespan -> Timespan -> Ordering
$ccompare :: Timespan -> Timespan -> Ordering
Ord,[Timespan] -> Encoding
[Timespan] -> Value
Timespan -> Encoding
Timespan -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Timespan] -> Encoding
$ctoEncodingList :: [Timespan] -> Encoding
toJSONList :: [Timespan] -> Value
$ctoJSONList :: [Timespan] -> Value
toEncoding :: Timespan -> Encoding
$ctoEncoding :: Timespan -> Encoding
toJSON :: Timespan -> Value
$ctoJSON :: Timespan -> Value
ToJSON,Value -> Parser [Timespan]
Value -> Parser Timespan
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Timespan]
$cparseJSONList :: Value -> Parser [Timespan]
parseJSON :: Value -> Parser Timespan
$cparseJSON :: Value -> Parser Timespan
FromJSON,Timespan
Timespan -> Timespan
Timespan -> Timespan -> Timespan
forall v.
v -> (v -> v) -> (v -> v -> v) -> (v -> v -> v) -> Additive v
minus :: Timespan -> Timespan -> Timespan
$cminus :: Timespan -> Timespan -> Timespan
plus :: Timespan -> Timespan -> Timespan
$cplus :: Timespan -> Timespan -> Timespan
invert :: Timespan -> Timespan
$cinvert :: Timespan -> Timespan
zero :: Timespan
$czero :: Timespan
Additive,Timespan -> ()
forall a. (a -> ()) -> NFData a
rnf :: Timespan -> ()
$crnf :: Timespan -> ()
NFData)

-- | a lens for accessing the `getTimespan` field.
_getTimespan :: Functor f => (Int64 -> f Int64) -> Timespan -> f Timespan
_getTimespan :: forall (f :: * -> *).
Functor f =>
(Int64 -> f Int64) -> Timespan -> f Timespan
_getTimespan Int64 -> f Int64
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Timespan
Timespan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> f Int64
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timespan -> Int64
getTimespan

instance Semigroup Timespan where
  (Timespan Int64
a) <> :: Timespan -> Timespan -> Timespan
<> (Timespan Int64
b) = Int64 -> Timespan
Timespan (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)

instance Monoid Timespan where
  mempty :: Timespan
mempty = Int64 -> Timespan
Timespan Int64
0
  mappend :: Timespan -> Timespan -> Timespan
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)

instance Torsor Time Timespan where
  add :: Timespan -> Time -> Time
add (Timespan Int64
ts) (Time Int64
t) = Int64 -> Time
Time (Int64
t forall a. Num a => a -> a -> a
+ Int64
ts)
  difference :: Time -> Time -> Timespan
difference (Time Int64
t) (Time Int64
s) = Int64 -> Timespan
Timespan (Int64
t forall a. Num a => a -> a -> a
- Int64
s)

instance Scaling Timespan Int64 where
  scale :: Int64 -> Timespan -> Timespan
scale Int64
i (Timespan Int64
ts) = Int64 -> Timespan
Timespan (Int64
i forall a. Num a => a -> a -> a
* Int64
ts)

instance Torsor Offset Int where
  add :: Int -> Offset -> Offset
add Int
i (Offset Int
x) = Int -> Offset
Offset (Int
x forall a. Num a => a -> a -> a
+ Int
i)
  difference :: Offset -> Offset -> Int
difference (Offset Int
x) (Offset Int
y) = Int
x forall a. Num a => a -> a -> a
- Int
y

-- | The precision used when encoding seconds to a human-readable format.
data SubsecondPrecision
  = SubsecondPrecisionAuto -- ^ Rounds to second, millisecond, microsecond, or nanosecond
  | SubsecondPrecisionFixed {-# UNPACK #-} !Int -- ^ Specify number of places after decimal
  deriving (SubsecondPrecision -> SubsecondPrecision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubsecondPrecision -> SubsecondPrecision -> Bool
$c/= :: SubsecondPrecision -> SubsecondPrecision -> Bool
== :: SubsecondPrecision -> SubsecondPrecision -> Bool
$c== :: SubsecondPrecision -> SubsecondPrecision -> Bool
Eq, Eq SubsecondPrecision
SubsecondPrecision -> SubsecondPrecision -> Bool
SubsecondPrecision -> SubsecondPrecision -> Ordering
SubsecondPrecision -> SubsecondPrecision -> SubsecondPrecision
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SubsecondPrecision -> SubsecondPrecision -> SubsecondPrecision
$cmin :: SubsecondPrecision -> SubsecondPrecision -> SubsecondPrecision
max :: SubsecondPrecision -> SubsecondPrecision -> SubsecondPrecision
$cmax :: SubsecondPrecision -> SubsecondPrecision -> SubsecondPrecision
>= :: SubsecondPrecision -> SubsecondPrecision -> Bool
$c>= :: SubsecondPrecision -> SubsecondPrecision -> Bool
> :: SubsecondPrecision -> SubsecondPrecision -> Bool
$c> :: SubsecondPrecision -> SubsecondPrecision -> Bool
<= :: SubsecondPrecision -> SubsecondPrecision -> Bool
$c<= :: SubsecondPrecision -> SubsecondPrecision -> Bool
< :: SubsecondPrecision -> SubsecondPrecision -> Bool
$c< :: SubsecondPrecision -> SubsecondPrecision -> Bool
compare :: SubsecondPrecision -> SubsecondPrecision -> Ordering
$ccompare :: SubsecondPrecision -> SubsecondPrecision -> Ordering
Ord, Int -> SubsecondPrecision -> ShowS
[SubsecondPrecision] -> ShowS
SubsecondPrecision -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubsecondPrecision] -> ShowS
$cshowList :: [SubsecondPrecision] -> ShowS
show :: SubsecondPrecision -> String
$cshow :: SubsecondPrecision -> String
showsPrec :: Int -> SubsecondPrecision -> ShowS
$cshowsPrec :: Int -> SubsecondPrecision -> ShowS
Show, ReadPrec [SubsecondPrecision]
ReadPrec SubsecondPrecision
Int -> ReadS SubsecondPrecision
ReadS [SubsecondPrecision]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubsecondPrecision]
$creadListPrec :: ReadPrec [SubsecondPrecision]
readPrec :: ReadPrec SubsecondPrecision
$creadPrec :: ReadPrec SubsecondPrecision
readList :: ReadS [SubsecondPrecision]
$creadList :: ReadS [SubsecondPrecision]
readsPrec :: Int -> ReadS SubsecondPrecision
$creadsPrec :: Int -> ReadS SubsecondPrecision
Read)

instance NFData SubsecondPrecision where
  rnf :: SubsecondPrecision -> ()
rnf (SubsecondPrecision
SubsecondPrecisionAuto) = ()
  rnf (SubsecondPrecisionFixed Int
a) = Int
a forall a b. NFData a => a -> b -> b
`deepseq` ()


-- | A date as represented by the Gregorian calendar.
data Date = Date
  { Date -> Year
dateYear  :: {-# UNPACK #-} !Year
  , Date -> Month
dateMonth :: {-# UNPACK #-} !Month
  , Date -> DayOfMonth
dateDay   :: {-# UNPACK #-} !DayOfMonth
  } deriving (Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Date] -> ShowS
$cshowList :: [Date] -> ShowS
show :: Date -> String
$cshow :: Date -> String
showsPrec :: Int -> Date -> ShowS
$cshowsPrec :: Int -> Date -> ShowS
Show,ReadPrec [Date]
ReadPrec Date
Int -> ReadS Date
ReadS [Date]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Date]
$creadListPrec :: ReadPrec [Date]
readPrec :: ReadPrec Date
$creadPrec :: ReadPrec Date
readList :: ReadS [Date]
$creadList :: ReadS [Date]
readsPrec :: Int -> ReadS Date
$creadsPrec :: Int -> ReadS Date
Read,Date -> Date -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c== :: Date -> Date -> Bool
Eq,Eq Date
Date -> Date -> Bool
Date -> Date -> Ordering
Date -> Date -> Date
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Date -> Date -> Date
$cmin :: Date -> Date -> Date
max :: Date -> Date -> Date
$cmax :: Date -> Date -> Date
>= :: Date -> Date -> Bool
$c>= :: Date -> Date -> Bool
> :: Date -> Date -> Bool
$c> :: Date -> Date -> Bool
<= :: Date -> Date -> Bool
$c<= :: Date -> Date -> Bool
< :: Date -> Date -> Bool
$c< :: Date -> Date -> Bool
compare :: Date -> Date -> Ordering
$ccompare :: Date -> Date -> Ordering
Ord)

instance NFData Date where
  rnf :: Date -> ()
rnf (Date Year
y Month
m DayOfMonth
d) = Year
y forall a b. NFData a => a -> b -> b
`deepseq` Month
m forall a b. NFData a => a -> b -> b
`deepseq` DayOfMonth
d forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | a lens for accessing the `dateYear` field.
_dateYear :: Functor f => (Year -> f Year) -> Date -> f Date
_dateYear :: forall (f :: * -> *).
Functor f =>
(Year -> f Year) -> Date -> f Date
_dateYear Year -> f Year
f Date
date = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Year
y -> Date
date{dateYear :: Year
dateYear = Year
y}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> f Year
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Year
dateYear forall a b. (a -> b) -> a -> b
$ Date
date

-- | a lens for accessing the `dateMonth` field.
_dateMonth :: Functor f => (Month -> f Month) -> Date -> f Date
_dateMonth :: forall (f :: * -> *).
Functor f =>
(Month -> f Month) -> Date -> f Date
_dateMonth Month -> f Month
f Date
date = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Month
m -> Date
date{dateMonth :: Month
dateMonth = Month
m}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month -> f Month
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Month
dateMonth forall a b. (a -> b) -> a -> b
$ Date
date

-- | a lens for accessing the `dateDay` field.
_dateDay :: Functor f => (DayOfMonth -> f DayOfMonth) -> Date -> f Date
_dateDay :: forall (f :: * -> *).
Functor f =>
(DayOfMonth -> f DayOfMonth) -> Date -> f Date
_dateDay DayOfMonth -> f DayOfMonth
f Date
date = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DayOfMonth
d -> Date
date{dateDay :: DayOfMonth
dateDay = DayOfMonth
d}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfMonth -> f DayOfMonth
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> DayOfMonth
dateDay forall a b. (a -> b) -> a -> b
$ Date
date

-- | An 'OrdinalDate' is a 'Year' and the number of days elapsed
--   since the 'Year' began.
data OrdinalDate = OrdinalDate
  { OrdinalDate -> Year
ordinalDateYear :: {-# UNPACK #-} !Year
  , OrdinalDate -> DayOfYear
ordinalDateDayOfYear :: {-# UNPACK #-} !DayOfYear
  } deriving (Int -> OrdinalDate -> ShowS
[OrdinalDate] -> ShowS
OrdinalDate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrdinalDate] -> ShowS
$cshowList :: [OrdinalDate] -> ShowS
show :: OrdinalDate -> String
$cshow :: OrdinalDate -> String
showsPrec :: Int -> OrdinalDate -> ShowS
$cshowsPrec :: Int -> OrdinalDate -> ShowS
Show,ReadPrec [OrdinalDate]
ReadPrec OrdinalDate
Int -> ReadS OrdinalDate
ReadS [OrdinalDate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrdinalDate]
$creadListPrec :: ReadPrec [OrdinalDate]
readPrec :: ReadPrec OrdinalDate
$creadPrec :: ReadPrec OrdinalDate
readList :: ReadS [OrdinalDate]
$creadList :: ReadS [OrdinalDate]
readsPrec :: Int -> ReadS OrdinalDate
$creadsPrec :: Int -> ReadS OrdinalDate
Read,OrdinalDate -> OrdinalDate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrdinalDate -> OrdinalDate -> Bool
$c/= :: OrdinalDate -> OrdinalDate -> Bool
== :: OrdinalDate -> OrdinalDate -> Bool
$c== :: OrdinalDate -> OrdinalDate -> Bool
Eq,Eq OrdinalDate
OrdinalDate -> OrdinalDate -> Bool
OrdinalDate -> OrdinalDate -> Ordering
OrdinalDate -> OrdinalDate -> OrdinalDate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OrdinalDate -> OrdinalDate -> OrdinalDate
$cmin :: OrdinalDate -> OrdinalDate -> OrdinalDate
max :: OrdinalDate -> OrdinalDate -> OrdinalDate
$cmax :: OrdinalDate -> OrdinalDate -> OrdinalDate
>= :: OrdinalDate -> OrdinalDate -> Bool
$c>= :: OrdinalDate -> OrdinalDate -> Bool
> :: OrdinalDate -> OrdinalDate -> Bool
$c> :: OrdinalDate -> OrdinalDate -> Bool
<= :: OrdinalDate -> OrdinalDate -> Bool
$c<= :: OrdinalDate -> OrdinalDate -> Bool
< :: OrdinalDate -> OrdinalDate -> Bool
$c< :: OrdinalDate -> OrdinalDate -> Bool
compare :: OrdinalDate -> OrdinalDate -> Ordering
$ccompare :: OrdinalDate -> OrdinalDate -> Ordering
Ord)

instance NFData OrdinalDate where
  rnf :: OrdinalDate -> ()
rnf (OrdinalDate Year
y DayOfYear
d) = Year
y forall a b. NFData a => a -> b -> b
`deepseq` DayOfYear
d forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | a lens for accessing the `ordinalDateYear` field.
_ordinalDateYear :: Functor f => (Year -> f Year) -> OrdinalDate -> f OrdinalDate
_ordinalDateYear :: forall (f :: * -> *).
Functor f =>
(Year -> f Year) -> OrdinalDate -> f OrdinalDate
_ordinalDateYear Year -> f Year
f OrdinalDate
date = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Year
y -> OrdinalDate
date{ordinalDateYear :: Year
ordinalDateYear = Year
y}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> f Year
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdinalDate -> Year
ordinalDateYear forall a b. (a -> b) -> a -> b
$ OrdinalDate
date

-- | a lens for accessing the `ordinalDateDayOfYear` field.
_ordinalDateDayOfYear :: Functor f => (DayOfYear -> f DayOfYear) -> OrdinalDate -> f OrdinalDate
_ordinalDateDayOfYear :: forall (f :: * -> *).
Functor f =>
(DayOfYear -> f DayOfYear) -> OrdinalDate -> f OrdinalDate
_ordinalDateDayOfYear DayOfYear -> f DayOfYear
f OrdinalDate
date =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DayOfYear
d -> OrdinalDate
date{ordinalDateDayOfYear :: DayOfYear
ordinalDateDayOfYear = DayOfYear
d}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfYear -> f DayOfYear
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdinalDate -> DayOfYear
ordinalDateDayOfYear forall a b. (a -> b) -> a -> b
$ OrdinalDate
date

-- | A month and the day of the month. This does not actually represent
--   a specific date, since this recurs every year.
data MonthDate = MonthDate
  { MonthDate -> Month
monthDateMonth :: {-# UNPACK #-} !Month
  , MonthDate -> DayOfMonth
monthDateDay :: {-# UNPACK #-} !DayOfMonth
  } deriving (Int -> MonthDate -> ShowS
[MonthDate] -> ShowS
MonthDate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonthDate] -> ShowS
$cshowList :: [MonthDate] -> ShowS
show :: MonthDate -> String
$cshow :: MonthDate -> String
showsPrec :: Int -> MonthDate -> ShowS
$cshowsPrec :: Int -> MonthDate -> ShowS
Show,ReadPrec [MonthDate]
ReadPrec MonthDate
Int -> ReadS MonthDate
ReadS [MonthDate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MonthDate]
$creadListPrec :: ReadPrec [MonthDate]
readPrec :: ReadPrec MonthDate
$creadPrec :: ReadPrec MonthDate
readList :: ReadS [MonthDate]
$creadList :: ReadS [MonthDate]
readsPrec :: Int -> ReadS MonthDate
$creadsPrec :: Int -> ReadS MonthDate
Read,MonthDate -> MonthDate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonthDate -> MonthDate -> Bool
$c/= :: MonthDate -> MonthDate -> Bool
== :: MonthDate -> MonthDate -> Bool
$c== :: MonthDate -> MonthDate -> Bool
Eq,Eq MonthDate
MonthDate -> MonthDate -> Bool
MonthDate -> MonthDate -> Ordering
MonthDate -> MonthDate -> MonthDate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MonthDate -> MonthDate -> MonthDate
$cmin :: MonthDate -> MonthDate -> MonthDate
max :: MonthDate -> MonthDate -> MonthDate
$cmax :: MonthDate -> MonthDate -> MonthDate
>= :: MonthDate -> MonthDate -> Bool
$c>= :: MonthDate -> MonthDate -> Bool
> :: MonthDate -> MonthDate -> Bool
$c> :: MonthDate -> MonthDate -> Bool
<= :: MonthDate -> MonthDate -> Bool
$c<= :: MonthDate -> MonthDate -> Bool
< :: MonthDate -> MonthDate -> Bool
$c< :: MonthDate -> MonthDate -> Bool
compare :: MonthDate -> MonthDate -> Ordering
$ccompare :: MonthDate -> MonthDate -> Ordering
Ord)

instance NFData MonthDate where
  rnf :: MonthDate -> ()
rnf (MonthDate Month
m DayOfMonth
d) = Month
m forall a b. NFData a => a -> b -> b
`deepseq` DayOfMonth
d forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | a lens for accessing the `monthDateMonth` field.
_monthDateMonth :: Functor f => (Month -> f Month) -> MonthDate -> f MonthDate
_monthDateMonth :: forall (f :: * -> *).
Functor f =>
(Month -> f Month) -> MonthDate -> f MonthDate
_monthDateMonth Month -> f Month
f MonthDate
date = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Month
m -> MonthDate
date{monthDateMonth :: Month
monthDateMonth = Month
m}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month -> f Month
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthDate -> Month
monthDateMonth forall a b. (a -> b) -> a -> b
$ MonthDate
date

-- | a lens for accessing the `monthDateDay` field.
_monthDateDay :: Functor f => (DayOfMonth -> f DayOfMonth) -> MonthDate -> f MonthDate
_monthDateDay :: forall (f :: * -> *).
Functor f =>
(DayOfMonth -> f DayOfMonth) -> MonthDate -> f MonthDate
_monthDateDay DayOfMonth -> f DayOfMonth
f MonthDate
date = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DayOfMonth
d -> MonthDate
date{monthDateDay :: DayOfMonth
monthDateDay = DayOfMonth
d}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfMonth -> f DayOfMonth
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthDate -> DayOfMonth
monthDateDay forall a b. (a -> b) -> a -> b
$ MonthDate
date

-- | A 'Date' as represented by the Gregorian calendar
--   and a 'TimeOfDay'.
--   While the 'ToJSON' instance encodes with a hyphen separator, the
--   'FromJSON' instance allows any non-digit character to act as
--   separator, using the lenient parser.
data Datetime = Datetime
  { Datetime -> Date
datetimeDate :: {-# UNPACK #-} !Date
  , Datetime -> TimeOfDay
datetimeTime :: {-# UNPACK #-} !TimeOfDay
  } deriving (Int -> Datetime -> ShowS
[Datetime] -> ShowS
Datetime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Datetime] -> ShowS
$cshowList :: [Datetime] -> ShowS
show :: Datetime -> String
$cshow :: Datetime -> String
showsPrec :: Int -> Datetime -> ShowS
$cshowsPrec :: Int -> Datetime -> ShowS
Show,ReadPrec [Datetime]
ReadPrec Datetime
Int -> ReadS Datetime
ReadS [Datetime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Datetime]
$creadListPrec :: ReadPrec [Datetime]
readPrec :: ReadPrec Datetime
$creadPrec :: ReadPrec Datetime
readList :: ReadS [Datetime]
$creadList :: ReadS [Datetime]
readsPrec :: Int -> ReadS Datetime
$creadsPrec :: Int -> ReadS Datetime
Read,Datetime -> Datetime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Datetime -> Datetime -> Bool
$c/= :: Datetime -> Datetime -> Bool
== :: Datetime -> Datetime -> Bool
$c== :: Datetime -> Datetime -> Bool
Eq,Eq Datetime
Datetime -> Datetime -> Bool
Datetime -> Datetime -> Ordering
Datetime -> Datetime -> Datetime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Datetime -> Datetime -> Datetime
$cmin :: Datetime -> Datetime -> Datetime
max :: Datetime -> Datetime -> Datetime
$cmax :: Datetime -> Datetime -> Datetime
>= :: Datetime -> Datetime -> Bool
$c>= :: Datetime -> Datetime -> Bool
> :: Datetime -> Datetime -> Bool
$c> :: Datetime -> Datetime -> Bool
<= :: Datetime -> Datetime -> Bool
$c<= :: Datetime -> Datetime -> Bool
< :: Datetime -> Datetime -> Bool
$c< :: Datetime -> Datetime -> Bool
compare :: Datetime -> Datetime -> Ordering
$ccompare :: Datetime -> Datetime -> Ordering
Ord)

instance NFData Datetime where
  rnf :: Datetime -> ()
rnf (Datetime Date
d TimeOfDay
t) = Date
d forall a b. NFData a => a -> b -> b
`deepseq` TimeOfDay
t forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | a lens for accessing the `datetimeDate` field.
_datetimeDate :: Functor f => (Date -> f Date) -> Datetime -> f Datetime
_datetimeDate :: forall (f :: * -> *).
Functor f =>
(Date -> f Date) -> Datetime -> f Datetime
_datetimeDate Date -> f Date
f Datetime
date = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Date
y -> Datetime
date{datetimeDate :: Date
datetimeDate = Date
y}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> f Date
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> Date
datetimeDate forall a b. (a -> b) -> a -> b
$ Datetime
date

-- | a lens for accessing the `datetimeTime` field.
_datetimeTime :: Functor f => (TimeOfDay -> f TimeOfDay) -> Datetime -> f Datetime
_datetimeTime :: forall (f :: * -> *).
Functor f =>
(TimeOfDay -> f TimeOfDay) -> Datetime -> f Datetime
_datetimeTime TimeOfDay -> f TimeOfDay
f Datetime
date = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TimeOfDay
t -> Datetime
date{datetimeTime :: TimeOfDay
datetimeTime = TimeOfDay
t}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> f TimeOfDay
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> TimeOfDay
datetimeTime forall a b. (a -> b) -> a -> b
$ Datetime
date

-- | A 'Datetime' with a time zone 'Offset'.
data OffsetDatetime = OffsetDatetime
  { OffsetDatetime -> Datetime
offsetDatetimeDatetime :: {-# UNPACK #-} !Datetime
  , OffsetDatetime -> Offset
offsetDatetimeOffset :: {-# UNPACK #-} !Offset
  } deriving (Int -> OffsetDatetime -> ShowS
[OffsetDatetime] -> ShowS
OffsetDatetime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OffsetDatetime] -> ShowS
$cshowList :: [OffsetDatetime] -> ShowS
show :: OffsetDatetime -> String
$cshow :: OffsetDatetime -> String
showsPrec :: Int -> OffsetDatetime -> ShowS
$cshowsPrec :: Int -> OffsetDatetime -> ShowS
Show,ReadPrec [OffsetDatetime]
ReadPrec OffsetDatetime
Int -> ReadS OffsetDatetime
ReadS [OffsetDatetime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OffsetDatetime]
$creadListPrec :: ReadPrec [OffsetDatetime]
readPrec :: ReadPrec OffsetDatetime
$creadPrec :: ReadPrec OffsetDatetime
readList :: ReadS [OffsetDatetime]
$creadList :: ReadS [OffsetDatetime]
readsPrec :: Int -> ReadS OffsetDatetime
$creadsPrec :: Int -> ReadS OffsetDatetime
Read,OffsetDatetime -> OffsetDatetime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OffsetDatetime -> OffsetDatetime -> Bool
$c/= :: OffsetDatetime -> OffsetDatetime -> Bool
== :: OffsetDatetime -> OffsetDatetime -> Bool
$c== :: OffsetDatetime -> OffsetDatetime -> Bool
Eq,Eq OffsetDatetime
OffsetDatetime -> OffsetDatetime -> Bool
OffsetDatetime -> OffsetDatetime -> Ordering
OffsetDatetime -> OffsetDatetime -> OffsetDatetime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OffsetDatetime -> OffsetDatetime -> OffsetDatetime
$cmin :: OffsetDatetime -> OffsetDatetime -> OffsetDatetime
max :: OffsetDatetime -> OffsetDatetime -> OffsetDatetime
$cmax :: OffsetDatetime -> OffsetDatetime -> OffsetDatetime
>= :: OffsetDatetime -> OffsetDatetime -> Bool
$c>= :: OffsetDatetime -> OffsetDatetime -> Bool
> :: OffsetDatetime -> OffsetDatetime -> Bool
$c> :: OffsetDatetime -> OffsetDatetime -> Bool
<= :: OffsetDatetime -> OffsetDatetime -> Bool
$c<= :: OffsetDatetime -> OffsetDatetime -> Bool
< :: OffsetDatetime -> OffsetDatetime -> Bool
$c< :: OffsetDatetime -> OffsetDatetime -> Bool
compare :: OffsetDatetime -> OffsetDatetime -> Ordering
$ccompare :: OffsetDatetime -> OffsetDatetime -> Ordering
Ord)

instance NFData OffsetDatetime where
  rnf :: OffsetDatetime -> ()
rnf (OffsetDatetime Datetime
dt Offset
o) = Datetime
dt forall a b. NFData a => a -> b -> b
`deepseq` Offset
o forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | a lens for accessing the `offsetDatetimeDatetime` field.
_offsetDatetimeDatetime
  :: Functor f => (Datetime -> f Datetime) -> OffsetDatetime -> f OffsetDatetime
_offsetDatetimeDatetime :: forall (f :: * -> *).
Functor f =>
(Datetime -> f Datetime) -> OffsetDatetime -> f OffsetDatetime
_offsetDatetimeDatetime Datetime -> f Datetime
f OffsetDatetime
date =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Datetime
d -> OffsetDatetime
date{offsetDatetimeDatetime :: Datetime
offsetDatetimeDatetime = Datetime
d}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> f Datetime
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetDatetime -> Datetime
offsetDatetimeDatetime forall a b. (a -> b) -> a -> b
$ OffsetDatetime
date

-- | a lens for accessing the `offsetDatetimeOffset` field.
_offsetDatetimeOffset
  :: Functor f => (Offset -> f Offset) -> OffsetDatetime -> f OffsetDatetime
_offsetDatetimeOffset :: forall (f :: * -> *).
Functor f =>
(Offset -> f Offset) -> OffsetDatetime -> f OffsetDatetime
_offsetDatetimeOffset Offset -> f Offset
f OffsetDatetime
date =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Offset
y -> OffsetDatetime
date{offsetDatetimeOffset :: Offset
offsetDatetimeOffset = Offset
y}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offset -> f Offset
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetDatetime -> Offset
offsetDatetimeOffset forall a b. (a -> b) -> a -> b
$ OffsetDatetime
date

-- | A time of day with nanosecond resolution.
data TimeOfDay = TimeOfDay
  { TimeOfDay -> Int
timeOfDayHour :: {-# UNPACK #-} !Int
  , TimeOfDay -> Int
timeOfDayMinute :: {-# UNPACK #-} !Int
  , TimeOfDay -> Int64
timeOfDayNanoseconds :: {-# UNPACK #-} !Int64
  } deriving (Int -> TimeOfDay -> ShowS
[TimeOfDay] -> ShowS
TimeOfDay -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeOfDay] -> ShowS
$cshowList :: [TimeOfDay] -> ShowS
show :: TimeOfDay -> String
$cshow :: TimeOfDay -> String
showsPrec :: Int -> TimeOfDay -> ShowS
$cshowsPrec :: Int -> TimeOfDay -> ShowS
Show,ReadPrec [TimeOfDay]
ReadPrec TimeOfDay
Int -> ReadS TimeOfDay
ReadS [TimeOfDay]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TimeOfDay]
$creadListPrec :: ReadPrec [TimeOfDay]
readPrec :: ReadPrec TimeOfDay
$creadPrec :: ReadPrec TimeOfDay
readList :: ReadS [TimeOfDay]
$creadList :: ReadS [TimeOfDay]
readsPrec :: Int -> ReadS TimeOfDay
$creadsPrec :: Int -> ReadS TimeOfDay
Read,TimeOfDay -> TimeOfDay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeOfDay -> TimeOfDay -> Bool
$c/= :: TimeOfDay -> TimeOfDay -> Bool
== :: TimeOfDay -> TimeOfDay -> Bool
$c== :: TimeOfDay -> TimeOfDay -> Bool
Eq,Eq TimeOfDay
TimeOfDay -> TimeOfDay -> Bool
TimeOfDay -> TimeOfDay -> Ordering
TimeOfDay -> TimeOfDay -> TimeOfDay
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeOfDay -> TimeOfDay -> TimeOfDay
$cmin :: TimeOfDay -> TimeOfDay -> TimeOfDay
max :: TimeOfDay -> TimeOfDay -> TimeOfDay
$cmax :: TimeOfDay -> TimeOfDay -> TimeOfDay
>= :: TimeOfDay -> TimeOfDay -> Bool
$c>= :: TimeOfDay -> TimeOfDay -> Bool
> :: TimeOfDay -> TimeOfDay -> Bool
$c> :: TimeOfDay -> TimeOfDay -> Bool
<= :: TimeOfDay -> TimeOfDay -> Bool
$c<= :: TimeOfDay -> TimeOfDay -> Bool
< :: TimeOfDay -> TimeOfDay -> Bool
$c< :: TimeOfDay -> TimeOfDay -> Bool
compare :: TimeOfDay -> TimeOfDay -> Ordering
$ccompare :: TimeOfDay -> TimeOfDay -> Ordering
Ord)

instance NFData TimeOfDay where
  rnf :: TimeOfDay -> ()
rnf (TimeOfDay Int
h Int
m Int64
s) = Int
h forall a b. NFData a => a -> b -> b
`deepseq` Int
m forall a b. NFData a => a -> b -> b
`deepseq` Int64
s forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | a lens for accessing the `timeOfDayHour` field.
_timeOfDayHour
  :: Functor f => (Int -> f Int) -> TimeOfDay -> f TimeOfDay
_timeOfDayHour :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> TimeOfDay -> f TimeOfDay
_timeOfDayHour Int -> f Int
f TimeOfDay
time =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
h -> TimeOfDay
time{timeOfDayHour :: Int
timeOfDayHour = Int
h}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Int
timeOfDayHour forall a b. (a -> b) -> a -> b
$ TimeOfDay
time

-- | a lens for accessing the `timeOfDayMinute` field.
_timeOfDayMinute
  :: Functor f => (Int -> f Int) -> TimeOfDay -> f TimeOfDay
_timeOfDayMinute :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> TimeOfDay -> f TimeOfDay
_timeOfDayMinute Int -> f Int
f TimeOfDay
time =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
m -> TimeOfDay
time{timeOfDayMinute :: Int
timeOfDayMinute = Int
m}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Int
timeOfDayMinute forall a b. (a -> b) -> a -> b
$ TimeOfDay
time

-- | a lens for accessing the `timeOfDayNanoseconds` field.
_timeOfDayNanoseconds
  :: Functor f => (Int64 -> f Int64) -> TimeOfDay -> f TimeOfDay
_timeOfDayNanoseconds :: forall (f :: * -> *).
Functor f =>
(Int64 -> f Int64) -> TimeOfDay -> f TimeOfDay
_timeOfDayNanoseconds Int64 -> f Int64
f TimeOfDay
time =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int64
n -> TimeOfDay
time{timeOfDayNanoseconds :: Int64
timeOfDayNanoseconds = Int64
n}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> f Int64
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Int64
timeOfDayNanoseconds forall a b. (a -> b) -> a -> b
$ TimeOfDay
time

-- | The format of a 'Datetime'. In particular
--   this provides separators for parts of the 'Datetime'
--   and nothing else.
data DatetimeFormat = DatetimeFormat
  { DatetimeFormat -> Maybe Char
datetimeFormatDateSeparator :: !(Maybe Char)
    -- ^ Separator in the date
  , DatetimeFormat -> Maybe Char
datetimeFormatSeparator :: !(Maybe Char)
    -- ^ Separator between date and time
  , DatetimeFormat -> Maybe Char
datetimeFormatTimeSeparator :: !(Maybe Char)
    -- ^ Separator in the time
  } deriving (Int -> DatetimeFormat -> ShowS
[DatetimeFormat] -> ShowS
DatetimeFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DatetimeFormat] -> ShowS
$cshowList :: [DatetimeFormat] -> ShowS
show :: DatetimeFormat -> String
$cshow :: DatetimeFormat -> String
showsPrec :: Int -> DatetimeFormat -> ShowS
$cshowsPrec :: Int -> DatetimeFormat -> ShowS
Show,ReadPrec [DatetimeFormat]
ReadPrec DatetimeFormat
Int -> ReadS DatetimeFormat
ReadS [DatetimeFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DatetimeFormat]
$creadListPrec :: ReadPrec [DatetimeFormat]
readPrec :: ReadPrec DatetimeFormat
$creadPrec :: ReadPrec DatetimeFormat
readList :: ReadS [DatetimeFormat]
$creadList :: ReadS [DatetimeFormat]
readsPrec :: Int -> ReadS DatetimeFormat
$creadsPrec :: Int -> ReadS DatetimeFormat
Read,DatetimeFormat -> DatetimeFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DatetimeFormat -> DatetimeFormat -> Bool
$c/= :: DatetimeFormat -> DatetimeFormat -> Bool
== :: DatetimeFormat -> DatetimeFormat -> Bool
$c== :: DatetimeFormat -> DatetimeFormat -> Bool
Eq,Eq DatetimeFormat
DatetimeFormat -> DatetimeFormat -> Bool
DatetimeFormat -> DatetimeFormat -> Ordering
DatetimeFormat -> DatetimeFormat -> DatetimeFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DatetimeFormat -> DatetimeFormat -> DatetimeFormat
$cmin :: DatetimeFormat -> DatetimeFormat -> DatetimeFormat
max :: DatetimeFormat -> DatetimeFormat -> DatetimeFormat
$cmax :: DatetimeFormat -> DatetimeFormat -> DatetimeFormat
>= :: DatetimeFormat -> DatetimeFormat -> Bool
$c>= :: DatetimeFormat -> DatetimeFormat -> Bool
> :: DatetimeFormat -> DatetimeFormat -> Bool
$c> :: DatetimeFormat -> DatetimeFormat -> Bool
<= :: DatetimeFormat -> DatetimeFormat -> Bool
$c<= :: DatetimeFormat -> DatetimeFormat -> Bool
< :: DatetimeFormat -> DatetimeFormat -> Bool
$c< :: DatetimeFormat -> DatetimeFormat -> Bool
compare :: DatetimeFormat -> DatetimeFormat -> Ordering
$ccompare :: DatetimeFormat -> DatetimeFormat -> Ordering
Ord)

instance NFData DatetimeFormat where
  rnf :: DatetimeFormat -> ()
rnf (DatetimeFormat Maybe Char
s1 Maybe Char
s2 Maybe Char
s3) = Maybe Char
s1 forall a b. NFData a => a -> b -> b
`deepseq` Maybe Char
s2 forall a b. NFData a => a -> b -> b
`deepseq` Maybe Char
s3 forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | Formatting settings for a timezone offset.
data OffsetFormat
  = OffsetFormatColonOff -- ^ @%z@ (e.g., -0400)
  | OffsetFormatColonOn -- ^ @%:z@ (e.g., -04:00)
  | OffsetFormatSecondsPrecision -- ^ @%::z@ (e.g., -04:00:00)
  | OffsetFormatColonAuto -- ^ @%:::z@ (e.g., -04, +05:30)
  deriving (Int -> OffsetFormat -> ShowS
[OffsetFormat] -> ShowS
OffsetFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OffsetFormat] -> ShowS
$cshowList :: [OffsetFormat] -> ShowS
show :: OffsetFormat -> String
$cshow :: OffsetFormat -> String
showsPrec :: Int -> OffsetFormat -> ShowS
$cshowsPrec :: Int -> OffsetFormat -> ShowS
Show,ReadPrec [OffsetFormat]
ReadPrec OffsetFormat
Int -> ReadS OffsetFormat
ReadS [OffsetFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OffsetFormat]
$creadListPrec :: ReadPrec [OffsetFormat]
readPrec :: ReadPrec OffsetFormat
$creadPrec :: ReadPrec OffsetFormat
readList :: ReadS [OffsetFormat]
$creadList :: ReadS [OffsetFormat]
readsPrec :: Int -> ReadS OffsetFormat
$creadsPrec :: Int -> ReadS OffsetFormat
Read,OffsetFormat -> OffsetFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OffsetFormat -> OffsetFormat -> Bool
$c/= :: OffsetFormat -> OffsetFormat -> Bool
== :: OffsetFormat -> OffsetFormat -> Bool
$c== :: OffsetFormat -> OffsetFormat -> Bool
Eq,Eq OffsetFormat
OffsetFormat -> OffsetFormat -> Bool
OffsetFormat -> OffsetFormat -> Ordering
OffsetFormat -> OffsetFormat -> OffsetFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OffsetFormat -> OffsetFormat -> OffsetFormat
$cmin :: OffsetFormat -> OffsetFormat -> OffsetFormat
max :: OffsetFormat -> OffsetFormat -> OffsetFormat
$cmax :: OffsetFormat -> OffsetFormat -> OffsetFormat
>= :: OffsetFormat -> OffsetFormat -> Bool
$c>= :: OffsetFormat -> OffsetFormat -> Bool
> :: OffsetFormat -> OffsetFormat -> Bool
$c> :: OffsetFormat -> OffsetFormat -> Bool
<= :: OffsetFormat -> OffsetFormat -> Bool
$c<= :: OffsetFormat -> OffsetFormat -> Bool
< :: OffsetFormat -> OffsetFormat -> Bool
$c< :: OffsetFormat -> OffsetFormat -> Bool
compare :: OffsetFormat -> OffsetFormat -> Ordering
$ccompare :: OffsetFormat -> OffsetFormat -> Ordering
Ord,Int -> OffsetFormat
OffsetFormat -> Int
OffsetFormat -> [OffsetFormat]
OffsetFormat -> OffsetFormat
OffsetFormat -> OffsetFormat -> [OffsetFormat]
OffsetFormat -> OffsetFormat -> OffsetFormat -> [OffsetFormat]
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 :: OffsetFormat -> OffsetFormat -> OffsetFormat -> [OffsetFormat]
$cenumFromThenTo :: OffsetFormat -> OffsetFormat -> OffsetFormat -> [OffsetFormat]
enumFromTo :: OffsetFormat -> OffsetFormat -> [OffsetFormat]
$cenumFromTo :: OffsetFormat -> OffsetFormat -> [OffsetFormat]
enumFromThen :: OffsetFormat -> OffsetFormat -> [OffsetFormat]
$cenumFromThen :: OffsetFormat -> OffsetFormat -> [OffsetFormat]
enumFrom :: OffsetFormat -> [OffsetFormat]
$cenumFrom :: OffsetFormat -> [OffsetFormat]
fromEnum :: OffsetFormat -> Int
$cfromEnum :: OffsetFormat -> Int
toEnum :: Int -> OffsetFormat
$ctoEnum :: Int -> OffsetFormat
pred :: OffsetFormat -> OffsetFormat
$cpred :: OffsetFormat -> OffsetFormat
succ :: OffsetFormat -> OffsetFormat
$csucc :: OffsetFormat -> OffsetFormat
Enum,OffsetFormat
forall a. a -> a -> Bounded a
maxBound :: OffsetFormat
$cmaxBound :: OffsetFormat
minBound :: OffsetFormat
$cminBound :: OffsetFormat
Bounded,forall x. Rep OffsetFormat x -> OffsetFormat
forall x. OffsetFormat -> Rep OffsetFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OffsetFormat x -> OffsetFormat
$cfrom :: forall x. OffsetFormat -> Rep OffsetFormat x
Generic)

instance NFData OffsetFormat where
  rnf :: OffsetFormat -> ()
rnf !OffsetFormat
_ = ()

-- | Locale-specific formatting for weekdays and months. The
--   type variable will likely be instantiated to @Text@
--   or @ByteString@.
data DatetimeLocale a = DatetimeLocale
  { forall a. DatetimeLocale a -> DayOfWeekMatch a
datetimeLocaleDaysOfWeekFull :: !(DayOfWeekMatch a)
    -- ^ full weekdays starting with Sunday, 7 elements
  , forall a. DatetimeLocale a -> DayOfWeekMatch a
datetimeLocaleDaysOfWeekAbbreviated :: !(DayOfWeekMatch a)
    -- ^ abbreviated weekdays starting with Sunday, 7 elements
  , forall a. DatetimeLocale a -> MonthMatch a
datetimeLocaleMonthsFull :: !(MonthMatch a)
    -- ^ full months starting with January, 12 elements
  , forall a. DatetimeLocale a -> MonthMatch a
datetimeLocaleMonthsAbbreviated :: !(MonthMatch a)
    -- ^ abbreviated months starting with January, 12 elements
  }

instance NFData a => NFData (DatetimeLocale a) where
  rnf :: DatetimeLocale a -> ()
rnf (DatetimeLocale DayOfWeekMatch a
d1 DayOfWeekMatch a
d2 MonthMatch a
m1 MonthMatch a
m2) =
    DayOfWeekMatch a
d1 forall a b. NFData a => a -> b -> b
`deepseq` DayOfWeekMatch a
d2 forall a b. NFData a => a -> b -> b
`deepseq` MonthMatch a
m1 forall a b. NFData a => a -> b -> b
`deepseq` MonthMatch a
m2 forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | A TimeInterval represents a start and end time.
--   It can sometimes be more ergonomic than the 'Torsor' API when
--   you only care about whether or not a 'Time' is within a certain range.
--
--   To construct a 'TimeInterval', it is best to use 'timeIntervalBuilder',
--   which maintains the invariant that @'lowerBound' interval '<=' 'upperBound' interval@
--   (all functions that act on 'TimeInterval's assume this invariant).
data TimeInterval = TimeInterval {-# UNPACK #-} !Time {-# UNPACK #-} !Time
    deriving (ReadPrec [TimeInterval]
ReadPrec TimeInterval
Int -> ReadS TimeInterval
ReadS [TimeInterval]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TimeInterval]
$creadListPrec :: ReadPrec [TimeInterval]
readPrec :: ReadPrec TimeInterval
$creadPrec :: ReadPrec TimeInterval
readList :: ReadS [TimeInterval]
$creadList :: ReadS [TimeInterval]
readsPrec :: Int -> ReadS TimeInterval
$creadsPrec :: Int -> ReadS TimeInterval
Read,Int -> TimeInterval -> ShowS
[TimeInterval] -> ShowS
TimeInterval -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeInterval] -> ShowS
$cshowList :: [TimeInterval] -> ShowS
show :: TimeInterval -> String
$cshow :: TimeInterval -> String
showsPrec :: Int -> TimeInterval -> ShowS
$cshowsPrec :: Int -> TimeInterval -> ShowS
Show,TimeInterval -> TimeInterval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeInterval -> TimeInterval -> Bool
$c/= :: TimeInterval -> TimeInterval -> Bool
== :: TimeInterval -> TimeInterval -> Bool
$c== :: TimeInterval -> TimeInterval -> Bool
Eq,Eq TimeInterval
TimeInterval -> TimeInterval -> Bool
TimeInterval -> TimeInterval -> Ordering
TimeInterval -> TimeInterval -> TimeInterval
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeInterval -> TimeInterval -> TimeInterval
$cmin :: TimeInterval -> TimeInterval -> TimeInterval
max :: TimeInterval -> TimeInterval -> TimeInterval
$cmax :: TimeInterval -> TimeInterval -> TimeInterval
>= :: TimeInterval -> TimeInterval -> Bool
$c>= :: TimeInterval -> TimeInterval -> Bool
> :: TimeInterval -> TimeInterval -> Bool
$c> :: TimeInterval -> TimeInterval -> Bool
<= :: TimeInterval -> TimeInterval -> Bool
$c<= :: TimeInterval -> TimeInterval -> Bool
< :: TimeInterval -> TimeInterval -> Bool
$c< :: TimeInterval -> TimeInterval -> Bool
compare :: TimeInterval -> TimeInterval -> Ordering
$ccompare :: TimeInterval -> TimeInterval -> Ordering
Ord,TimeInterval
forall a. a -> a -> Bounded a
maxBound :: TimeInterval
$cmaxBound :: TimeInterval
minBound :: TimeInterval
$cminBound :: TimeInterval
Bounded)

instance NFData TimeInterval where
  rnf :: TimeInterval -> ()
rnf (TimeInterval Time
t1 Time
t2) = Time
t1 forall a b. NFData a => a -> b -> b
`deepseq` Time
t2 forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | Locale-specific formatting for AM and PM.
data MeridiemLocale a = MeridiemLocale
  { forall a. MeridiemLocale a -> a
meridiemLocaleAm :: !a
  , forall a. MeridiemLocale a -> a
meridiemLocalePm :: !a
  } deriving (ReadPrec [MeridiemLocale a]
ReadPrec (MeridiemLocale a)
ReadS [MeridiemLocale a]
forall a. Read a => ReadPrec [MeridiemLocale a]
forall a. Read a => ReadPrec (MeridiemLocale a)
forall a. Read a => Int -> ReadS (MeridiemLocale a)
forall a. Read a => ReadS [MeridiemLocale a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MeridiemLocale a]
$creadListPrec :: forall a. Read a => ReadPrec [MeridiemLocale a]
readPrec :: ReadPrec (MeridiemLocale a)
$creadPrec :: forall a. Read a => ReadPrec (MeridiemLocale a)
readList :: ReadS [MeridiemLocale a]
$creadList :: forall a. Read a => ReadS [MeridiemLocale a]
readsPrec :: Int -> ReadS (MeridiemLocale a)
$creadsPrec :: forall a. Read a => Int -> ReadS (MeridiemLocale a)
Read,Int -> MeridiemLocale a -> ShowS
forall a. Show a => Int -> MeridiemLocale a -> ShowS
forall a. Show a => [MeridiemLocale a] -> ShowS
forall a. Show a => MeridiemLocale a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeridiemLocale a] -> ShowS
$cshowList :: forall a. Show a => [MeridiemLocale a] -> ShowS
show :: MeridiemLocale a -> String
$cshow :: forall a. Show a => MeridiemLocale a -> String
showsPrec :: Int -> MeridiemLocale a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MeridiemLocale a -> ShowS
Show,MeridiemLocale a -> MeridiemLocale a -> Bool
forall a. Eq a => MeridiemLocale a -> MeridiemLocale a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeridiemLocale a -> MeridiemLocale a -> Bool
$c/= :: forall a. Eq a => MeridiemLocale a -> MeridiemLocale a -> Bool
== :: MeridiemLocale a -> MeridiemLocale a -> Bool
$c== :: forall a. Eq a => MeridiemLocale a -> MeridiemLocale a -> Bool
Eq,MeridiemLocale a -> MeridiemLocale a -> Bool
MeridiemLocale a -> MeridiemLocale a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (MeridiemLocale a)
forall a. Ord a => MeridiemLocale a -> MeridiemLocale a -> Bool
forall a. Ord a => MeridiemLocale a -> MeridiemLocale a -> Ordering
forall a.
Ord a =>
MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
min :: MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
$cmin :: forall a.
Ord a =>
MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
max :: MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
$cmax :: forall a.
Ord a =>
MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
>= :: MeridiemLocale a -> MeridiemLocale a -> Bool
$c>= :: forall a. Ord a => MeridiemLocale a -> MeridiemLocale a -> Bool
> :: MeridiemLocale a -> MeridiemLocale a -> Bool
$c> :: forall a. Ord a => MeridiemLocale a -> MeridiemLocale a -> Bool
<= :: MeridiemLocale a -> MeridiemLocale a -> Bool
$c<= :: forall a. Ord a => MeridiemLocale a -> MeridiemLocale a -> Bool
< :: MeridiemLocale a -> MeridiemLocale a -> Bool
$c< :: forall a. Ord a => MeridiemLocale a -> MeridiemLocale a -> Bool
compare :: MeridiemLocale a -> MeridiemLocale a -> Ordering
$ccompare :: forall a. Ord a => MeridiemLocale a -> MeridiemLocale a -> Ordering
Ord)

instance NFData a => NFData (MeridiemLocale a) where
  rnf :: MeridiemLocale a -> ()
rnf (MeridiemLocale a
am a
pm) = a
am forall a b. NFData a => a -> b -> b
`deepseq` a
pm forall a b. NFData a => a -> b -> b
`deepseq` ()

newtype instance UVector.MVector s Month = MV_Month (PVector.MVector s Month)
newtype instance UVector.Vector Month = V_Month (PVector.Vector Month)

instance UVector.Unbox Month

instance MGVector.MVector UVector.MVector Month where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicInitialize #-}
  {-# INLINE basicUnsafeReplicate #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength :: forall s. MVector s Month -> Int
basicLength (MV_Month MVector s Month
v) = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MGVector.basicLength MVector s Month
v
  basicUnsafeSlice :: forall s. Int -> Int -> MVector s Month -> MVector s Month
basicUnsafeSlice Int
i Int
n (MV_Month MVector s Month
v) = forall s. MVector s Month -> MVector s Month
MV_Month forall a b. (a -> b) -> a -> b
$ forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
MGVector.basicUnsafeSlice Int
i Int
n MVector s Month
v
  basicOverlaps :: forall s. MVector s Month -> MVector s Month -> Bool
basicOverlaps (MV_Month MVector s Month
v1) (MV_Month MVector s Month
v2) = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
MGVector.basicOverlaps MVector s Month
v1 MVector s Month
v2
  basicUnsafeNew :: forall (m :: * -> *).
PrimMonad m =>
Int -> m (MVector (PrimState m) Month)
basicUnsafeNew Int
n = forall s. MVector s Month -> MVector s Month
MV_Month forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MGVector.basicUnsafeNew Int
n
  basicInitialize :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Month -> m ()
basicInitialize (MV_Month MVector (PrimState m) Month
v) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicInitialize MVector (PrimState m) Month
v
  basicUnsafeReplicate :: forall (m :: * -> *).
PrimMonad m =>
Int -> Month -> m (MVector (PrimState m) Month)
basicUnsafeReplicate Int
n Month
x = forall s. MVector s Month -> MVector s Month
MV_Month forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
MGVector.basicUnsafeReplicate Int
n Month
x
  basicUnsafeRead :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Month -> Int -> m Month
basicUnsafeRead (MV_Month MVector (PrimState m) Month
v) Int
i = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
MGVector.basicUnsafeRead MVector (PrimState m) Month
v Int
i
  basicUnsafeWrite :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Month -> Int -> Month -> m ()
basicUnsafeWrite (MV_Month MVector (PrimState m) Month
v) Int
i Month
x = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
MGVector.basicUnsafeWrite MVector (PrimState m) Month
v Int
i Month
x
  basicClear :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Month -> m ()
basicClear (MV_Month MVector (PrimState m) Month
v) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicClear MVector (PrimState m) Month
v
  basicSet :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Month -> Month -> m ()
basicSet (MV_Month MVector (PrimState m) Month
v) Month
x = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
MGVector.basicSet MVector (PrimState m) Month
v Month
x
  basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Month -> MVector (PrimState m) Month -> m ()
basicUnsafeCopy (MV_Month MVector (PrimState m) Month
v1) (MV_Month MVector (PrimState m) Month
v2) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeCopy MVector (PrimState m) Month
v1 MVector (PrimState m) Month
v2
  basicUnsafeMove :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Month -> MVector (PrimState m) Month -> m ()
basicUnsafeMove (MV_Month MVector (PrimState m) Month
v1) (MV_Month MVector (PrimState m) Month
v2) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeMove MVector (PrimState m) Month
v1 MVector (PrimState m) Month
v2
  basicUnsafeGrow :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Month
-> Int -> m (MVector (PrimState m) Month)
basicUnsafeGrow (MV_Month MVector (PrimState m) Month
v) Int
n = forall s. MVector s Month -> MVector s Month
MV_Month forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
MGVector.basicUnsafeGrow MVector (PrimState m) Month
v Int
n

instance GVector.Vector UVector.Vector Month where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze :: forall (m :: * -> *).
PrimMonad m =>
Mutable Vector (PrimState m) Month -> m (Vector Month)
basicUnsafeFreeze (MV_Month MVector (PrimState m) Month
v) = Vector Month -> Vector Month
V_Month forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
GVector.basicUnsafeFreeze MVector (PrimState m) Month
v
  basicUnsafeThaw :: forall (m :: * -> *).
PrimMonad m =>
Vector Month -> m (Mutable Vector (PrimState m) Month)
basicUnsafeThaw (V_Month Vector Month
v) = forall s. MVector s Month -> MVector s Month
MV_Month forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
GVector.basicUnsafeThaw Vector Month
v
  basicLength :: Vector Month -> Int
basicLength (V_Month Vector Month
v) = forall (v :: * -> *) a. Vector v a => v a -> Int
GVector.basicLength Vector Month
v
  basicUnsafeSlice :: Int -> Int -> Vector Month -> Vector Month
basicUnsafeSlice Int
i Int
n (V_Month Vector Month
v) = Vector Month -> Vector Month
V_Month forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i Int
n Vector Month
v
  basicUnsafeIndexM :: forall (m :: * -> *). Monad m => Vector Month -> Int -> m Month
basicUnsafeIndexM (V_Month Vector Month
v) Int
i = forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
GVector.basicUnsafeIndexM Vector Month
v Int
i
  basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
Mutable Vector (PrimState m) Month -> Vector Month -> m ()
basicUnsafeCopy (MV_Month MVector (PrimState m) Month
mv) (V_Month Vector Month
v) = forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
GVector.basicUnsafeCopy MVector (PrimState m) Month
mv Vector Month
v
  elemseq :: forall b. Vector Month -> Month -> b -> b
elemseq Vector Month
_ = seq :: forall a b. a -> b -> b
seq

newtype instance UVector.MVector s DayOfMonth = MV_DayOfMonth (PVector.MVector s DayOfMonth)
newtype instance UVector.Vector DayOfMonth = V_DayOfMonth (PVector.Vector DayOfMonth)

instance UVector.Unbox DayOfMonth

instance MGVector.MVector UVector.MVector DayOfMonth where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicInitialize #-}
  {-# INLINE basicUnsafeReplicate #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength :: forall s. MVector s DayOfMonth -> Int
basicLength (MV_DayOfMonth MVector s DayOfMonth
v) = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MGVector.basicLength MVector s DayOfMonth
v
  basicUnsafeSlice :: forall s.
Int -> Int -> MVector s DayOfMonth -> MVector s DayOfMonth
basicUnsafeSlice Int
i Int
n (MV_DayOfMonth MVector s DayOfMonth
v) = forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth forall a b. (a -> b) -> a -> b
$ forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
MGVector.basicUnsafeSlice Int
i Int
n MVector s DayOfMonth
v
  basicOverlaps :: forall s. MVector s DayOfMonth -> MVector s DayOfMonth -> Bool
basicOverlaps (MV_DayOfMonth MVector s DayOfMonth
v1) (MV_DayOfMonth MVector s DayOfMonth
v2) = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
MGVector.basicOverlaps MVector s DayOfMonth
v1 MVector s DayOfMonth
v2
  basicUnsafeNew :: forall (m :: * -> *).
PrimMonad m =>
Int -> m (MVector (PrimState m) DayOfMonth)
basicUnsafeNew Int
n = forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MGVector.basicUnsafeNew Int
n
  basicInitialize :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) DayOfMonth -> m ()
basicInitialize (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicInitialize MVector (PrimState m) DayOfMonth
v
  basicUnsafeReplicate :: forall (m :: * -> *).
PrimMonad m =>
Int -> DayOfMonth -> m (MVector (PrimState m) DayOfMonth)
basicUnsafeReplicate Int
n DayOfMonth
x = forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
MGVector.basicUnsafeReplicate Int
n DayOfMonth
x
  basicUnsafeRead :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) DayOfMonth -> Int -> m DayOfMonth
basicUnsafeRead (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v) Int
i = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
MGVector.basicUnsafeRead MVector (PrimState m) DayOfMonth
v Int
i
  basicUnsafeWrite :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) DayOfMonth -> Int -> DayOfMonth -> m ()
basicUnsafeWrite (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v) Int
i DayOfMonth
x = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
MGVector.basicUnsafeWrite MVector (PrimState m) DayOfMonth
v Int
i DayOfMonth
x
  basicClear :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) DayOfMonth -> m ()
basicClear (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicClear MVector (PrimState m) DayOfMonth
v
  basicSet :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) DayOfMonth -> DayOfMonth -> m ()
basicSet (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v) DayOfMonth
x = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
MGVector.basicSet MVector (PrimState m) DayOfMonth
v DayOfMonth
x
  basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) DayOfMonth
-> MVector (PrimState m) DayOfMonth -> m ()
basicUnsafeCopy (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v1) (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v2) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeCopy MVector (PrimState m) DayOfMonth
v1 MVector (PrimState m) DayOfMonth
v2
  basicUnsafeMove :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) DayOfMonth
-> MVector (PrimState m) DayOfMonth -> m ()
basicUnsafeMove (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v1) (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v2) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeMove MVector (PrimState m) DayOfMonth
v1 MVector (PrimState m) DayOfMonth
v2
  basicUnsafeGrow :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) DayOfMonth
-> Int -> m (MVector (PrimState m) DayOfMonth)
basicUnsafeGrow (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v) Int
n = forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
MGVector.basicUnsafeGrow MVector (PrimState m) DayOfMonth
v Int
n

instance GVector.Vector UVector.Vector DayOfMonth where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze :: forall (m :: * -> *).
PrimMonad m =>
Mutable Vector (PrimState m) DayOfMonth -> m (Vector DayOfMonth)
basicUnsafeFreeze (MV_DayOfMonth MVector (PrimState m) DayOfMonth
v) = Vector DayOfMonth -> Vector DayOfMonth
V_DayOfMonth forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
GVector.basicUnsafeFreeze MVector (PrimState m) DayOfMonth
v
  basicUnsafeThaw :: forall (m :: * -> *).
PrimMonad m =>
Vector DayOfMonth -> m (Mutable Vector (PrimState m) DayOfMonth)
basicUnsafeThaw (V_DayOfMonth Vector DayOfMonth
v) = forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
GVector.basicUnsafeThaw Vector DayOfMonth
v
  basicLength :: Vector DayOfMonth -> Int
basicLength (V_DayOfMonth Vector DayOfMonth
v) = forall (v :: * -> *) a. Vector v a => v a -> Int
GVector.basicLength Vector DayOfMonth
v
  basicUnsafeSlice :: Int -> Int -> Vector DayOfMonth -> Vector DayOfMonth
basicUnsafeSlice Int
i Int
n (V_DayOfMonth Vector DayOfMonth
v) = Vector DayOfMonth -> Vector DayOfMonth
V_DayOfMonth forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i Int
n Vector DayOfMonth
v
  basicUnsafeIndexM :: forall (m :: * -> *).
Monad m =>
Vector DayOfMonth -> Int -> m DayOfMonth
basicUnsafeIndexM (V_DayOfMonth Vector DayOfMonth
v) Int
i = forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
GVector.basicUnsafeIndexM Vector DayOfMonth
v Int
i
  basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
Mutable Vector (PrimState m) DayOfMonth
-> Vector DayOfMonth -> m ()
basicUnsafeCopy (MV_DayOfMonth MVector (PrimState m) DayOfMonth
mv) (V_DayOfMonth Vector DayOfMonth
v) = forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
GVector.basicUnsafeCopy MVector (PrimState m) DayOfMonth
mv Vector DayOfMonth
v
  elemseq :: forall b. Vector DayOfMonth -> DayOfMonth -> b -> b
elemseq Vector DayOfMonth
_ = seq :: forall a b. a -> b -> b
seq

------------------------
-- The Torsor and Enum instances for Date and OrdinalDate
-- are both bad. This only causes problems for dates
-- at least a million years in the future. Some of this
-- badness is caused by pragmatism, and some of it is caused by
-- my own laziness.
--
-- The badness that comes from pragmatism:
--   - Int technically is not a good delta for Date. Date
--     has too many inhabitants. If we subtract the lowest
--     Date from the highest Date, we get something too
--     big to fit in a machine integer.
--   - There is no good way to write fromEnum or toEnum for
--     Date. Again, Date has more inhabitants than Int, so
--     it simply cannot be done.
-- The badness that comes from laziness:
--   - Technically, we should still be able to add deltas to
--     Dates that do not fit in machine integers. We should
--     also be able to correctly subtract Dates to cannot
--     fit in machine integers.
--   - For similar reasons, the Enum functions succ, pred,
--     enumFromThen, enumFromThenTo, etc. could all have
--     better definitions than the default ones currently
--     used.
-- If, for some reason, anyone ever wants to fix the badness
-- that comes from laziness, all
-- you really have to do is define a version of dateToDay,
-- dayToDate, ordinalDateToDay, and dayToOrdinalDate
-- that uses something bigger instead of Day. Maybe something like
-- (Int,Word) or (Int,Word,Word). I'm not exactly sure how
-- big it would need to be to work correctly. Then you could
-- handle deltas of two very far off days correctly, provided
-- that the two days weren't also super far from each other.
--
------------------------
instance Torsor Date Int where
  add :: Int -> Date -> Date
add Int
i Date
d = Day -> Date
dayToDate (forall p v. Torsor p v => v -> p -> p
add Int
i (Date -> Day
dateToDay Date
d))
  difference :: Date -> Date -> Int
difference Date
a Date
b = forall p v. Torsor p v => p -> p -> v
difference (Date -> Day
dateToDay Date
a) (Date -> Day
dateToDay Date
b)

instance Torsor OrdinalDate Int where
  add :: Int -> OrdinalDate -> OrdinalDate
add Int
i OrdinalDate
d = Day -> OrdinalDate
dayToOrdinalDate (forall p v. Torsor p v => v -> p -> p
add Int
i (OrdinalDate -> Day
ordinalDateToDay OrdinalDate
d))
  difference :: OrdinalDate -> OrdinalDate -> Int
difference OrdinalDate
a OrdinalDate
b = forall p v. Torsor p v => p -> p -> v
difference (OrdinalDate -> Day
ordinalDateToDay OrdinalDate
a) (OrdinalDate -> Day
ordinalDateToDay OrdinalDate
b)

instance Enum Date where
  fromEnum :: Date -> Int
fromEnum Date
d = forall a. Enum a => a -> Int
fromEnum (Date -> Day
dateToDay Date
d)
  toEnum :: Int -> Date
toEnum Int
i = Day -> Date
dayToDate (forall a. Enum a => Int -> a
toEnum Int
i)

instance Enum OrdinalDate where
  fromEnum :: OrdinalDate -> Int
fromEnum OrdinalDate
d = forall a. Enum a => a -> Int
fromEnum (OrdinalDate -> Day
ordinalDateToDay OrdinalDate
d)
  toEnum :: Int -> OrdinalDate
toEnum Int
i = Day -> OrdinalDate
dayToOrdinalDate (forall a. Enum a => Int -> a
toEnum Int
i)

instance ToJSON Datetime where
  toJSON :: Datetime -> Value
toJSON = Text -> Value
AE.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubsecondPrecision -> DatetimeFormat -> Datetime -> Text
encode_YmdHMS SubsecondPrecision
SubsecondPrecisionAuto DatetimeFormat
hyphen
  toEncoding :: Datetime -> Encoding
toEncoding Datetime
x = forall a. Builder -> Encoding' a
AEE.unsafeToEncoding (Char -> Builder
BB.char7 Char
'"' forall a. Semigroup a => a -> a -> a
SG.<> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder
builderUtf8_YmdHMS SubsecondPrecision
SubsecondPrecisionAuto DatetimeFormat
hyphen Datetime
x forall a. Semigroup a => a -> a -> a
SG.<> Char -> Builder
BB.char7 Char
'"')

instance FromJSON Datetime where
  parseJSON :: Value -> Parser Datetime
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
AE.withText String
"Datetime" Text -> Parser Datetime
aesonParserDatetime

aesonParserDatetime :: Text -> AET.Parser Datetime
aesonParserDatetime :: Text -> Parser Datetime
aesonParserDatetime =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not parse Datetime")) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Datetime
parser_lenient forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
AT.endOfInput)

instance ToJSON Offset where
  toJSON :: Offset -> Value
toJSON = Text -> Value
AE.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetFormat -> Offset -> Text
encodeOffset OffsetFormat
OffsetFormatColonOn
  toEncoding :: Offset -> Encoding
toEncoding Offset
x = forall a. Builder -> Encoding' a
AEE.unsafeToEncoding (Char -> Builder
BB.char7 Char
'"' forall a. Semigroup a => a -> a -> a
SG.<> OffsetFormat -> Offset -> Builder
builderOffsetUtf8 OffsetFormat
OffsetFormatColonOn Offset
x forall a. Semigroup a => a -> a -> a
SG.<> Char -> Builder
BB.char7 Char
'"')

instance FromJSON Offset where
  parseJSON :: Value -> Parser Offset
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
AE.withText String
"Offset" Text -> Parser Offset
aesonParserOffset

instance ToJSONKey Offset where
  toJSONKey :: ToJSONKeyFunction Offset
toJSONKey = forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
AE.ToJSONKeyText
    (Text -> Key
keyFromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetFormat -> Offset -> Text
encodeOffset OffsetFormat
OffsetFormatColonOn)
    (\Offset
x -> forall a. Builder -> Encoding' a
AEE.unsafeToEncoding (Char -> Builder
BB.char7 Char
'"' forall a. Semigroup a => a -> a -> a
SG.<> OffsetFormat -> Offset -> Builder
builderOffsetUtf8 OffsetFormat
OffsetFormatColonOn Offset
x forall a. Semigroup a => a -> a -> a
SG.<> Char -> Builder
BB.char7 Char
'"'))
    where
#if MIN_VERSION_aeson(2,0,0)
      keyFromText :: Text -> Key
keyFromText = Text -> Key
AK.fromText
#else
      keyFromText = id
#endif

instance FromJSONKey Offset where
  fromJSONKey :: FromJSONKeyFunction Offset
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
AE.FromJSONKeyTextParser Text -> Parser Offset
aesonParserOffset

aesonParserOffset :: Text -> AET.Parser Offset
aesonParserOffset :: Text -> Parser Offset
aesonParserOffset Text
t = case OffsetFormat -> Text -> Maybe Offset
decodeOffset OffsetFormat
OffsetFormatColonOn Text
t of
  Maybe Offset
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not parse Offset"
  Just Offset
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Offset
x

-- | Holds all of the parts encoded by a 'Time'.
--   Can be used for formatting if what is presently in the API
--   does not suffice.
data TimeParts = TimeParts
  { TimeParts -> Int
timePartsDay :: !Int -- ^ days 0-31
  , TimeParts -> Int
timePartsMonth :: !Int -- ^ months 0-11
  , TimeParts -> Int
timePartsYear :: !Int
  , TimeParts -> Int
timePartsHour :: !Int -- ^ hours 0-23
  , TimeParts -> Int
timePartsMinute :: !Int -- ^ minutes 0-59
  , TimeParts -> Int
timePartsSecond :: !Int -- ^ seconds 0-59
  , TimeParts -> Int
timePartsSubsecond :: !Int -- ^ fraction of a second with nanosecond resolution
  , TimeParts -> Int
timePartsOffset :: !Int
  }
  deriving (TimeParts -> TimeParts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeParts -> TimeParts -> Bool
$c/= :: TimeParts -> TimeParts -> Bool
== :: TimeParts -> TimeParts -> Bool
$c== :: TimeParts -> TimeParts -> Bool
Eq, ReadPrec [TimeParts]
ReadPrec TimeParts
Int -> ReadS TimeParts
ReadS [TimeParts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TimeParts]
$creadListPrec :: ReadPrec [TimeParts]
readPrec :: ReadPrec TimeParts
$creadPrec :: ReadPrec TimeParts
readList :: ReadS [TimeParts]
$creadList :: ReadS [TimeParts]
readsPrec :: Int -> ReadS TimeParts
$creadsPrec :: Int -> ReadS TimeParts
Read, Int -> TimeParts -> ShowS
[TimeParts] -> ShowS
TimeParts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeParts] -> ShowS
$cshowList :: [TimeParts] -> ShowS
show :: TimeParts -> String
$cshow :: TimeParts -> String
showsPrec :: Int -> TimeParts -> ShowS
$cshowsPrec :: Int -> TimeParts -> ShowS
Show)

instance NFData TimeParts where
  rnf :: TimeParts -> ()
rnf (TimeParts Int
d Int
mo Int
y Int
h Int
m Int
s Int
ss Int
o) =
    Int
d forall a b. NFData a => a -> b -> b
`deepseq` Int
mo forall a b. NFData a => a -> b -> b
`deepseq` Int
y forall a b. NFData a => a -> b -> b
`deepseq` Int
h forall a b. NFData a => a -> b -> b
`deepseq` Int
m forall a b. NFData a => a -> b -> b
`deepseq` Int
s forall a b. NFData a => a -> b -> b
`deepseq` Int
ss forall a b. NFData a => a -> b -> b
`deepseq` Int
o forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | Deconstruct a 'Time' into its 'TimeParts'.
timeParts :: Offset -> Time -> TimeParts
timeParts :: Offset -> Time -> TimeParts
timeParts Offset
o0 Time
t0 =
  let
    OffsetDatetime (Datetime Date
dt TimeOfDay
t) Offset
o = Offset -> Time -> OffsetDatetime
timeToOffsetDatetime Offset
o0 Time
t0
    Date Year
y Month
mo DayOfMonth
d = Date
dt
    TimeOfDay Int
h Int
mi Int64
s = TimeOfDay
t
    (Int64
wholeSeconds, Int64
subsecond) = forall a. Integral a => a -> a -> (a, a)
divMod Int64
s Int64
100000000
  in TimeParts
    { timePartsDay :: Int
timePartsDay = forall a b. (Integral a, Num b) => a -> b
fromIntegral (DayOfMonth -> Int
getDayOfMonth DayOfMonth
d)
    , timePartsMonth :: Int
timePartsMonth = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Month -> Int
getMonth Month
mo)
    , timePartsYear :: Int
timePartsYear = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Year -> Int
getYear Year
y)
    , timePartsHour :: Int
timePartsHour = Int
h
    , timePartsMinute :: Int
timePartsMinute = Int
mi
    , timePartsSecond :: Int
timePartsSecond = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
wholeSeconds
    , timePartsSubsecond :: Int
timePartsSubsecond = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
subsecond
    , timePartsOffset :: Int
timePartsOffset = Offset -> Int
getOffset Offset
o
    }

-- | Decode an ISO-8601-encode datetime. The encoded time must be suffixed
-- by either @Z@ or @+00:00@ or @+00@.
decodeShortTextIso8601Zulu :: ShortText -> Maybe Chronos.Datetime
decodeShortTextIso8601Zulu :: ShortText -> Maybe Datetime
decodeShortTextIso8601Zulu !ShortText
t = forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
BVP.parseBytesMaybe
  ( do Datetime
d <- forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless Char
'T'
       Bytes
remaining <- forall e s. Parser e s Bytes
BVP.remaining
       case Bytes -> Int
Bytes.length Bytes
remaining of
         Int
1 | Bytes -> Int -> Word8
Bytes.unsafeIndex Bytes
remaining Int
0 forall a. Eq a => a -> a -> Bool
== Word8
0x5A -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Datetime
d
         Int
3 | CString -> Bytes -> Bool
Bytes.equalsCString (forall a. Addr# -> Ptr a
Ptr Addr#
"+00"#) Bytes
remaining -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Datetime
d
         Int
6 | CString -> Bytes -> Bool
Bytes.equalsCString (forall a. Addr# -> Ptr a
Ptr Addr#
"+00:00"#) Bytes
remaining -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Datetime
d
         Int
_ -> forall e s a. e -> Parser e s a
BVP.fail ()
  ) (ShortByteString -> Bytes
Bytes.fromShortByteString (ShortText -> ShortByteString
TS.toShortByteString ShortText
t))

-- | Decode an ISO-8601-encode datetime. The encoded time must not be suffixed
-- by an offset. Any offset (e.g. @-05:00@, @+00:00@, @Z@) will cause a decode
-- failure.
decodeShortTextIso8601Zoneless :: ShortText -> Maybe Chronos.Datetime
decodeShortTextIso8601Zoneless :: ShortText -> Maybe Datetime
decodeShortTextIso8601Zoneless !ShortText
t = Bytes -> Maybe Datetime
decodeUtf8BytesIso8601Zoneless
  (ShortByteString -> Bytes
Bytes.fromShortByteString (ShortText -> ShortByteString
TS.toShortByteString ShortText
t))

-- | Decode an ISO-8601-encode datetime. The encoded time must include an offset
-- (e.g. @-05:00@, @+00:00@, @Z@).
decodeShortTextIso8601 :: ShortText -> Maybe Chronos.OffsetDatetime
decodeShortTextIso8601 :: ShortText -> Maybe OffsetDatetime
decodeShortTextIso8601 !ShortText
t = Bytes -> Maybe OffsetDatetime
decodeUtf8BytesIso8601
  (ShortByteString -> Bytes
Bytes.fromShortByteString (ShortText -> ShortByteString
TS.toShortByteString ShortText
t))

-- | Decode an ISO-8601-encode datetime.
decodeUtf8BytesIso8601Zoneless :: Bytes -> Maybe Chronos.Datetime
decodeUtf8BytesIso8601Zoneless :: Bytes -> Maybe Datetime
decodeUtf8BytesIso8601Zoneless !Bytes
b =
  forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
BVP.parseBytesMaybe (forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless Char
'T' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s. e -> Parser e s ()
BVP.endOfInput ()) Bytes
b

-- | Decode a datetime that is nearly ISO-8601-encoded but uses a space
-- instead of a T to separate the date and the time. For example:
-- @2022-10-29 14:00:05@.
decodeUtf8BytesIso8601ZonelessSpaced :: Bytes -> Maybe Chronos.Datetime
decodeUtf8BytesIso8601ZonelessSpaced :: Bytes -> Maybe Datetime
decodeUtf8BytesIso8601ZonelessSpaced !Bytes
b =
  forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
BVP.parseBytesMaybe (forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless Char
' ' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s. e -> Parser e s ()
BVP.endOfInput ()) Bytes
b

decodeUtf8BytesIso8601 :: Bytes -> Maybe Chronos.OffsetDatetime
decodeUtf8BytesIso8601 :: Bytes -> Maybe OffsetDatetime
decodeUtf8BytesIso8601 !Bytes
b =
  forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
BVP.parseBytesMaybe (forall s. Parser () s OffsetDatetime
parserUtf8BytesIso8601 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s. e -> Parser e s ()
BVP.endOfInput ()) Bytes
b

parserUtf8BytesIso8601Zoneless :: Char -> BVP.Parser () s Chronos.Datetime
{-# noinline parserUtf8BytesIso8601Zoneless #-}
parserUtf8BytesIso8601Zoneless :: forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless !Char
sep = do
  Word
year <- forall e s. e -> Parser e s Word
Latin.decWord ()
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'-'
  Word
month' <- forall e s. e -> Parser e s Word
Latin.decWord ()
  let !month :: Word
month = Word
month' forall a. Num a => a -> a -> a
- Word
1
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
month forall a. Ord a => a -> a -> Bool
>= Word
12) (forall e s a. e -> Parser e s a
BVP.fail ())
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'-'
  Word
dayWord <- forall e s. e -> Parser e s Word
Latin.decWord ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
dayWord forall a. Ord a => a -> a -> Bool
> Word
31) (forall e s a. e -> Parser e s a
BVP.fail ())
  let !date :: Date
date = Year -> Month -> DayOfMonth -> Date
Chronos.Date
        (Int -> Year
Chronos.Year (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
year))
        (Int -> Month
Chronos.Month (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
month))
        (Int -> DayOfMonth
Chronos.DayOfMonth (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
dayWord))
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
sep
  Word8
hourWord <- forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
hourWord forall a. Ord a => a -> a -> Bool
> Word8
23) (forall e s a. e -> Parser e s a
BVP.fail ())
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
  Word8
minuteWord <- forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
minuteWord forall a. Ord a => a -> a -> Bool
> Word8
59) (forall e s a. e -> Parser e s a
BVP.fail ())
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
  Word8
sec <- forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sec forall a. Ord a => a -> a -> Bool
> Word8
59) (forall e s a. e -> Parser e s a
BVP.fail ())
  !Word64
nanos <- forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (forall a. Eq a => a -> a -> Bool
==Char
'.') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
      (Int
n,Word64
w) <- forall e s a. Parser e s a -> Parser e s (Int, a)
BVP.measure (forall e s. e -> Parser e s Word64
Latin.decWord64 ())
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
> Int
9) (forall e s a. e -> Parser e s a
BVP.fail ())
      let go :: t -> t -> t
go !t
acc !t
b = case t
b of
            t
0 -> t
acc
            t
_ -> t -> t -> t
go (t
acc forall a. Num a => a -> a -> a
* t
10) (t
b forall a. Num a => a -> a -> a
- t
1)
          !ns :: Word64
ns = forall {t} {t}. (Eq t, Num t, Num t) => t -> t -> t
go Word64
w (Int
9 forall a. Num a => a -> a -> a
- Int
n)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
ns
    Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
  let !td :: TimeOfDay
td = Int -> Int -> Int64 -> TimeOfDay
Chronos.TimeOfDay
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
hourWord)
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
minuteWord)
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Int64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
sec forall a. Num a => a -> a -> a
* Word64
1000000000 forall a. Num a => a -> a -> a
+ Word64
nanos))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Date -> TimeOfDay -> Datetime
Chronos.Datetime Date
date TimeOfDay
td

-- | Consume an ISO-8601-encoded datetime with offset. This will consume any of
-- the following:
--
-- > 2021-12-05T23:01:09Z
-- > 2021-12-05T23:01:09.000Z
-- > 2021-12-05T23:01:09.123456789Z
-- > 2021-12-05T23:01:09+05:00
-- > 2021-12-05T23:01:09.357-11:00
parserUtf8BytesIso8601 :: BVP.Parser () s Chronos.OffsetDatetime
{-# noinline parserUtf8BytesIso8601 #-}
parserUtf8BytesIso8601 :: forall s. Parser () s OffsetDatetime
parserUtf8BytesIso8601 = do
  Datetime
dt <- forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless Char
'T'
  Int
off <- forall e s. e -> Parser e s Char
Latin.any () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Char
'Z' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
    Char
'+' -> forall s. Parser () s Int
parserBytesOffset
    Char
'-' -> do
      !Int
off <- forall s. Parser () s Int
parserBytesOffset
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Num a => a -> a
negate Int
off)
    Char
_ -> forall e s a. e -> Parser e s a
BVP.fail ()
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Datetime -> Offset -> OffsetDatetime
Chronos.OffsetDatetime Datetime
dt (Int -> Offset
Chronos.Offset Int
off)

-- Should consume exactly five characters: HH:MM. However, the implementation
-- is more generous.
parserBytesOffset :: BVP.Parser () s Int
parserBytesOffset :: forall s. Parser () s Int
parserBytesOffset = do
  Word8
h <- forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
  Word8
m <- forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  let !r :: Int
r = ((forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Int Word8
h) forall a. Num a => a -> a -> a
* Int
60) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Int Word8
m
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r

encodeShortTextIso8601Zulu :: Datetime -> ShortText
{-# noinline encodeShortTextIso8601Zulu #-}
encodeShortTextIso8601Zulu :: Datetime -> ShortText
encodeShortTextIso8601Zulu !Datetime
dt =
  let !(ByteArray ByteArray#
x) = forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run forall (n :: Nat). KnownNat n => Nat n
Nat.constant
        ( Datetime -> Builder 44
boundedBuilderUtf8BytesIso8601Zoneless Datetime
dt
        forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
        Char -> Builder 1
Bounded.ascii Char
'Z'
        )
   in ShortByteString -> ShortText
TS.fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS.SBS ByteArray#
x)

encodeShortTextIso8601Zoneless :: Datetime -> ShortText
{-# noinline encodeShortTextIso8601Zoneless #-}
encodeShortTextIso8601Zoneless :: Datetime -> ShortText
encodeShortTextIso8601Zoneless !Datetime
dt =
  let !(ByteArray ByteArray#
x) = forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run forall (n :: Nat). KnownNat n => Nat n
Nat.constant
        (Datetime -> Builder 44
boundedBuilderUtf8BytesIso8601Zoneless Datetime
dt)
   in ShortByteString -> ShortText
TS.fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS.SBS ByteArray#
x)

encodeShortTextIso8601 :: OffsetDatetime -> ShortText
{-# noinline encodeShortTextIso8601 #-}
encodeShortTextIso8601 :: OffsetDatetime -> ShortText
encodeShortTextIso8601 OffsetDatetime
offdt =
  let !(ByteArray ByteArray#
x) = forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run forall (n :: Nat). KnownNat n => Nat n
Nat.constant
        (OffsetDatetime -> Builder 50
boundedBuilderUtf8BytesIso8601 OffsetDatetime
offdt)
   in ShortByteString -> ShortText
TS.fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS.SBS ByteArray#
x)

boundedBuilderUtf8BytesIso8601 :: OffsetDatetime -> Bounded.Builder 50
boundedBuilderUtf8BytesIso8601 :: OffsetDatetime -> Builder 50
boundedBuilderUtf8BytesIso8601 (OffsetDatetime Datetime
dt Offset
off) =
  ( Datetime -> Builder 44
boundedBuilderUtf8BytesIso8601Zoneless Datetime
dt
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Offset -> Builder 6
boundedBuilderOffset Offset
off
  )

-- | Encode a datetime with ISO-8601. The result does not include any
-- indication of a time zone. If the subsecond part is zero, it is suppressed.
-- Examples of output:
--
-- > 2021-01-05T23:00:51
-- > 2021-01-05T23:00:52.123000000
-- > 2021-01-05T23:00:53.674094347
boundedBuilderUtf8BytesIso8601Zoneless :: Datetime -> Bounded.Builder 44
boundedBuilderUtf8BytesIso8601Zoneless :: Datetime -> Builder 44
boundedBuilderUtf8BytesIso8601Zoneless (Datetime (Date (Year Int
y) (Month Int
mth) (DayOfMonth Int
d)) (TimeOfDay Int
h Int
mt Int64
sns)) =
    let (Int64
s,Int64
ns) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
sns Int64
1_000_000_000 in
    Word -> Builder 19
Bounded.wordDec (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Char -> Builder 1
Bounded.ascii Char
'-'
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Word -> Builder 2
Bounded.wordPaddedDec2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
mth forall a. Num a => a -> a -> a
+ Int
1))
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Char -> Builder 1
Bounded.ascii Char
'-'
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Word -> Builder 2
Bounded.wordPaddedDec2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Char -> Builder 1
Bounded.ascii Char
'T'
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Word -> Builder 2
Bounded.wordPaddedDec2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Char -> Builder 1
Bounded.ascii Char
':'
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Word -> Builder 2
Bounded.wordPaddedDec2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mt)
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Char -> Builder 1
Bounded.ascii Char
':'
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    Word -> Builder 2
Bounded.wordPaddedDec2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s)
    forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
    (case Int64
ns of
      Int64
0 -> forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
Bounded.weaken @0 @10 forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant Builder 0
Bounded.empty
      Int64
_ ->
        Char -> Builder 1
Bounded.ascii Char
'.'
        forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
        Word -> Builder 9
Bounded.wordPaddedDec9 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
ns)
    )

boundedBuilderOffset :: Offset -> Bounded.Builder 6
boundedBuilderOffset :: Offset -> Builder 6
boundedBuilderOffset (Offset Int
mins) = case Int
mins of
  Int
0 -> forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
Bounded.weaken @1 @6 forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant (Char -> Builder 1
Bounded.ascii Char
'Z')
  Int
_ ->
    let !absMins :: Word
absMins = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word (forall a. Num a => a -> a
abs Int
mins)
        !absHrs :: Word
absHrs = forall a. Integral a => a -> a -> a
quot Word
absMins Word
60
        !absMinutes :: Word
absMinutes = forall a. Integral a => a -> a -> a
rem Word
absMins Word
60
     in Char -> Builder 1
Bounded.ascii (forall a. a -> a -> Bool -> a
bool Char
'-' Char
'+' (Int
mins forall a. Ord a => a -> a -> Bool
> Int
0))
        forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
        Word -> Builder 2
Bounded.wordPaddedDec2 Word
absHrs
        forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
        Char -> Builder 1
Bounded.ascii Char
':'
        forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append`
        Word -> Builder 2
Bounded.wordPaddedDec2 Word
absMinutes