{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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
  , sinceEpoch
  , asSeconds

    -- * 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 qualified Arithmetic.Lte as Lte
import qualified Arithmetic.Nat as Nat
import Control.Applicative
import Control.DeepSeq (NFData (..), deepseq)
import Control.Exception (evaluate)
import Control.Monad
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
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 Data.Attoparsec.Text (Parser)
import qualified Data.Attoparsec.Text as AT
import qualified Data.Attoparsec.Zepto as Z
import Data.Bool (bool)
import Data.ByteString (ByteString)
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 Data.Bytes (Bytes)
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 Data.Char (isDigit)
import Data.Foldable
import Data.Hashable (Hashable)
import Data.Int (Int64)
import Data.Primitive
import qualified Data.Semigroup as SG
import Data.Text (Text)
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 Data.Text.Short (ShortText)
import qualified Data.Text.Short as TS
import qualified Data.Text.Short.Unsafe as TS
import Data.Vector (Vector)
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
import Data.Word (Word64, Word8)
import Foreign.Storable
import GHC.Clock (getMonotonicTimeNSec)
import GHC.Generics (Generic)
import Torsor

#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 (UtcTime -> Datetime) -> (Time -> UtcTime) -> Time -> Datetime
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 (UtcTime -> Time) -> (Datetime -> UtcTime) -> Datetime -> Time
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 = (Datetime -> Time) -> f Datetime -> f Time
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Datetime -> Time
datetimeToTime (f Datetime -> f Time) -> (Time -> f Datetime) -> Time -> f Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> f Datetime
f (Datetime -> f Datetime)
-> (Time -> Datetime) -> Time -> f Datetime
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 = (Time -> Datetime) -> f Time -> f Datetime
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Time -> Datetime
timeToDatetime (f Time -> f Datetime)
-> (Datetime -> f Time) -> Datetime -> f Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> f Time
f (Time -> f Time) -> (Datetime -> Time) -> Datetime -> f Time
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      y :: Int
y = Int
adjustedYear Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100
      c :: Int
c = Int
adjustedYear Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100
      adjustedYear :: Int
adjustedYear = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11 then Year -> Int
getYear Year
year Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Year -> Int
getYear Year
year
   in Int -> DayOfWeek
DayOfWeek (Int -> DayOfWeek) -> Int -> DayOfWeek
forall a b. (a -> b) -> a -> b
$ (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ ((Double
2.6 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.2) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)) Int -> Int -> Int
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 (UtcTime -> OffsetDatetime)
-> (Time -> UtcTime) -> Time -> OffsetDatetime
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 (UtcTime -> Time)
-> (OffsetDatetime -> UtcTime) -> OffsetDatetime -> Time
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 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
div Int64
i Int64
86400000000000) Int -> Int -> Int
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 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
40587) Int64 -> Int64 -> Int64
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 (OrdinalDate -> Day) -> OrdinalDate -> Day
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 = (Date -> Day) -> f Date -> f Day
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Date -> Day
dateToDay (f Date -> f Day) -> (Day -> f Date) -> Day -> f Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> f Date
f (Date -> f Date) -> (Day -> Date) -> Day -> f Date
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 = (Day -> Date) -> f Day -> f Date
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> Date
dayToDate (f Day -> f Date) -> (Date -> f Day) -> Date -> f Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> f Day
f (Day -> f Day) -> (Date -> Day) -> Date -> f Day
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 ::
  -- | Year
  Int ->
  -- | Month
  Int ->
  -- | Day
  Int ->
  -- | Hour
  Int ->
  -- | Minute
  Int ->
  -- | Second
  Int ->
  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 (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
        (Int -> Month
Month Int
mx)
        (Int -> DayOfMonth
DayOfMonth (Int -> DayOfMonth) -> Int -> DayOfMonth
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
    )
    ( Int -> Int -> Int64 -> TimeOfDay
TimeOfDay
        (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
        (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m')
        (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000000)
    )
 where
  mx :: Int
mx =
    if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
12
      then Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
m Int -> Int -> Int
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 ::
  -- | Year
  Int ->
  -- | Month
  Int ->
  -- | Day
  Int ->
  -- | Hour
  Int ->
  -- | Minute
  Int ->
  -- | Second
  Int ->
  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 = (Time -> Day) -> IO Time -> IO Day
forall a b. (a -> b) -> IO a -> IO b
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 = (Time -> Day) -> IO Time -> IO Day
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Day -> Day
forall p v. Torsor p v => v -> p -> p
add Int
1 (Day -> Day) -> (Time -> Day) -> Time -> Day
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 = (Time -> Day) -> IO Time -> IO Day
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Day -> Day
forall p v. Torsor p v => v -> p -> p
add (-Int
1) (Day -> Day) -> (Time -> Day) -> Time -> Day
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 = (Int64 -> Time) -> IO Int64 -> IO Time
forall a b. (a -> b) -> IO a -> IO b
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 (Int -> DayOfWeek) -> Int -> DayOfWeek
forall a b. (a -> b) -> a -> b
$
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Int ((Int64
time Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
86400000000000) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
4) Int -> Int -> Int
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 (Time -> DayOfWeek) -> IO Time -> IO DayOfWeek
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 (Time -> DayOfWeek) -> (Time -> Time) -> Time -> DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Timespan -> Time -> Time
forall p v. Torsor p v => v -> p -> p
add (Int64 -> Timespan
Timespan (-Int64
86400000000000))) (Time -> DayOfWeek) -> IO Time -> IO DayOfWeek
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 (Time -> DayOfWeek) -> (Time -> Time) -> Time -> DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Timespan -> Time -> Time
forall p v. Torsor p v => v -> p -> p
add (Int64 -> Timespan
Timespan (Int64
86400000000000))) (Time -> DayOfWeek) -> IO Time -> IO DayOfWeek
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 IO a -> (a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
evaluate
  Word64
end <- IO Word64
getMonotonicTimeNSec
  (Timespan, a) -> IO (Timespan, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int64 -> Timespan
Timespan (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
end Word64 -> Word64 -> Word64
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
  Timespan -> IO Timespan
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Timespan
Timespan (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
end Word64 -> Word64 -> Word64
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) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
divMod Int64
i (Timespan -> Int64
getTimespan Timespan
day)
   in Day -> Int64 -> UtcTime
UtcTime (Int -> Day -> Day
forall p v. Torsor p v => v -> p -> p
add (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
d) Day
epochDay) (Int64 -> Int64
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 (Int64 -> Time) -> Int64 -> Time
forall a b. (a -> b) -> a -> b
$
    Timespan -> Int64
getTimespan (Timespan -> Int64) -> Timespan -> Int64
forall a b. (a -> b) -> a -> b
$
      Timespan -> Timespan -> Timespan
forall v. Additive v => v -> v -> v
plus
        (Int64 -> Timespan -> Timespan
forall v s. Scaling v s => s -> v -> v
scale (Int -> Int64
intToInt64 (Day -> Day -> Int
forall p v. Torsor p v => p -> p -> v
difference Day
d Day
epochDay)) Timespan
day)
        (if Timespan
ns Timespan -> Timespan -> Bool
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 = Int -> Int64
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 =
  [Offset] -> Vector Offset
forall a. [a] -> Vector a
Vector.fromList ([Offset] -> Vector Offset) -> [Offset] -> Vector Offset
forall a b. (a -> b) -> a -> b
$
    (Int -> Offset) -> [Int] -> [Offset]
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
      ]

{- | Compute the 'Timespan' between the given date and 'epoch'.

@since 1.1.6.0
-}
sinceEpoch :: Time -> Timespan
sinceEpoch :: Time -> Timespan
sinceEpoch Time
t = Time -> Time -> Timespan
forall p v. Torsor p v => p -> p -> v
difference Time
t Time
epoch

{- | Convert a 'Timespan' to its equivalent in seconds.

@since 1.1.6.0
-}
asSeconds :: Timespan -> Int64
asSeconds :: Timespan -> Int64
asSeconds (Timespan Int64
t) = case Timespan
second of
  Timespan Int64
s -> Int64
t Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
s

{- | 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'') = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
h' Int
24
  (!Int
hourAdjustment, !Int
m'') = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
m' Int
60
  m' :: Int
m' = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset
  h' :: Int
h' = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hourAdjustment

nanosecondsSinceMidnightToTimeOfDay :: Int64 -> TimeOfDay
nanosecondsSinceMidnightToTimeOfDay :: Int64 -> TimeOfDay
nanosecondsSinceMidnightToTimeOfDay Int64
ns =
  if Int64
ns Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
dayLengthInt64
    then Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
23 Int
59 (Int64
nanosecondsInMinute Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int64
ns Int64 -> Int64 -> Int64
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') = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
ns Int64
nanosecondsInMinute
  !m :: Int
m = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
mInt64
  (!Int
h', !Int
m') = Int -> Int -> (Int, Int)
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) =
  Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
3600000000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
60000000000 Int64 -> Int64 -> Int64
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 Int -> Int -> Int
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 (Int -> Offset) -> Int -> Offset
forall a b. (a -> b) -> a -> b
$ Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dayAdjustment))
        (TimeOfDay -> Int64
timeOfDayToNanosecondsSinceMidnight TimeOfDay
tod)

-- | Convert a 'MonthDate' to a 'DayOfYear'.
monthDateToDayOfYear ::
  -- | Is it a leap year?
  Bool ->
  MonthDate ->
  DayOfYear
monthDateToDayOfYear :: Bool -> MonthDate -> DayOfYear
monthDateToDayOfYear Bool
isLeap (MonthDate month :: Month
month@(Month Int
m) (DayOfMonth Int
dayOfMonth)) =
  Int -> DayOfYear
DayOfYear ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
367 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
362) Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
day')
 where
  day' :: Int
day' = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int
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 Month -> Month -> Bool
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' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  mjd :: Int
mjd =
    ( Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (DayOfYear -> Int) -> DayOfYear -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfYear -> Int
getDayOfYear (DayOfYear -> Int) -> DayOfYear -> Int
forall a b. (a -> b) -> a -> b
$
        (DayOfYear -> DayOfYear -> DayOfYear -> DayOfYear
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)
    )
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
365 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
y Int
4)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
y Int
100)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
y Int
400)
      Int -> Int -> Int
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) = (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
year Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
&& ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
year Int
400 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| Bool -> Bool
not (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
year Int
100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0))

-- | Convert a 'DayOfYear' to a 'MonthDate'.
dayOfYearToMonthDay ::
  -- | Is it a leap year?
  Bool ->
  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 = DayOfYear -> DayOfYear -> DayOfYear -> DayOfYear
forall t. Ord t => t -> t -> t -> t
clip (Int -> DayOfYear
DayOfYear Int
1) DayOfYear
doyUpperBound DayOfYear
dayOfYear
      clippedDayInt :: Int
clippedDayInt = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
clippedDay :: Int
      month :: Month
month = Vector Month -> Int -> Month
forall a. Unbox a => Vector a -> Int -> a
UVector.unsafeIndex Vector Month
monthTable Int
clippedDayInt
      theDay :: DayOfMonth
theDay = Vector DayOfMonth -> Int -> DayOfMonth
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 (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
year) (Int -> DayOfYear
DayOfYear (Int -> DayOfYear) -> Int -> DayOfYear
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
yd)
 where
  a :: Int64
a = (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mjd :: Int64) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
678575
  quadcent :: Int64
quadcent = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
div Int64
a Int64
146097
  b :: Int64
b = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
mod Int64
a Int64
146097
  cent :: Int64
cent = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
div Int64
b Int64
36524) Int64
3
  c :: Int64
c = Int64
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- (Int64
cent Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
36524)
  quad :: Int64
quad = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
div Int64
c Int64
1461
  d :: Int64
d = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
mod Int64
c Int64
1461
  y :: Int64
y = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
div Int64
d Int64
365) Int64
3
  yd :: Int64
yd = (Int64
d Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- (Int64
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
365) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)
  year :: Int64
year = Int64
quadcent Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
400 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
cent Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
100 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
quad Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
y Int64 -> Int64 -> Int64
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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-') (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'T') (Char -> Maybe Char
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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'/') (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' ') (Char -> Maybe 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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-') (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' ') (Char -> Maybe 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 Maybe Char
forall a. Maybe a
Nothing (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'T') Maybe Char
forall a. Maybe a
Nothing

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

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

normalYearDayOfYearMonthTable :: UVector.Vector Month
normalYearDayOfYearMonthTable :: Vector Month
normalYearDayOfYearMonthTable =
  [Month] -> Vector Month
forall a. Unbox a => [a] -> Vector a
UVector.fromList ([Month] -> Vector Month) -> [Month] -> Vector Month
forall a b. (a -> b) -> a -> b
$
    (Int -> Month
Month Int
0 Month -> [Month] -> [Month]
forall a. a -> [a] -> [a]
:) ([Month] -> [Month]) -> [Month] -> [Month]
forall a b. (a -> b) -> a -> b
$
      [[Month]] -> [Month]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
0)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
28 (Int -> Month
Month Int
1)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
2)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
3)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
4)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
5)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
6)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
7)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
8)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
31 (Int -> Month
Month Int
9)
        , Int -> Month -> [Month]
forall a. Int -> a -> [a]
replicate Int
30 (Int -> Month
Month Int
10)
        , Int -> Month -> [Month]
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 =
  Vector a -> MonthMatch a
forall a. Vector a -> MonthMatch a
MonthMatch (Int -> [a] -> Vector a
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) = Vector a -> Int -> a
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 =
  Vector a -> UnboxedMonthMatch a
forall a. Vector a -> UnboxedMonthMatch a
UnboxedMonthMatch (Int -> [a] -> Vector a
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) = Vector a -> Int -> a
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 =
  Vector a -> DayOfWeekMatch a
forall a. Vector a -> DayOfWeekMatch a
DayOfWeekMatch (Int -> [a] -> Vector a
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) = Vector a -> Int -> a
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
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigit Month
m
      Builder -> Builder -> Builder
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
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigit Month
m
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          Builder -> Builder -> Builder
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.toStrict (Text -> Text) -> (Date -> Text) -> Date -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Date -> Builder) -> Date -> Text
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
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigit Month
m
      Builder -> Builder -> Builder
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
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigit Month
m
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          Builder -> Builder -> Builder
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.toStrict (Text -> Text) -> (Date -> Text) -> Date -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Date -> Builder) -> Date -> Text
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
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  Date -> Parser Date
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
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 <- Parser Text () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text ()
parserLenientSeparator
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  Maybe ()
sep2 <- Parser Text () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text ()
parserLenientSeparator
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31) (String -> Parser Text ()
forall a. String -> Parser Text a
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 ()
_) -> String -> Parser Date
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Just ()
_, Maybe ()
Nothing) -> String -> Parser Date
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Maybe (), Maybe ())
_ -> Date -> Parser Date
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
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
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  Date -> Parser Date
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
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
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  Maybe ()
sep1 <- Parser Text () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text ()
parserLenientSeparator
  Int
d <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  Maybe ()
sep2 <- Parser Text () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text ()
parserLenientSeparator
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  case (Maybe ()
sep1, Maybe ()
sep2) of
    (Maybe ()
Nothing, Just ()
_) -> String -> Parser Date
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Just ()
_, Maybe ()
Nothing) -> String -> Parser Date
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Maybe (), Maybe ())
_ -> Date -> Parser Date
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
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
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  Date -> Parser Date
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
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
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  Maybe ()
sep1 <- Parser Text () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text ()
parserLenientSeparator
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  Maybe ()
sep2 <- Parser Text () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text ()
parserLenientSeparator
  Int
y <- Int -> Parser Int
parseFixedDigits Int
4
  case (Maybe ()
sep1, Maybe ()
sep2) of
    (Maybe ()
Nothing, Just ()
_) -> String -> Parser Date
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Just ()
_, Maybe ()
Nothing) -> String -> Parser Date
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Separators must all exist or not"
    (Maybe (), Maybe ())
_ -> Date -> Parser Date
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
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
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigitBS Month
m
      Builder -> Builder -> Builder
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
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Month -> Builder
monthToZeroPaddedDigitBS Month
m
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          Builder -> Builder -> Builder
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
  (Char -> Parser ByteString Char)
-> Maybe Char -> Parser ByteString ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser ByteString Char
AB.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12) (String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  (Char -> Parser ByteString Char)
-> Maybe Char -> Parser ByteString ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser ByteString Char
AB.char Maybe Char
msep
  Int
d <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31) (String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  Date -> Parser Date
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
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
    Builder -> Builder -> Builder
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilder_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
    Builder -> Builder -> 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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilder_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns
    Builder -> Builder -> Builder
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 (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$
    if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12
      then Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12
      else
        if Int
h Int -> Int -> Bool
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 Int -> Int -> Bool
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
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
23) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
  TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)

parserLenientSeparator :: Parser ()
parserLenientSeparator :: Parser Text ()
parserLenientSeparator = (Char -> Bool) -> Parser Text Char
AT.satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) Parser Text Char -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser Text ()
forall a. a -> Parser Text a
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
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
23) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  Parser Text ()
parserLenientSeparator
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  Parser Text ()
parserLenientSeparator
  Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
  TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
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
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
23) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59) (String -> Parser Text ()
forall a. String -> Parser Text a
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 -> TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep
          then do
            Char
_ <- Parser Text Char
AT.anyChar -- should be the separator
            Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
            TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
          else TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
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
            TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
          else TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
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
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
23) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  Parser Text ()
parserLenientSeparator
  Int
m <- Int -> Parser Int
parseFixedDigits Int
2
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59) (String -> Parser Text ()
forall a. String -> Parser Text a
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 -> TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
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 Text Char
AT.anyChar -- should be the separator
      Int64
ns <- Parser Int64
parseSecondsAndNanoseconds
      TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
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
      TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
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 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s' :: Int64
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
60) (String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"seconds must be between 0 and 60")
  Int64
nanoseconds <-
    ( do
        Char
_ <- Char -> Parser Text Char
AT.char Char
'.'
        Int
numberOfZeroes <- Parser Int
countZeroes
        Parser (Maybe Char)
AT.peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Int64) -> Parser Int64
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' -> do
            Int64
x <- Parser Int64
forall a. Integral a => Parser a
AT.decimal
            let totalDigits :: Int
totalDigits = Int64 -> Int
forall a. Integral a => a -> Int
countDigits Int64
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numberOfZeroes
                result :: Int64
result =
                  if Int
totalDigits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9
                    then Int64
x
                    else
                      if Int
totalDigits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9
                        then Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
raiseTenTo (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
totalDigits)
                        else Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
quot Int64
x (Int -> Int64
raiseTenTo (Int
totalDigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9))
            Int64 -> Parser Int64
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
result)
          Maybe Char
_ -> Int64 -> Parser Int64
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
      )
      Parser Int64 -> Parser Int64 -> Parser Int64
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int64 -> Parser Int64
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
  Int64 -> Parser Int64
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
nanoseconds)

countZeroes :: AT.Parser Int
countZeroes :: Parser Int
countZeroes = Int -> Parser Int
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 -> t -> Parser Text t
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
i
      Just Char
c ->
        if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0'
          then Parser Text Char
AT.anyChar Parser Text Char -> Parser Text t -> Parser Text t
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> t -> Parser Text t
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
          else t -> Parser Text t
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
i

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

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

millisecondsBuilder :: Int64 -> TB.Builder
millisecondsBuilder :: Int64 -> Builder
millisecondsBuilder Int64
w
  | Int64
w Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = Builder
forall a. Monoid a => a
mempty
  | Int64
w Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
99 = Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Int64
w Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
9 = Builder
".0" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
forall a. Integral a => a -> Builder
TB.decimal Int64
w
  | Bool
otherwise = Builder
".00" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
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 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 -> Int64 -> Builder
millisecondsBuilder Int64
milli
    | Int64
microRem Int64 -> Int64 -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Builder
forall a. Monoid a => a
mempty
      else
        let newSubsecondPart :: Int64
newSubsecondPart = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
quot Int64
nano (Int -> Int64
raiseTenTo (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d))
         in Builder
"."
              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText (Int -> Text -> Text
Text.replicate (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a. Integral a => a -> Int
countDigits Int64
newSubsecondPart) Text
"0")
              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
forall a. Integral a => a -> Builder
TB.decimal Int64
newSubsecondPart
 where
  (Int64
milli, Int64
milliRem) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
nano Int64
1000000
  (Int64
micro, Int64
microRem) = Int64 -> Int64 -> (Int64, Int64)
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 (Text -> Text) -> (Timespan -> Text) -> Timespan -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Timespan -> Builder) -> Timespan -> Text
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) =
  Int64 -> Builder
forall a. Integral a => a -> Builder
TB.decimal Int64
sInt64 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilder SubsecondPrecision
sp Int64
nsRemainder
 where
  (!Int64
sInt64, !Int64
nsRemainder) = Int64 -> Int64 -> (Int64, Int64)
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
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
s
      Builder -> Builder -> Builder
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
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
m
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
s
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilder SubsecondPrecision
sp Int64
nsRemainder
 where
  (!Int64
sInt64, !Int64
nsRemainder) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
ns Int64
1000000000
  !s :: Int
s = Int64 -> Int
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
        Builder -> Builder -> Builder
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
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
sep
        Builder -> Builder -> Builder
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Char -> Builder) -> Maybe Char -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty Char -> Builder
TB.singleton Maybe Char
msep
    Builder -> Builder -> Builder
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Char -> Builder) -> Maybe Char -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty Char -> Builder
TB.singleton Maybe Char
msep
    Builder -> Builder -> Builder
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 (Text -> Text) -> (Datetime -> Text) -> Datetime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Datetime -> Builder) -> Datetime -> Text
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 (Text -> Text) -> (Datetime -> Text) -> Datetime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Datetime -> Builder) -> Datetime -> Text
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 (Text -> Text) -> (Datetime -> Text) -> Datetime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Datetime -> Builder) -> Datetime -> Text
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 (Text -> Text) -> (Datetime -> Text) -> Datetime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Datetime -> Builder) -> Datetime -> Text
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
        Builder -> Builder -> Builder
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
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
sep
        Builder -> Builder -> Builder
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Char -> Builder) -> Maybe Char -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty Char -> Builder
TB.singleton Maybe Char
msep
    Builder -> Builder -> Builder
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Char -> Builder) -> Maybe Char -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty Char -> Builder
TB.singleton Maybe Char
msep
    Builder -> Builder -> Builder
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 (Text -> Text) -> (Datetime -> Text) -> Datetime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Datetime -> Builder) -> Datetime -> Text
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> Parser Text a
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
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> Parser Text a
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 <- Parser Date -> Parser Text (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Date -> Parser Text (Maybe Date))
-> Parser Date -> Parser Text (Maybe Date)
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Dmy Maybe Char
forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date (TimeOfDay -> Datetime) -> Parser TimeOfDay -> Parser Datetime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime (Date -> TimeOfDay -> Datetime)
-> Parser Date -> Parser Text (TimeOfDay -> Datetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Dmy_lenient Parser Text (TimeOfDay -> Datetime)
-> Parser Text () -> Parser Text (TimeOfDay -> Datetime)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
parserLenientSeparator Parser Text (TimeOfDay -> Datetime)
-> Parser TimeOfDay -> Parser Datetime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
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 <- Parser Date -> Parser Text (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Date -> Parser Text (Maybe Date))
-> Parser Date -> Parser Text (Maybe Date)
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Dmy Maybe Char
forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date (TimeOfDay -> Datetime) -> Parser TimeOfDay -> Parser Datetime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime (Date -> TimeOfDay -> Datetime)
-> Parser Date -> Parser Text (TimeOfDay -> Datetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Dmy_lenient Parser Text (TimeOfDay -> Datetime)
-> Parser Text () -> Parser Text (TimeOfDay -> Datetime)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
parserLenientSeparator Parser Text (TimeOfDay -> Datetime)
-> Parser TimeOfDay -> Parser Datetime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
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 = (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> Parser Text a
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 <- Parser Date -> Parser Text (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Date -> Parser Text (Maybe Date))
-> Parser Date -> Parser Text (Maybe Date)
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Mdy Maybe Char
forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date (TimeOfDay -> Datetime) -> Parser TimeOfDay -> Parser Datetime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime (Date -> TimeOfDay -> Datetime)
-> Parser Date -> Parser Text (TimeOfDay -> Datetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Mdy_lenient Parser Text (TimeOfDay -> Datetime)
-> Parser Text () -> Parser Text (TimeOfDay -> Datetime)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
parserLenientSeparator Parser Text (TimeOfDay -> Datetime)
-> Parser TimeOfDay -> Parser Datetime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
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
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> Parser Text a
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 <- Parser Date -> Parser Text (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Date -> Parser Text (Maybe Date))
-> Parser Date -> Parser Text (Maybe Date)
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Mdy Maybe Char
forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date (TimeOfDay -> Datetime) -> Parser TimeOfDay -> Parser Datetime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime (Date -> TimeOfDay -> Datetime)
-> Parser Date -> Parser Text (TimeOfDay -> Datetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Mdy_lenient Parser Text (TimeOfDay -> Datetime)
-> Parser Text () -> Parser Text (TimeOfDay -> Datetime)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
parserLenientSeparator Parser Text (TimeOfDay -> Datetime)
-> Parser TimeOfDay -> Parser Datetime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> Parser Text a
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 <- Parser Date -> Parser Text (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Date -> Parser Text (Maybe Date))
-> Parser Date -> Parser Text (Maybe Date)
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Ymd Maybe Char
forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date (TimeOfDay -> Datetime) -> Parser TimeOfDay -> Parser Datetime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS Maybe Char
forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime (Date -> TimeOfDay -> Datetime)
-> Parser Date -> Parser Text (TimeOfDay -> Datetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Ymd_lenient Parser Text (TimeOfDay -> Datetime)
-> Parser Text () -> Parser Text (TimeOfDay -> Datetime)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
parserLenientSeparator Parser Text (TimeOfDay -> Datetime)
-> Parser TimeOfDay -> Parser Datetime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
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
  (Char -> Parser Text Char) -> Maybe Char -> Parser Text ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser Text Char
AT.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> Parser Text a
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 <- Parser Date -> Parser Text (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Date -> Parser Text (Maybe Date))
-> Parser Date -> Parser Text (Maybe Date)
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Parser Date
parser_Ymd Maybe Char
forall a. Maybe a
Nothing
  case Maybe Date
mdate of
    Just Date
date -> Date -> TimeOfDay -> Datetime
Datetime Date
date (TimeOfDay -> Datetime) -> Parser TimeOfDay -> Parser Datetime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char -> Parser TimeOfDay
parser_HMS_opt_S Maybe Char
forall a. Maybe a
Nothing
    Maybe Date
Nothing -> Date -> TimeOfDay -> Datetime
Datetime (Date -> TimeOfDay -> Datetime)
-> Parser Date -> Parser Text (TimeOfDay -> Datetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Date
parser_Ymd_lenient Parser Text (TimeOfDay -> Datetime)
-> Parser Text () -> Parser Text (TimeOfDay -> Datetime)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
parserLenientSeparator Parser Text (TimeOfDay -> Datetime)
-> Parser TimeOfDay -> Parser Datetime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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 Parser Datetime -> Parser Datetime -> Parser Datetime
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Datetime
parser_DmyHMS_opt_S_lenient Parser Datetime -> Parser Datetime -> Parser Datetime
forall a. Parser Text a -> Parser Text a -> Parser Text a
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (Text -> Either String Datetime) -> Text -> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
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
    Builder -> Builder -> Builder
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilderUtf8_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
    Builder -> Builder -> 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 (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$
    if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12
      then Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12
      else
        if Int
h Int -> Int -> Bool
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 Int -> Int -> Bool
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder
internalBuilderUtf8_NS SubsecondPrecision
sp Maybe Char
msep Int
m Int64
ns
    Builder -> Builder -> Builder
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
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
23) (String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  (Char -> Parser ByteString Char)
-> Maybe Char -> Parser ByteString ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser ByteString Char
AB.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59) (String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  (Char -> Parser ByteString Char)
-> Maybe Char -> Parser ByteString ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser ByteString Char
AB.char Maybe Char
msep
  Int64
ns <- Parser Int64
parseSecondsAndNanosecondsUtf8
  TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser ByteString a
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
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
23) (String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hour must be between 0 and 23")
  (Char -> Parser ByteString Char)
-> Maybe Char -> Parser ByteString ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser ByteString Char
AB.char Maybe Char
msep
  Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59) (String -> Parser ByteString ()
forall a. String -> Parser ByteString a
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 -> TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser ByteString a
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep
          then do
            Char
_ <- Parser ByteString Char
AB.anyChar -- should be the separator
            Int64
ns <- Parser Int64
parseSecondsAndNanosecondsUtf8
            TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
          else TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser ByteString a
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
            TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int64 -> TimeOfDay
TimeOfDay Int
h Int
m Int64
ns)
          else TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser ByteString a
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 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s' :: Int64
  -- TODO: whoops, this should probably be gt 59, not 60
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
60) (String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"seconds must be between 0 and 60")
  Int64
nanoseconds <-
    ( do
        Char
_ <- Char -> Parser ByteString Char
AB.char Char
'.'
        Int
numberOfZeroes <- Parser Int
countZeroesUtf8
        Parser (Maybe Char)
AB.peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Int64) -> Parser Int64
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' -> do
            Int64
x <- Parser Int64
forall a. Integral a => Parser a
AB.decimal
            let totalDigits :: Int
totalDigits = Int64 -> Int
forall a. Integral a => a -> Int
countDigits Int64
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numberOfZeroes
                result :: Int64
result =
                  if Int
totalDigits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9
                    then Int64
x
                    else
                      if Int
totalDigits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9
                        then Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
raiseTenTo (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
totalDigits)
                        else Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
quot Int64
x (Int -> Int64
raiseTenTo (Int
totalDigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9))
            Int64 -> Parser Int64
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
result)
          Maybe Char
_ -> Int64 -> Parser Int64
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
      )
      Parser Int64 -> Parser Int64 -> Parser Int64
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int64 -> Parser Int64
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
  Int64 -> Parser Int64
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
nanoseconds)

countZeroesUtf8 :: AB.Parser Int
countZeroesUtf8 :: Parser Int
countZeroesUtf8 = Int -> Parser Int
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 -> t -> Parser ByteString t
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
i
      Just Char
c ->
        if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0'
          then Parser ByteString Char
AB.anyChar Parser ByteString Char
-> Parser ByteString t -> Parser ByteString t
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> t -> Parser ByteString t
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
          else t -> Parser ByteString t
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
i

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

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

millisecondsBuilderUtf8 :: Int64 -> BB.Builder
millisecondsBuilderUtf8 :: Int64 -> Builder
millisecondsBuilderUtf8 Int64
w
  | Int64
w Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = Builder
forall a. Monoid a => a
mempty
  | Int64
w Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
99 = Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Int64
w Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
9 = Builder
".0" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
w
  | Bool
otherwise = Builder
".00" Builder -> Builder -> Builder
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 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 -> Int64 -> Builder
millisecondsBuilderUtf8 Int64
milli
    | Int64
microRem Int64 -> Int64 -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Builder
forall a. Monoid a => a
mempty
      else
        let newSubsecondPart :: Int64
newSubsecondPart = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
quot Int64
nano (Int -> Int64
raiseTenTo (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d))
         in Char -> Builder
BB.char7 Char
'.'
              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString (Int -> Char -> ByteString
BC.replicate (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a. Integral a => a -> Int
countDigits Int64
newSubsecondPart) Char
'0')
              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Builder Int64
newSubsecondPart
 where
  (Int64
milli, Int64
milliRem) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
nano Int64
1000000
  (Int64
micro, Int64
microRem) = Int64 -> Int64 -> (Int64, Int64)
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 (ByteString -> ByteString)
-> (Timespan -> ByteString) -> Timespan -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Timespan -> Builder) -> Timespan -> ByteString
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilderUtf8 SubsecondPrecision
sp Int64
nsRemainder
 where
  (!Int64
sInt64, !Int64
nsRemainder) = Int64 -> Int64 -> (Int64, Int64)
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 (Integer -> Builder) -> (Int64 -> Integer) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
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
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
s
      Builder -> Builder -> Builder
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
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
m
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sepBuilder
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
s
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SubsecondPrecision -> Int64 -> Builder
prettyNanosecondsBuilderUtf8 SubsecondPrecision
sp Int64
nsRemainder
 where
  (!Int64
sInt64, !Int64
nsRemainder) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
ns Int64
1000000000
  !s :: Int
s = Int64 -> Int
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 (ByteString -> ByteString)
-> (Datetime -> ByteString) -> Datetime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Datetime -> Builder) -> Datetime -> ByteString
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 (ByteString -> ByteString)
-> (Datetime -> ByteString) -> Datetime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Datetime -> Builder) -> Datetime -> ByteString
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
        Builder -> Builder -> Builder
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
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
sep
        Builder -> Builder -> Builder
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Char -> Builder) -> Maybe Char -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty Char -> Builder
BB.char7 Maybe Char
msep
    Builder -> Builder -> Builder
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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Char -> Builder) -> Maybe Char -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty Char -> Builder
BB.char7 Maybe Char
msep
    Builder -> Builder -> Builder
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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-') (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'T') (Char -> Maybe Char
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (ByteString -> Either String Datetime)
-> ByteString
-> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> ByteString -> Either String Datetime
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
  (Char -> Parser ByteString Char)
-> Maybe Char -> Parser ByteString ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser ByteString Char
AB.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parserUtf8_HMS Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> Parser ByteString a
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
  (Char -> Parser ByteString Char)
-> Maybe Char -> Parser ByteString ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Char -> Parser ByteString Char
AB.char Maybe Char
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
parserUtf8_HMS_opt_S Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> Parser ByteString a
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 =
  (String -> Maybe Datetime)
-> (Datetime -> Maybe Datetime)
-> Either String Datetime
-> Maybe Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Datetime -> String -> Maybe Datetime
forall a b. a -> b -> a
const Maybe Datetime
forall a. Maybe a
Nothing) Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just (Either String Datetime -> Maybe Datetime)
-> (ByteString -> Either String Datetime)
-> ByteString
-> Maybe Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> ByteString -> Either String Datetime
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
    Builder -> Builder -> Builder
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
    (Datetime -> Offset -> OffsetDatetime)
-> Parser Datetime -> Parser Text (Offset -> OffsetDatetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatetimeFormat -> Parser Datetime
parser_YmdHMS DatetimeFormat
datetimeFormat
    Parser Text (Offset -> OffsetDatetime)
-> Parser Text Offset -> Parser OffsetDatetime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OffsetFormat -> Parser Text 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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
    Builder -> Builder -> 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 (Text -> Text)
-> (OffsetDatetime -> Text) -> OffsetDatetime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text)
-> (OffsetDatetime -> Builder) -> OffsetDatetime -> Text
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
    Builder -> Builder -> Builder
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
    (Datetime -> Offset -> OffsetDatetime)
-> Parser Datetime -> Parser Text (Offset -> OffsetDatetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatetimeFormat -> Parser Datetime
parser_DmyHMS DatetimeFormat
datetimeFormat
    Parser Text (Offset -> OffsetDatetime)
-> Parser Text Offset -> Parser OffsetDatetime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OffsetFormat -> Parser Text 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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
    Builder -> Builder -> 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 (Text -> Text)
-> (OffsetDatetime -> Text) -> OffsetDatetime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text)
-> (OffsetDatetime -> Builder) -> OffsetDatetime -> Text
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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-') (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'T') (Char -> Maybe Char
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 (Text -> Text) -> (Offset -> Text) -> Offset -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (Offset -> Builder) -> Offset -> Text
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 =
  (String -> Maybe Offset)
-> (Offset -> Maybe Offset) -> Either String Offset -> Maybe Offset
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Offset -> String -> Maybe Offset
forall a b. a -> b -> a
const Maybe Offset
forall a. Maybe a
Nothing) Offset -> Maybe Offset
forall a. a -> Maybe a
Just (Either String Offset -> Maybe Offset)
-> (Text -> Either String Offset) -> Text -> Maybe Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text Offset -> Text -> Either String Offset
forall a. Parser a -> Text -> Either String a
AT.parseOnly (OffsetFormat -> Parser Text Offset
parserOffset OffsetFormat
fmt Parser Text Offset -> Parser Text () -> Parser Text Offset
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
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 Text Offset
parserOffset OffsetFormat
x = case OffsetFormat
x of
  OffsetFormat
OffsetFormatColonOff -> Parser Text Offset
parserOffset_z
  OffsetFormat
OffsetFormatColonOn -> Parser Text Offset
parserOffset_z1
  OffsetFormat
OffsetFormatSecondsPrecision -> Parser Text Offset
parserOffset_z2
  OffsetFormat
OffsetFormatColonAuto -> Parser Text Offset
parserOffset_z3

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

parserOffset_z :: Parser Offset
parserOffset_z :: Parser Text 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
  Offset -> Parser Text Offset
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset -> Parser Text Offset)
-> (Int -> Offset) -> Int -> Parser Text Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset (Int -> Parser Text Offset) -> Int -> Parser Text Offset
forall a b. (a -> b) -> a -> b
$
    if Bool
pos
      then Int
res
      else Int -> Int
forall a. Num a => a -> a
negate Int
res

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

parserOffset_z2 :: AT.Parser Offset
parserOffset_z2 :: Parser Text Offset
parserOffset_z2 = do
  Bool
pos <- Parser Bool
parseSignedness
  Int
h <- Int -> Parser Int
parseFixedDigits Int
2
  Char
_ <- Char -> Parser Text 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
  Offset -> Parser Text Offset
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset -> Parser Text Offset)
-> (Int -> Offset) -> Int -> Parser Text Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset (Int -> Parser Text Offset) -> Int -> Parser Text Offset
forall a b. (a -> b) -> a -> b
$
    if Bool
pos
      then Int
res
      else Int -> Int
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 Text 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 Text Char
AT.anyChar -- should be a colon
      Int
m <- Int -> Parser Int
parseFixedDigits Int
2
      let !res :: Int
res = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
      Offset -> Parser Text Offset
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset -> Parser Text Offset)
-> (Int -> Offset) -> Int -> Parser Text Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset (Int -> Parser Text Offset) -> Int -> Parser Text Offset
forall a b. (a -> b) -> a -> b
$
        if Bool
pos
          then Int
res
          else Int -> Int
forall a. Num a => a -> a
negate Int
res
    Maybe Char
_ ->
      Offset -> Parser Text Offset
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset -> Parser Text Offset)
-> (Int -> Offset) -> Int -> Parser Text Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset (Int -> Parser Text Offset) -> Int -> Parser Text Offset
forall a b. (a -> b) -> a -> b
$
        if Bool
pos
          then Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60
          else Int
h Int -> Int -> Int
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) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int
forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if Int -> Int
forall a. Num a => a -> a
signum Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
        Builder -> Builder -> Builder
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) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int
forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if Int -> Int
forall a. Num a => a -> a
signum Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
        Builder -> Builder -> 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) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int
forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if Int -> Int
forall a. Num a => a -> a
signum Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
b
        Builder -> Builder -> Builder
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) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int
forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if Int -> Int
forall a. Num a => a -> a
signum Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in if Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then
          Builder
prefix
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
        else
          Builder
prefix
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitTextBuilder Int
a
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
            Builder -> Builder -> 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
    Builder -> Builder -> Builder
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
    (Datetime -> Offset -> OffsetDatetime)
-> Parser Datetime -> Parser ByteString (Offset -> OffsetDatetime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatetimeFormat -> Parser Datetime
parserUtf8_YmdHMS DatetimeFormat
datetimeFormat
    Parser ByteString (Offset -> OffsetDatetime)
-> Parser ByteString Offset -> Parser OffsetDatetime
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OffsetFormat -> Parser ByteString 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
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
    Builder -> Builder -> 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 (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-') (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'T') (Char -> Maybe Char
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 (ByteString -> ByteString)
-> (Offset -> ByteString) -> Offset -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Offset -> Builder) -> Offset -> ByteString
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 =
  (String -> Maybe Offset)
-> (Offset -> Maybe Offset) -> Either String Offset -> Maybe Offset
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Offset -> String -> Maybe Offset
forall a b. a -> b -> a
const Maybe Offset
forall a. Maybe a
Nothing) Offset -> Maybe Offset
forall a. a -> Maybe a
Just (Either String Offset -> Maybe Offset)
-> (ByteString -> Either String Offset)
-> ByteString
-> Maybe Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ByteString Offset -> ByteString -> Either String Offset
forall a. Parser a -> ByteString -> Either String a
AB.parseOnly (OffsetFormat -> Parser ByteString 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 ByteString Offset
parserOffsetUtf8 OffsetFormat
x = case OffsetFormat
x of
  OffsetFormat
OffsetFormatColonOff -> Parser ByteString Offset
parserOffsetUtf8_z
  OffsetFormat
OffsetFormatColonOn -> Parser ByteString Offset
parserOffsetUtf8_z1
  OffsetFormat
OffsetFormatSecondsPrecision -> Parser ByteString Offset
parserOffsetUtf8_z2
  OffsetFormat
OffsetFormatColonAuto -> Parser ByteString Offset
parserOffsetUtf8_z3

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

parserOffsetUtf8_z :: AB.Parser Offset
parserOffsetUtf8_z :: Parser ByteString 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
  Offset -> Parser ByteString Offset
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset -> Parser ByteString Offset)
-> (Int -> Offset) -> Int -> Parser ByteString Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset (Int -> Parser ByteString Offset)
-> Int -> Parser ByteString Offset
forall a b. (a -> b) -> a -> b
$
    if Bool
pos
      then Int
res
      else Int -> Int
forall a. Num a => a -> a
negate Int
res

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

parserOffsetUtf8_z2 :: AB.Parser Offset
parserOffsetUtf8_z2 :: Parser ByteString Offset
parserOffsetUtf8_z2 = do
  Bool
pos <- Parser Bool
parseSignednessUtf8
  Int
h <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
  Char
_ <- Char -> Parser ByteString 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
  Offset -> Parser ByteString Offset
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset -> Parser ByteString Offset)
-> (Int -> Offset) -> Int -> Parser ByteString Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset (Int -> Parser ByteString Offset)
-> Int -> Parser ByteString Offset
forall a b. (a -> b) -> a -> b
$
    if Bool
pos
      then Int
res
      else Int -> Int
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 ByteString 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 ByteString Char
AB.anyChar -- should be a colon
      Int
m <- Int -> Parser Int
parseFixedDigitsIntBS Int
2
      let !res :: Int
res = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
      Offset -> Parser ByteString Offset
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset -> Parser ByteString Offset)
-> (Int -> Offset) -> Int -> Parser ByteString Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset (Int -> Parser ByteString Offset)
-> Int -> Parser ByteString Offset
forall a b. (a -> b) -> a -> b
$
        if Bool
pos
          then Int
res
          else Int -> Int
forall a. Num a => a -> a
negate Int
res
    Maybe Char
_ ->
      Offset -> Parser ByteString Offset
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset -> Parser ByteString Offset)
-> (Int -> Offset) -> Int -> Parser ByteString Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Offset
Offset (Int -> Parser ByteString Offset)
-> Int -> Parser ByteString Offset
forall a b. (a -> b) -> a -> b
$
        if Bool
pos
          then Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60
          else Int
h Int -> Int -> Int
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) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int
forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if Int -> Int
forall a. Num a => a -> a
signum Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
        Builder -> Builder -> Builder
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) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int
forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if Int -> Int
forall a. Num a => a -> a
signum Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
        Builder -> Builder -> 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) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int
forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if Int -> Int
forall a. Num a => a -> a
signum Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in Builder
prefix
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
b
        Builder -> Builder -> Builder
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) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int -> Int
forall a. Num a => a -> a
abs Int
i) Int
60
      !prefix :: Builder
prefix = if Int -> Int
forall a. Num a => a -> a
signum Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Builder
"-" else Builder
"+"
   in if Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then
          Builder
prefix
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
        else
          Builder
prefix
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
indexTwoDigitByteStringBuilder Int
a
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
            Builder -> Builder -> 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 (Char -> ByteString) -> Maybe Char -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
msep'
  (ByteString -> ZeptoT Identity ())
-> Maybe ByteString -> ZeptoT Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ByteString -> ZeptoT Identity ()
forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  TimeOfDay
time <- Maybe Char -> Parser TimeOfDay
zeptoUtf8_HMS Maybe Char
mtimeSep
  Datetime -> Parser Datetime
forall a. a -> ZeptoT Identity a
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 <- (Word8 -> Bool) -> ZeptoT Identity ByteString
forall (m :: * -> *).
Monad m =>
(Word8 -> Bool) -> ZeptoT m ByteString
Z.takeWhile (Word8
0x30 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==)
  Int -> Parser Int
forall a. a -> ZeptoT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Parser Int) -> Int -> Parser Int
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 (Char -> ByteString) -> Maybe Char -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
msep'
  (ByteString -> ZeptoT Identity ())
-> Maybe ByteString -> ZeptoT Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ByteString -> ZeptoT Identity ()
forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  Int
m <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
2
  Bool -> ZeptoT Identity () -> ZeptoT Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12) (String -> ZeptoT Identity ()
forall a. String -> ZeptoT Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"month must be between 1 and 12")
  (ByteString -> ZeptoT Identity ())
-> Maybe ByteString -> ZeptoT Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ByteString -> ZeptoT Identity ()
forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  Int
d <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
2
  Bool -> ZeptoT Identity () -> ZeptoT Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31) (String -> ZeptoT Identity ()
forall a. String -> ZeptoT Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"day must be between 1 and 31")
  Date -> Parser Date
forall a. a -> ZeptoT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Month -> DayOfMonth -> Date
Date (Int -> Year
Year Int
y) (Int -> Month
Month (Int -> Month) -> Int -> Month
forall a b. (a -> b) -> a -> b
$ Int
m Int -> Int -> Int
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
  Bool -> ZeptoT Identity () -> ZeptoT Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
23) (String -> ZeptoT Identity ()
forall a. String -> ZeptoT Identity a
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 (Char -> ByteString) -> Maybe Char -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
msep'
  (ByteString -> ZeptoT Identity ())
-> Maybe ByteString -> ZeptoT Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ByteString -> ZeptoT Identity ()
forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  Int
m <- Int -> Parser Int
zeptoFixedDigitsIntBS Int
2
  Bool -> ZeptoT Identity () -> ZeptoT Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59) (String -> ZeptoT Identity ()
forall a. String -> ZeptoT Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"minute must be between 0 and 59")
  (ByteString -> ZeptoT Identity ())
-> Maybe ByteString -> ZeptoT Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ByteString -> ZeptoT Identity ()
forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string Maybe ByteString
msep
  Int64
ns <- Parser Int64
zeptoSecondsAndNanosecondsUtf8
  TimeOfDay -> Parser TimeOfDay
forall a. a -> ZeptoT Identity a
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 <- Int -> ZeptoT Identity ByteString
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 -> String -> Parser Int
forall a. String -> ZeptoT Identity a
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 Int -> Parser Int
forall a. a -> ZeptoT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
        else String -> Parser Int
forall a. String -> ZeptoT Identity a
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 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s' :: Int64
  Bool -> ZeptoT Identity () -> ZeptoT Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
60) (String -> ZeptoT Identity ()
forall a. String -> ZeptoT Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"seconds must be between 0 and 60")
  Int64
nanoseconds <-
    ( do
        ()
_ <- ByteString -> ZeptoT Identity ()
forall (m :: * -> *). Monad m => ByteString -> ZeptoT m ()
Z.string ByteString
"."
        Int
numberOfZeroes <- Parser Int
zeptoCountZeroes
        Int64
x <- Parser Int64
zdecimal
        let totalDigits :: Int
totalDigits = Int64 -> Int
forall a. Integral a => a -> Int
countDigits Int64
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numberOfZeroes
            result :: Int64
result =
              if Int
totalDigits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9
                then Int64
x
                else
                  if Int
totalDigits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9
                    then Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
raiseTenTo (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
totalDigits)
                    else Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
quot Int64
x (Int -> Int64
raiseTenTo (Int
totalDigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9))
        Int64 -> Parser Int64
forall a. a -> ZeptoT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
result)
      )
      Parser Int64 -> Parser Int64 -> Parser Int64
forall a.
ZeptoT Identity a -> ZeptoT Identity a -> ZeptoT Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int64 -> Parser Int64
forall a. a -> ZeptoT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
  Int64 -> Parser Int64
forall a. a -> ZeptoT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
nanoseconds)

zdecimal :: Z.Parser Int64
zdecimal :: Parser Int64
zdecimal = do
  ByteString
digits <- (Word8 -> Bool) -> ZeptoT Identity ByteString
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 -> String -> Parser Int64
forall a. String -> ZeptoT Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"somehow this didn't work"
    Just (Int
i, ByteString
_) -> Int64 -> Parser Int64
forall a. a -> ZeptoT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Parser Int64) -> Int64 -> Parser Int64
forall a b. (a -> b) -> a -> b
$! Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i

wordIsDigit :: Word8 -> Bool
wordIsDigit :: Word8 -> Bool
wordIsDigit Word8
a = Word8
0x30 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
a Bool -> Bool -> Bool
&& Word8
a Word8 -> Word8 -> Bool
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
  | Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v64 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v0 = Int -> Word64 -> Int
forall {t}. Num t => t -> Word64 -> t
go Int
1 Word64
v64
  | Bool
otherwise = Int -> Integer -> Int
goBig Int
1 (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v0)
 where
  v64 :: Word64
v64 = a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v0
  goBig :: Int -> Integer -> Int
goBig !Int
k (Integer
v :: Integer)
    | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
big = Int -> Integer -> Int
goBig (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
19) (Integer
v Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
big)
    | Bool
otherwise = Int -> Word64 -> Int
forall {t}. Num t => t -> Word64 -> t
go Int
k (Integer -> Word64
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
10 = t
k
    | Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
100 = t
k t -> t -> t
forall a. Num a => a -> a -> a
+ t
1
    | Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
1000 = t
k t -> t -> t
forall a. Num a => a -> a -> a
+ t
2
    | Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
1000000000000 =
        t
k
          t -> t -> t
forall a. Num a => a -> a -> a
+ if Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
100000000
            then
              if Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
1000000
                then
                  if Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
10000
                    then t
3
                    else t
4 t -> t -> t
forall a. Num a => a -> a -> a
+ Word64 -> Word64 -> t
forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
100000
                else t
6 t -> t -> t
forall a. Num a => a -> a -> a
+ Word64 -> Word64 -> t
forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
10000000
            else
              if Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
10000000000
                then t
8 t -> t -> t
forall a. Num a => a -> a -> a
+ Word64 -> Word64 -> t
forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
1000000000
                else t
10 t -> t -> t
forall a. Num a => a -> a -> a
+ Word64 -> Word64 -> t
forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
100000000000
    | Bool
otherwise = t -> Word64 -> t
go (t
k t -> t -> t
forall a. Num a => a -> a -> a
+ t
12) (Word64
v Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
1000000000000)
  fin :: a -> a -> a
fin a
v a
n = if a
v a -> a -> Bool
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 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
a = t
a
clip t
_ t
b t
x | t
x t -> t -> Bool
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 Reader Int
forall a. Integral a => Reader a
Text.decimal Text
t of
    Left String
err -> String -> Parser Int
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Right (Int
i, Text
r) ->
      if Text -> Bool
Text.null Text
r
        then Int -> Parser Int
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
        else String -> Parser Int
forall a. String -> Parser Text a
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 -> String -> Parser Int
forall a. String -> Parser ByteString a
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 Int -> Parser Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
        else String -> Parser Int
forall a. String -> Parser ByteString a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100
    then Vector Builder -> Int -> Builder
forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector Builder
twoDigitTextBuilder (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    else Int -> Builder
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100
    then Vector Builder -> Int -> Builder
forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector Builder
twoDigitByteStringBuilder (Int -> Int
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 =
  [Builder] -> Vector Builder
forall a. [a] -> Vector a
Vector.fromList ([Builder] -> Vector Builder) -> [Builder] -> Vector Builder
forall a b. (a -> b) -> a -> b
$
    (String -> Builder) -> [String] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Builder
BB.byteString (ByteString -> Builder)
-> (String -> ByteString) -> String -> Builder
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 =
  [Builder] -> Vector Builder
forall a. [a] -> Vector a
Vector.fromList ([Builder] -> Vector Builder) -> [Builder] -> Vector Builder
forall a b. (a -> b) -> a -> b
$
    (String -> Builder) -> [String] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Builder
TB.fromText (Text -> Builder) -> (String -> Text) -> String -> Builder
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
15
    then Int64
10 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i
    else Vector Int64 -> Int -> Int64
forall a. Unbox a => Vector a -> Int -> a
UVector.unsafeIndex Vector Int64
tenRaisedToSmallPowers Int
i

tenRaisedToSmallPowers :: UVector.Vector Int64
tenRaisedToSmallPowers :: Vector Int64
tenRaisedToSmallPowers = [Int64] -> Vector Int64
forall a. Unbox a => [a] -> Vector a
UVector.fromList ([Int64] -> Vector Int64) -> [Int64] -> Vector Int64
forall a b. (a -> b) -> a -> b
$ (Int -> Int64) -> [Int] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map (Int64
10 Int64 -> Int -> Int64
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Builder
"000" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
TB.decimal Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100 = Builder
"00" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
TB.decimal Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000 = Builder
"0" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
TB.decimal Int
x
  | Bool
otherwise = Int -> Builder
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 Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Builder
"000" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100 = Builder
"00" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000 = Builder
"0" Builder -> Builder -> Builder
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 Int -> Int -> Int
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 Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
t0 Bool -> Bool -> Bool
&& Time
t Time -> Time -> Bool
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 Time
forall a. Bounded a => a
minBound Time
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) = Time -> Time -> Timespan
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 Time -> Time -> Ordering
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
(Int -> Day -> ShowS)
-> (Day -> String) -> ([Day] -> ShowS) -> Show Day
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Day -> ShowS
showsPrec :: Int -> Day -> ShowS
$cshow :: Day -> String
show :: Day -> String
$cshowList :: [Day] -> ShowS
showList :: [Day] -> ShowS
Show, ReadPrec [Day]
ReadPrec Day
Int -> ReadS Day
ReadS [Day]
(Int -> ReadS Day)
-> ReadS [Day] -> ReadPrec Day -> ReadPrec [Day] -> Read Day
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Day
readsPrec :: Int -> ReadS Day
$creadList :: ReadS [Day]
readList :: ReadS [Day]
$creadPrec :: ReadPrec Day
readPrec :: ReadPrec Day
$creadListPrec :: ReadPrec [Day]
readListPrec :: ReadPrec [Day]
Read, Day -> Day -> Bool
(Day -> Day -> Bool) -> (Day -> Day -> Bool) -> Eq Day
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Day -> Day -> Bool
== :: Day -> Day -> Bool
$c/= :: Day -> Day -> Bool
/= :: Day -> Day -> Bool
Eq, Eq Day
Eq Day =>
(Day -> Day -> Ordering)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Day)
-> (Day -> Day -> Day)
-> Ord 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
$ccompare :: Day -> Day -> Ordering
compare :: Day -> Day -> Ordering
$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
>= :: Day -> Day -> Bool
$cmax :: Day -> Day -> Day
max :: Day -> Day -> Day
$cmin :: Day -> Day -> Day
min :: Day -> Day -> Day
Ord, Eq Day
Eq Day => (Int -> Day -> Int) -> (Day -> Int) -> Hashable Day
Int -> Day -> Int
Day -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Day -> Int
hashWithSalt :: Int -> Day -> Int
$chash :: Day -> Int
hash :: Day -> Int
Hashable, Int -> Day
Day -> Int
Day -> [Day]
Day -> Day
Day -> Day -> [Day]
Day -> Day -> Day -> [Day]
(Day -> Day)
-> (Day -> Day)
-> (Int -> Day)
-> (Day -> Int)
-> (Day -> [Day])
-> (Day -> Day -> [Day])
-> (Day -> Day -> [Day])
-> (Day -> Day -> Day -> [Day])
-> Enum 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
$csucc :: Day -> Day
succ :: Day -> Day
$cpred :: Day -> Day
pred :: Day -> Day
$ctoEnum :: Int -> Day
toEnum :: Int -> Day
$cfromEnum :: Day -> Int
fromEnum :: Day -> Int
$cenumFrom :: Day -> [Day]
enumFrom :: Day -> [Day]
$cenumFromThen :: Day -> Day -> [Day]
enumFromThen :: Day -> Day -> [Day]
$cenumFromTo :: Day -> Day -> [Day]
enumFromTo :: Day -> Day -> [Day]
$cenumFromThenTo :: Day -> Day -> Day -> [Day]
enumFromThenTo :: Day -> Day -> Day -> [Day]
Enum, [Day] -> Value
[Day] -> Encoding
Day -> Bool
Day -> Value
Day -> Encoding
(Day -> Value)
-> (Day -> Encoding)
-> ([Day] -> Value)
-> ([Day] -> Encoding)
-> (Day -> Bool)
-> ToJSON Day
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Day -> Value
toJSON :: Day -> Value
$ctoEncoding :: Day -> Encoding
toEncoding :: Day -> Encoding
$ctoJSONList :: [Day] -> Value
toJSONList :: [Day] -> Value
$ctoEncodingList :: [Day] -> Encoding
toEncodingList :: [Day] -> Encoding
$comitField :: Day -> Bool
omitField :: Day -> Bool
ToJSON, Maybe Day
Value -> Parser [Day]
Value -> Parser Day
(Value -> Parser Day)
-> (Value -> Parser [Day]) -> Maybe Day -> FromJSON Day
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Day
parseJSON :: Value -> Parser Day
$cparseJSONList :: Value -> Parser [Day]
parseJSONList :: Value -> Parser [Day]
$comittedField :: Maybe Day
omittedField :: Maybe Day
FromJSON, Ptr Day -> IO Day
Ptr Day -> Int -> IO Day
Ptr Day -> Int -> Day -> IO ()
Ptr Day -> Day -> IO ()
Day -> Int
(Day -> Int)
-> (Day -> Int)
-> (Ptr Day -> Int -> IO Day)
-> (Ptr Day -> Int -> Day -> IO ())
-> (forall b. Ptr b -> Int -> IO Day)
-> (forall b. Ptr b -> Int -> Day -> IO ())
-> (Ptr Day -> IO Day)
-> (Ptr Day -> Day -> IO ())
-> Storable Day
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
$csizeOf :: Day -> Int
sizeOf :: Day -> Int
$calignment :: Day -> Int
alignment :: Day -> Int
$cpeekElemOff :: Ptr Day -> Int -> IO Day
peekElemOff :: Ptr Day -> Int -> IO Day
$cpokeElemOff :: Ptr Day -> Int -> Day -> IO ()
pokeElemOff :: Ptr Day -> Int -> Day -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Day
peekByteOff :: forall b. Ptr b -> Int -> IO Day
$cpokeByteOff :: forall b. Ptr b -> Int -> Day -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Day -> IO ()
$cpeek :: Ptr Day -> IO Day
peek :: Ptr Day -> IO Day
$cpoke :: Ptr Day -> Day -> IO ()
poke :: Ptr Day -> Day -> IO ()
Storable, Addr# -> Int# -> Day
ByteArray# -> Int# -> Day
Proxy Day -> Int#
Day -> Int#
(Proxy Day -> Int#)
-> (Day -> Int#)
-> (Proxy Day -> Int#)
-> (Day -> Int#)
-> (ByteArray# -> Int# -> Day)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Day #))
-> (forall s.
    MutableByteArray# s -> Int# -> Day -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> Day -> State# s -> State# s)
-> (Addr# -> Int# -> Day)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, Day #))
-> (forall s. Addr# -> Int# -> Day -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> Day -> State# s -> State# s)
-> Prim Day
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.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy 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
$csizeOfType# :: Proxy Day -> Int#
sizeOfType# :: Proxy Day -> Int#
$csizeOf# :: Day -> Int#
sizeOf# :: Day -> Int#
$calignmentOfType# :: Proxy Day -> Int#
alignmentOfType# :: Proxy Day -> Int#
$calignment# :: Day -> Int#
alignment# :: Day -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> Day
indexByteArray# :: ByteArray# -> Int# -> Day
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Day #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Day #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Day -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Day -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Day -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Day -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> Day
indexOffAddr# :: Addr# -> Int# -> Day
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Day #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Day #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Day -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Day -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Day -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Day -> State# s -> State# s
Prim, Day -> ()
(Day -> ()) -> NFData Day
forall a. (a -> ()) -> NFData a
$crnf :: Day -> ()
rnf :: Day -> ()
NFData)

instance Torsor Day Int where
  add :: Int -> Day -> Day
add Int
i (Day Int
d) = Int -> Day
Day (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
  difference :: Day -> Day -> Int
difference (Day Int
a) (Day Int
b) = Int
a Int -> Int -> Int
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 = (Int -> Day) -> f Int -> f Day
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Day
Day (f Int -> f Day) -> (Day -> f Int) -> Day -> f Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (Day -> Int) -> Day -> f Int
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
(Int -> DayOfWeek -> ShowS)
-> (DayOfWeek -> String)
-> ([DayOfWeek] -> ShowS)
-> Show DayOfWeek
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DayOfWeek -> ShowS
showsPrec :: Int -> DayOfWeek -> ShowS
$cshow :: DayOfWeek -> String
show :: DayOfWeek -> String
$cshowList :: [DayOfWeek] -> ShowS
showList :: [DayOfWeek] -> ShowS
Show, ReadPrec [DayOfWeek]
ReadPrec DayOfWeek
Int -> ReadS DayOfWeek
ReadS [DayOfWeek]
(Int -> ReadS DayOfWeek)
-> ReadS [DayOfWeek]
-> ReadPrec DayOfWeek
-> ReadPrec [DayOfWeek]
-> Read DayOfWeek
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DayOfWeek
readsPrec :: Int -> ReadS DayOfWeek
$creadList :: ReadS [DayOfWeek]
readList :: ReadS [DayOfWeek]
$creadPrec :: ReadPrec DayOfWeek
readPrec :: ReadPrec DayOfWeek
$creadListPrec :: ReadPrec [DayOfWeek]
readListPrec :: ReadPrec [DayOfWeek]
Read, DayOfWeek -> DayOfWeek -> Bool
(DayOfWeek -> DayOfWeek -> Bool)
-> (DayOfWeek -> DayOfWeek -> Bool) -> Eq DayOfWeek
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DayOfWeek -> DayOfWeek -> Bool
== :: DayOfWeek -> DayOfWeek -> Bool
$c/= :: DayOfWeek -> DayOfWeek -> Bool
/= :: DayOfWeek -> DayOfWeek -> Bool
Eq, Eq DayOfWeek
Eq DayOfWeek =>
(DayOfWeek -> DayOfWeek -> Ordering)
-> (DayOfWeek -> DayOfWeek -> Bool)
-> (DayOfWeek -> DayOfWeek -> Bool)
-> (DayOfWeek -> DayOfWeek -> Bool)
-> (DayOfWeek -> DayOfWeek -> Bool)
-> (DayOfWeek -> DayOfWeek -> DayOfWeek)
-> (DayOfWeek -> DayOfWeek -> DayOfWeek)
-> Ord 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
$ccompare :: DayOfWeek -> DayOfWeek -> Ordering
compare :: DayOfWeek -> DayOfWeek -> Ordering
$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
>= :: DayOfWeek -> DayOfWeek -> Bool
$cmax :: DayOfWeek -> DayOfWeek -> DayOfWeek
max :: DayOfWeek -> DayOfWeek -> DayOfWeek
$cmin :: DayOfWeek -> DayOfWeek -> DayOfWeek
min :: DayOfWeek -> DayOfWeek -> DayOfWeek
Ord, Eq DayOfWeek
Eq DayOfWeek =>
(Int -> DayOfWeek -> Int)
-> (DayOfWeek -> Int) -> Hashable DayOfWeek
Int -> DayOfWeek -> Int
DayOfWeek -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> DayOfWeek -> Int
hashWithSalt :: Int -> DayOfWeek -> Int
$chash :: DayOfWeek -> Int
hash :: DayOfWeek -> Int
Hashable, DayOfWeek -> ()
(DayOfWeek -> ()) -> NFData DayOfWeek
forall a. (a -> ()) -> NFData a
$crnf :: DayOfWeek -> ()
rnf :: 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 = (Int -> DayOfWeek) -> f Int -> f DayOfWeek
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DayOfWeek
DayOfWeek (f Int -> f DayOfWeek)
-> (DayOfWeek -> f Int) -> DayOfWeek -> f DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (DayOfWeek -> Int) -> DayOfWeek -> f Int
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
(Int -> DayOfMonth -> ShowS)
-> (DayOfMonth -> String)
-> ([DayOfMonth] -> ShowS)
-> Show DayOfMonth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DayOfMonth -> ShowS
showsPrec :: Int -> DayOfMonth -> ShowS
$cshow :: DayOfMonth -> String
show :: DayOfMonth -> String
$cshowList :: [DayOfMonth] -> ShowS
showList :: [DayOfMonth] -> ShowS
Show, ReadPrec [DayOfMonth]
ReadPrec DayOfMonth
Int -> ReadS DayOfMonth
ReadS [DayOfMonth]
(Int -> ReadS DayOfMonth)
-> ReadS [DayOfMonth]
-> ReadPrec DayOfMonth
-> ReadPrec [DayOfMonth]
-> Read DayOfMonth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DayOfMonth
readsPrec :: Int -> ReadS DayOfMonth
$creadList :: ReadS [DayOfMonth]
readList :: ReadS [DayOfMonth]
$creadPrec :: ReadPrec DayOfMonth
readPrec :: ReadPrec DayOfMonth
$creadListPrec :: ReadPrec [DayOfMonth]
readListPrec :: ReadPrec [DayOfMonth]
Read, DayOfMonth -> DayOfMonth -> Bool
(DayOfMonth -> DayOfMonth -> Bool)
-> (DayOfMonth -> DayOfMonth -> Bool) -> Eq DayOfMonth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DayOfMonth -> DayOfMonth -> Bool
== :: DayOfMonth -> DayOfMonth -> Bool
$c/= :: DayOfMonth -> DayOfMonth -> Bool
/= :: DayOfMonth -> DayOfMonth -> Bool
Eq, Eq DayOfMonth
Eq DayOfMonth =>
(DayOfMonth -> DayOfMonth -> Ordering)
-> (DayOfMonth -> DayOfMonth -> Bool)
-> (DayOfMonth -> DayOfMonth -> Bool)
-> (DayOfMonth -> DayOfMonth -> Bool)
-> (DayOfMonth -> DayOfMonth -> Bool)
-> (DayOfMonth -> DayOfMonth -> DayOfMonth)
-> (DayOfMonth -> DayOfMonth -> DayOfMonth)
-> Ord 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
$ccompare :: DayOfMonth -> DayOfMonth -> Ordering
compare :: DayOfMonth -> DayOfMonth -> Ordering
$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
>= :: DayOfMonth -> DayOfMonth -> Bool
$cmax :: DayOfMonth -> DayOfMonth -> DayOfMonth
max :: DayOfMonth -> DayOfMonth -> DayOfMonth
$cmin :: DayOfMonth -> DayOfMonth -> DayOfMonth
min :: DayOfMonth -> DayOfMonth -> DayOfMonth
Ord, Addr# -> Int# -> DayOfMonth
ByteArray# -> Int# -> DayOfMonth
Proxy DayOfMonth -> Int#
DayOfMonth -> Int#
(Proxy DayOfMonth -> Int#)
-> (DayOfMonth -> Int#)
-> (Proxy DayOfMonth -> Int#)
-> (DayOfMonth -> Int#)
-> (ByteArray# -> Int# -> DayOfMonth)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, DayOfMonth #))
-> (forall s.
    MutableByteArray# s -> Int# -> DayOfMonth -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> DayOfMonth -> State# s -> State# s)
-> (Addr# -> Int# -> DayOfMonth)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, DayOfMonth #))
-> (forall s. Addr# -> Int# -> DayOfMonth -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> DayOfMonth -> State# s -> State# s)
-> Prim DayOfMonth
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.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy 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
$csizeOfType# :: Proxy DayOfMonth -> Int#
sizeOfType# :: Proxy DayOfMonth -> Int#
$csizeOf# :: DayOfMonth -> Int#
sizeOf# :: DayOfMonth -> Int#
$calignmentOfType# :: Proxy DayOfMonth -> Int#
alignmentOfType# :: Proxy DayOfMonth -> Int#
$calignment# :: DayOfMonth -> Int#
alignment# :: DayOfMonth -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> DayOfMonth
indexByteArray# :: ByteArray# -> Int# -> DayOfMonth
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfMonth #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfMonth #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> DayOfMonth -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> DayOfMonth -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfMonth -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfMonth -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> DayOfMonth
indexOffAddr# :: Addr# -> Int# -> DayOfMonth
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfMonth #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfMonth #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> DayOfMonth -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> DayOfMonth -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> DayOfMonth -> State# s -> State# s
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> DayOfMonth -> State# s -> State# s
Prim, Int -> DayOfMonth
DayOfMonth -> Int
DayOfMonth -> [DayOfMonth]
DayOfMonth -> DayOfMonth
DayOfMonth -> DayOfMonth -> [DayOfMonth]
DayOfMonth -> DayOfMonth -> DayOfMonth -> [DayOfMonth]
(DayOfMonth -> DayOfMonth)
-> (DayOfMonth -> DayOfMonth)
-> (Int -> DayOfMonth)
-> (DayOfMonth -> Int)
-> (DayOfMonth -> [DayOfMonth])
-> (DayOfMonth -> DayOfMonth -> [DayOfMonth])
-> (DayOfMonth -> DayOfMonth -> [DayOfMonth])
-> (DayOfMonth -> DayOfMonth -> DayOfMonth -> [DayOfMonth])
-> Enum 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
$csucc :: DayOfMonth -> DayOfMonth
succ :: DayOfMonth -> DayOfMonth
$cpred :: DayOfMonth -> DayOfMonth
pred :: DayOfMonth -> DayOfMonth
$ctoEnum :: Int -> DayOfMonth
toEnum :: Int -> DayOfMonth
$cfromEnum :: DayOfMonth -> Int
fromEnum :: DayOfMonth -> Int
$cenumFrom :: DayOfMonth -> [DayOfMonth]
enumFrom :: DayOfMonth -> [DayOfMonth]
$cenumFromThen :: DayOfMonth -> DayOfMonth -> [DayOfMonth]
enumFromThen :: DayOfMonth -> DayOfMonth -> [DayOfMonth]
$cenumFromTo :: DayOfMonth -> DayOfMonth -> [DayOfMonth]
enumFromTo :: DayOfMonth -> DayOfMonth -> [DayOfMonth]
$cenumFromThenTo :: DayOfMonth -> DayOfMonth -> DayOfMonth -> [DayOfMonth]
enumFromThenTo :: DayOfMonth -> DayOfMonth -> DayOfMonth -> [DayOfMonth]
Enum, DayOfMonth -> ()
(DayOfMonth -> ()) -> NFData DayOfMonth
forall a. (a -> ()) -> NFData a
$crnf :: DayOfMonth -> ()
rnf :: 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 = (Int -> DayOfMonth) -> f Int -> f DayOfMonth
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DayOfMonth
DayOfMonth (f Int -> f DayOfMonth)
-> (DayOfMonth -> f Int) -> DayOfMonth -> f DayOfMonth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (DayOfMonth -> Int) -> DayOfMonth -> f Int
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
(Int -> DayOfYear -> ShowS)
-> (DayOfYear -> String)
-> ([DayOfYear] -> ShowS)
-> Show DayOfYear
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DayOfYear -> ShowS
showsPrec :: Int -> DayOfYear -> ShowS
$cshow :: DayOfYear -> String
show :: DayOfYear -> String
$cshowList :: [DayOfYear] -> ShowS
showList :: [DayOfYear] -> ShowS
Show, ReadPrec [DayOfYear]
ReadPrec DayOfYear
Int -> ReadS DayOfYear
ReadS [DayOfYear]
(Int -> ReadS DayOfYear)
-> ReadS [DayOfYear]
-> ReadPrec DayOfYear
-> ReadPrec [DayOfYear]
-> Read DayOfYear
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DayOfYear
readsPrec :: Int -> ReadS DayOfYear
$creadList :: ReadS [DayOfYear]
readList :: ReadS [DayOfYear]
$creadPrec :: ReadPrec DayOfYear
readPrec :: ReadPrec DayOfYear
$creadListPrec :: ReadPrec [DayOfYear]
readListPrec :: ReadPrec [DayOfYear]
Read, DayOfYear -> DayOfYear -> Bool
(DayOfYear -> DayOfYear -> Bool)
-> (DayOfYear -> DayOfYear -> Bool) -> Eq DayOfYear
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DayOfYear -> DayOfYear -> Bool
== :: DayOfYear -> DayOfYear -> Bool
$c/= :: DayOfYear -> DayOfYear -> Bool
/= :: DayOfYear -> DayOfYear -> Bool
Eq, Eq DayOfYear
Eq DayOfYear =>
(DayOfYear -> DayOfYear -> Ordering)
-> (DayOfYear -> DayOfYear -> Bool)
-> (DayOfYear -> DayOfYear -> Bool)
-> (DayOfYear -> DayOfYear -> Bool)
-> (DayOfYear -> DayOfYear -> Bool)
-> (DayOfYear -> DayOfYear -> DayOfYear)
-> (DayOfYear -> DayOfYear -> DayOfYear)
-> Ord 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
$ccompare :: DayOfYear -> DayOfYear -> Ordering
compare :: DayOfYear -> DayOfYear -> Ordering
$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
>= :: DayOfYear -> DayOfYear -> Bool
$cmax :: DayOfYear -> DayOfYear -> DayOfYear
max :: DayOfYear -> DayOfYear -> DayOfYear
$cmin :: DayOfYear -> DayOfYear -> DayOfYear
min :: DayOfYear -> DayOfYear -> DayOfYear
Ord, Addr# -> Int# -> DayOfYear
ByteArray# -> Int# -> DayOfYear
Proxy DayOfYear -> Int#
DayOfYear -> Int#
(Proxy DayOfYear -> Int#)
-> (DayOfYear -> Int#)
-> (Proxy DayOfYear -> Int#)
-> (DayOfYear -> Int#)
-> (ByteArray# -> Int# -> DayOfYear)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, DayOfYear #))
-> (forall s.
    MutableByteArray# s -> Int# -> DayOfYear -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> DayOfYear -> State# s -> State# s)
-> (Addr# -> Int# -> DayOfYear)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, DayOfYear #))
-> (forall s. Addr# -> Int# -> DayOfYear -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> DayOfYear -> State# s -> State# s)
-> Prim DayOfYear
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.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy 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
$csizeOfType# :: Proxy DayOfYear -> Int#
sizeOfType# :: Proxy DayOfYear -> Int#
$csizeOf# :: DayOfYear -> Int#
sizeOf# :: DayOfYear -> Int#
$calignmentOfType# :: Proxy DayOfYear -> Int#
alignmentOfType# :: Proxy DayOfYear -> Int#
$calignment# :: DayOfYear -> Int#
alignment# :: DayOfYear -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> DayOfYear
indexByteArray# :: ByteArray# -> Int# -> DayOfYear
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfYear #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, DayOfYear #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> DayOfYear -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> DayOfYear -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfYear -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> DayOfYear -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> DayOfYear
indexOffAddr# :: Addr# -> Int# -> DayOfYear
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfYear #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, DayOfYear #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> DayOfYear -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> DayOfYear -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> DayOfYear -> State# s -> State# s
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> DayOfYear -> State# s -> State# s
Prim, DayOfYear -> ()
(DayOfYear -> ()) -> NFData DayOfYear
forall a. (a -> ()) -> NFData a
$crnf :: DayOfYear -> ()
rnf :: 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 = (Int -> DayOfYear) -> f Int -> f DayOfYear
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DayOfYear
DayOfYear (f Int -> f DayOfYear)
-> (DayOfYear -> f Int) -> DayOfYear -> f DayOfYear
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (DayOfYear -> Int) -> DayOfYear -> f Int
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
(Int -> Month -> ShowS)
-> (Month -> String) -> ([Month] -> ShowS) -> Show Month
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Month -> ShowS
showsPrec :: Int -> Month -> ShowS
$cshow :: Month -> String
show :: Month -> String
$cshowList :: [Month] -> ShowS
showList :: [Month] -> ShowS
Show, ReadPrec [Month]
ReadPrec Month
Int -> ReadS Month
ReadS [Month]
(Int -> ReadS Month)
-> ReadS [Month]
-> ReadPrec Month
-> ReadPrec [Month]
-> Read Month
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Month
readsPrec :: Int -> ReadS Month
$creadList :: ReadS [Month]
readList :: ReadS [Month]
$creadPrec :: ReadPrec Month
readPrec :: ReadPrec Month
$creadListPrec :: ReadPrec [Month]
readListPrec :: ReadPrec [Month]
Read, Month -> Month -> Bool
(Month -> Month -> Bool) -> (Month -> Month -> Bool) -> Eq Month
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Month -> Month -> Bool
== :: Month -> Month -> Bool
$c/= :: Month -> Month -> Bool
/= :: Month -> Month -> Bool
Eq, Eq Month
Eq Month =>
(Month -> Month -> Ordering)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Month)
-> (Month -> Month -> Month)
-> Ord 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
$ccompare :: Month -> Month -> Ordering
compare :: Month -> Month -> Ordering
$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
>= :: Month -> Month -> Bool
$cmax :: Month -> Month -> Month
max :: Month -> Month -> Month
$cmin :: Month -> Month -> Month
min :: Month -> Month -> Month
Ord, Addr# -> Int# -> Month
ByteArray# -> Int# -> Month
Proxy Month -> Int#
Month -> Int#
(Proxy Month -> Int#)
-> (Month -> Int#)
-> (Proxy Month -> Int#)
-> (Month -> Int#)
-> (ByteArray# -> Int# -> Month)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Month #))
-> (forall s.
    MutableByteArray# s -> Int# -> Month -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> Month -> State# s -> State# s)
-> (Addr# -> Int# -> Month)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, Month #))
-> (forall s. Addr# -> Int# -> Month -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> Month -> State# s -> State# s)
-> Prim Month
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.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy 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
$csizeOfType# :: Proxy Month -> Int#
sizeOfType# :: Proxy Month -> Int#
$csizeOf# :: Month -> Int#
sizeOf# :: Month -> Int#
$calignmentOfType# :: Proxy Month -> Int#
alignmentOfType# :: Proxy Month -> Int#
$calignment# :: Month -> Int#
alignment# :: Month -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> Month
indexByteArray# :: ByteArray# -> Int# -> Month
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Month #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Month #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Month -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Month -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Month -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Month -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> Month
indexOffAddr# :: Addr# -> Int# -> Month
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Month #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Month #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Month -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Month -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Month -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Month -> State# s -> State# s
Prim, Month -> ()
(Month -> ()) -> NFData Month
forall a. (a -> ()) -> NFData a
$crnf :: Month -> ()
rnf :: 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 = (Int -> Month) -> f Int -> f Month
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Month
Month (f Int -> f Month) -> (Month -> f Int) -> Month -> f Month
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (Month -> Int) -> Month -> f Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
11
      then Int -> Month
Month (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      else String -> Month
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      then Int -> Month
Month (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      else String -> Month
forall a. HasCallStack => String -> a
error String
"Enum.pred{Month}: tried to take pred of January"
  enumFrom :: Month -> [Month]
enumFrom Month
x = Month -> Month -> [Month]
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
(Int -> Year -> ShowS)
-> (Year -> String) -> ([Year] -> ShowS) -> Show Year
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Year -> ShowS
showsPrec :: Int -> Year -> ShowS
$cshow :: Year -> String
show :: Year -> String
$cshowList :: [Year] -> ShowS
showList :: [Year] -> ShowS
Show, ReadPrec [Year]
ReadPrec Year
Int -> ReadS Year
ReadS [Year]
(Int -> ReadS Year)
-> ReadS [Year] -> ReadPrec Year -> ReadPrec [Year] -> Read Year
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Year
readsPrec :: Int -> ReadS Year
$creadList :: ReadS [Year]
readList :: ReadS [Year]
$creadPrec :: ReadPrec Year
readPrec :: ReadPrec Year
$creadListPrec :: ReadPrec [Year]
readListPrec :: ReadPrec [Year]
Read, Year -> Year -> Bool
(Year -> Year -> Bool) -> (Year -> Year -> Bool) -> Eq Year
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Year -> Year -> Bool
== :: Year -> Year -> Bool
$c/= :: Year -> Year -> Bool
/= :: Year -> Year -> Bool
Eq, Eq Year
Eq Year =>
(Year -> Year -> Ordering)
-> (Year -> Year -> Bool)
-> (Year -> Year -> Bool)
-> (Year -> Year -> Bool)
-> (Year -> Year -> Bool)
-> (Year -> Year -> Year)
-> (Year -> Year -> Year)
-> Ord 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
$ccompare :: Year -> Year -> Ordering
compare :: Year -> Year -> Ordering
$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
>= :: Year -> Year -> Bool
$cmax :: Year -> Year -> Year
max :: Year -> Year -> Year
$cmin :: Year -> Year -> Year
min :: Year -> Year -> Year
Ord, Year -> ()
(Year -> ()) -> NFData Year
forall a. (a -> ()) -> NFData a
$crnf :: Year -> ()
rnf :: 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 = (Int -> Year) -> f Int -> f Year
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Year
Year (f Int -> f Year) -> (Year -> f Int) -> Year -> f Year
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (Year -> Int) -> Year -> f Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> Int
getYear

-- | A <https://en.wikipedia.org/wiki/UTC_offset UTC offset> in minutes.
newtype Offset = Offset {Offset -> Int
getOffset :: Int}
  deriving (Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
(Int -> Offset -> ShowS)
-> (Offset -> String) -> ([Offset] -> ShowS) -> Show Offset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Offset -> ShowS
showsPrec :: Int -> Offset -> ShowS
$cshow :: Offset -> String
show :: Offset -> String
$cshowList :: [Offset] -> ShowS
showList :: [Offset] -> ShowS
Show, ReadPrec [Offset]
ReadPrec Offset
Int -> ReadS Offset
ReadS [Offset]
(Int -> ReadS Offset)
-> ReadS [Offset]
-> ReadPrec Offset
-> ReadPrec [Offset]
-> Read Offset
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Offset
readsPrec :: Int -> ReadS Offset
$creadList :: ReadS [Offset]
readList :: ReadS [Offset]
$creadPrec :: ReadPrec Offset
readPrec :: ReadPrec Offset
$creadListPrec :: ReadPrec [Offset]
readListPrec :: ReadPrec [Offset]
Read, Offset -> Offset -> Bool
(Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool) -> Eq Offset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
/= :: Offset -> Offset -> Bool
Eq, Eq Offset
Eq Offset =>
(Offset -> Offset -> Ordering)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> Ord 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
$ccompare :: Offset -> Offset -> Ordering
compare :: Offset -> Offset -> Ordering
$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
>= :: Offset -> Offset -> Bool
$cmax :: Offset -> Offset -> Offset
max :: Offset -> Offset -> Offset
$cmin :: Offset -> Offset -> Offset
min :: Offset -> Offset -> Offset
Ord, Int -> Offset
Offset -> Int
Offset -> [Offset]
Offset -> Offset
Offset -> Offset -> [Offset]
Offset -> Offset -> Offset -> [Offset]
(Offset -> Offset)
-> (Offset -> Offset)
-> (Int -> Offset)
-> (Offset -> Int)
-> (Offset -> [Offset])
-> (Offset -> Offset -> [Offset])
-> (Offset -> Offset -> [Offset])
-> (Offset -> Offset -> Offset -> [Offset])
-> Enum 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
$csucc :: Offset -> Offset
succ :: Offset -> Offset
$cpred :: Offset -> Offset
pred :: Offset -> Offset
$ctoEnum :: Int -> Offset
toEnum :: Int -> Offset
$cfromEnum :: Offset -> Int
fromEnum :: Offset -> Int
$cenumFrom :: Offset -> [Offset]
enumFrom :: Offset -> [Offset]
$cenumFromThen :: Offset -> Offset -> [Offset]
enumFromThen :: Offset -> Offset -> [Offset]
$cenumFromTo :: Offset -> Offset -> [Offset]
enumFromTo :: Offset -> Offset -> [Offset]
$cenumFromThenTo :: Offset -> Offset -> Offset -> [Offset]
enumFromThenTo :: Offset -> Offset -> Offset -> [Offset]
Enum, Offset -> ()
(Offset -> ()) -> NFData Offset
forall a. (a -> ()) -> NFData a
$crnf :: Offset -> ()
rnf :: 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 = (Int -> Offset) -> f Int -> f Offset
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Offset
Offset (f Int -> f Offset) -> (Offset -> f Int) -> Offset -> f Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (Offset -> Int) -> Offset -> f Int
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 (Maybe Time
Value -> Parser [Time]
Value -> Parser Time
(Value -> Parser Time)
-> (Value -> Parser [Time]) -> Maybe Time -> FromJSON Time
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Time
parseJSON :: Value -> Parser Time
$cparseJSONList :: Value -> Parser [Time]
parseJSONList :: Value -> Parser [Time]
$comittedField :: Maybe Time
omittedField :: Maybe Time
FromJSON, [Time] -> Value
[Time] -> Encoding
Time -> Bool
Time -> Value
Time -> Encoding
(Time -> Value)
-> (Time -> Encoding)
-> ([Time] -> Value)
-> ([Time] -> Encoding)
-> (Time -> Bool)
-> ToJSON Time
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Time -> Value
toJSON :: Time -> Value
$ctoEncoding :: Time -> Encoding
toEncoding :: Time -> Encoding
$ctoJSONList :: [Time] -> Value
toJSONList :: [Time] -> Value
$ctoEncodingList :: [Time] -> Encoding
toEncodingList :: [Time] -> Encoding
$comitField :: Time -> Bool
omitField :: Time -> Bool
ToJSON, Eq Time
Eq Time => (Int -> Time -> Int) -> (Time -> Int) -> Hashable Time
Int -> Time -> Int
Time -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Time -> Int
hashWithSalt :: Int -> Time -> Int
$chash :: Time -> Int
hash :: Time -> Int
Hashable, Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
/= :: Time -> Time -> Bool
Eq, Eq Time
Eq Time =>
(Time -> Time -> Ordering)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> Ord 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
$ccompare :: Time -> Time -> Ordering
compare :: Time -> Time -> Ordering
$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
>= :: Time -> Time -> Bool
$cmax :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
min :: Time -> Time -> Time
Ord, Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
(Int -> Time -> ShowS)
-> (Time -> String) -> ([Time] -> ShowS) -> Show Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Time -> ShowS
showsPrec :: Int -> Time -> ShowS
$cshow :: Time -> String
show :: Time -> String
$cshowList :: [Time] -> ShowS
showList :: [Time] -> ShowS
Show, ReadPrec [Time]
ReadPrec Time
Int -> ReadS Time
ReadS [Time]
(Int -> ReadS Time)
-> ReadS [Time] -> ReadPrec Time -> ReadPrec [Time] -> Read Time
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Time
readsPrec :: Int -> ReadS Time
$creadList :: ReadS [Time]
readList :: ReadS [Time]
$creadPrec :: ReadPrec Time
readPrec :: ReadPrec Time
$creadListPrec :: ReadPrec [Time]
readListPrec :: ReadPrec [Time]
Read, Ptr Time -> IO Time
Ptr Time -> Int -> IO Time
Ptr Time -> Int -> Time -> IO ()
Ptr Time -> Time -> IO ()
Time -> Int
(Time -> Int)
-> (Time -> Int)
-> (Ptr Time -> Int -> IO Time)
-> (Ptr Time -> Int -> Time -> IO ())
-> (forall b. Ptr b -> Int -> IO Time)
-> (forall b. Ptr b -> Int -> Time -> IO ())
-> (Ptr Time -> IO Time)
-> (Ptr Time -> Time -> IO ())
-> Storable Time
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
$csizeOf :: Time -> Int
sizeOf :: Time -> Int
$calignment :: Time -> Int
alignment :: Time -> Int
$cpeekElemOff :: Ptr Time -> Int -> IO Time
peekElemOff :: Ptr Time -> Int -> IO Time
$cpokeElemOff :: Ptr Time -> Int -> Time -> IO ()
pokeElemOff :: Ptr Time -> Int -> Time -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Time
peekByteOff :: forall b. Ptr b -> Int -> IO Time
$cpokeByteOff :: forall b. Ptr b -> Int -> Time -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Time -> IO ()
$cpeek :: Ptr Time -> IO Time
peek :: Ptr Time -> IO Time
$cpoke :: Ptr Time -> Time -> IO ()
poke :: Ptr Time -> Time -> IO ()
Storable, Addr# -> Int# -> Time
ByteArray# -> Int# -> Time
Proxy Time -> Int#
Time -> Int#
(Proxy Time -> Int#)
-> (Time -> Int#)
-> (Proxy Time -> Int#)
-> (Time -> Int#)
-> (ByteArray# -> Int# -> Time)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Time #))
-> (forall s.
    MutableByteArray# s -> Int# -> Time -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> Time -> State# s -> State# s)
-> (Addr# -> Int# -> Time)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, Time #))
-> (forall s. Addr# -> Int# -> Time -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> Time -> State# s -> State# s)
-> Prim Time
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.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy 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
$csizeOfType# :: Proxy Time -> Int#
sizeOfType# :: Proxy Time -> Int#
$csizeOf# :: Time -> Int#
sizeOf# :: Time -> Int#
$calignmentOfType# :: Proxy Time -> Int#
alignmentOfType# :: Proxy Time -> Int#
$calignment# :: Time -> Int#
alignment# :: Time -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> Time
indexByteArray# :: ByteArray# -> Int# -> Time
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Time #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Time #)
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Time -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Time -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Time -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Time -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> Time
indexOffAddr# :: Addr# -> Int# -> Time
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Time #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Time #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Time -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Time -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Time -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Time -> State# s -> State# s
Prim, Time
Time -> Time -> Bounded Time
forall a. a -> a -> Bounded a
$cminBound :: Time
minBound :: Time
$cmaxBound :: Time
maxBound :: Time
Bounded, Time -> ()
(Time -> ()) -> NFData Time
forall a. (a -> ()) -> NFData a
$crnf :: Time -> ()
rnf :: 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 = (Int64 -> Time) -> f Int64 -> f Time
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Time
Time (f Int64 -> f Time) -> (Time -> f Int64) -> Time -> f Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> f Int64
f (Int64 -> f Int64) -> (Time -> Int64) -> Time -> f Int64
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 -> ()
(DayOfWeekMatch a -> ()) -> NFData (DayOfWeekMatch a)
forall a. NFData a => DayOfWeekMatch a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => DayOfWeekMatch a -> ()
rnf :: 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 -> ()
(MonthMatch a -> ()) -> NFData (MonthMatch a)
forall a. NFData a => MonthMatch a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => MonthMatch a -> ()
rnf :: 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 -> ()
(UnboxedMonthMatch a -> ()) -> NFData (UnboxedMonthMatch a)
forall a. UnboxedMonthMatch a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. UnboxedMonthMatch a -> ()
rnf :: 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
(Int -> Timespan -> ShowS)
-> (Timespan -> String) -> ([Timespan] -> ShowS) -> Show Timespan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timespan -> ShowS
showsPrec :: Int -> Timespan -> ShowS
$cshow :: Timespan -> String
show :: Timespan -> String
$cshowList :: [Timespan] -> ShowS
showList :: [Timespan] -> ShowS
Show, ReadPrec [Timespan]
ReadPrec Timespan
Int -> ReadS Timespan
ReadS [Timespan]
(Int -> ReadS Timespan)
-> ReadS [Timespan]
-> ReadPrec Timespan
-> ReadPrec [Timespan]
-> Read Timespan
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Timespan
readsPrec :: Int -> ReadS Timespan
$creadList :: ReadS [Timespan]
readList :: ReadS [Timespan]
$creadPrec :: ReadPrec Timespan
readPrec :: ReadPrec Timespan
$creadListPrec :: ReadPrec [Timespan]
readListPrec :: ReadPrec [Timespan]
Read, Timespan -> Timespan -> Bool
(Timespan -> Timespan -> Bool)
-> (Timespan -> Timespan -> Bool) -> Eq Timespan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timespan -> Timespan -> Bool
== :: Timespan -> Timespan -> Bool
$c/= :: Timespan -> Timespan -> Bool
/= :: Timespan -> Timespan -> Bool
Eq, Eq Timespan
Eq Timespan =>
(Timespan -> Timespan -> Ordering)
-> (Timespan -> Timespan -> Bool)
-> (Timespan -> Timespan -> Bool)
-> (Timespan -> Timespan -> Bool)
-> (Timespan -> Timespan -> Bool)
-> (Timespan -> Timespan -> Timespan)
-> (Timespan -> Timespan -> Timespan)
-> Ord 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
$ccompare :: Timespan -> Timespan -> Ordering
compare :: Timespan -> Timespan -> Ordering
$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
>= :: Timespan -> Timespan -> Bool
$cmax :: Timespan -> Timespan -> Timespan
max :: Timespan -> Timespan -> Timespan
$cmin :: Timespan -> Timespan -> Timespan
min :: Timespan -> Timespan -> Timespan
Ord, [Timespan] -> Value
[Timespan] -> Encoding
Timespan -> Bool
Timespan -> Value
Timespan -> Encoding
(Timespan -> Value)
-> (Timespan -> Encoding)
-> ([Timespan] -> Value)
-> ([Timespan] -> Encoding)
-> (Timespan -> Bool)
-> ToJSON Timespan
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Timespan -> Value
toJSON :: Timespan -> Value
$ctoEncoding :: Timespan -> Encoding
toEncoding :: Timespan -> Encoding
$ctoJSONList :: [Timespan] -> Value
toJSONList :: [Timespan] -> Value
$ctoEncodingList :: [Timespan] -> Encoding
toEncodingList :: [Timespan] -> Encoding
$comitField :: Timespan -> Bool
omitField :: Timespan -> Bool
ToJSON, Maybe Timespan
Value -> Parser [Timespan]
Value -> Parser Timespan
(Value -> Parser Timespan)
-> (Value -> Parser [Timespan])
-> Maybe Timespan
-> FromJSON Timespan
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Timespan
parseJSON :: Value -> Parser Timespan
$cparseJSONList :: Value -> Parser [Timespan]
parseJSONList :: Value -> Parser [Timespan]
$comittedField :: Maybe Timespan
omittedField :: Maybe Timespan
FromJSON, Timespan
Timespan -> Timespan
Timespan -> Timespan -> Timespan
Timespan
-> (Timespan -> Timespan)
-> (Timespan -> Timespan -> Timespan)
-> (Timespan -> Timespan -> Timespan)
-> Additive Timespan
forall v.
v -> (v -> v) -> (v -> v -> v) -> (v -> v -> v) -> Additive v
$czero :: Timespan
zero :: Timespan
$cinvert :: Timespan -> Timespan
invert :: Timespan -> Timespan
$cplus :: Timespan -> Timespan -> Timespan
plus :: Timespan -> Timespan -> Timespan
$cminus :: Timespan -> Timespan -> Timespan
minus :: Timespan -> Timespan -> Timespan
Additive, Timespan -> ()
(Timespan -> ()) -> NFData Timespan
forall a. (a -> ()) -> NFData a
$crnf :: Timespan -> ()
rnf :: 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 = (Int64 -> Timespan) -> f Int64 -> f Timespan
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Timespan
Timespan (f Int64 -> f Timespan)
-> (Timespan -> f Int64) -> Timespan -> f Timespan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> f Int64
f (Int64 -> f Int64) -> (Timespan -> Int64) -> Timespan -> f Int64
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 Int64 -> Int64 -> Int64
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 = Timespan -> Timespan -> Timespan
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 Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
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 Int64 -> Int64 -> Int64
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
  difference :: Offset -> Offset -> Int
difference (Offset Int
x) (Offset Int
y) = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y

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

instance NFData SubsecondPrecision where
  rnf :: SubsecondPrecision -> ()
rnf (SubsecondPrecision
SubsecondPrecisionAuto) = ()
  rnf (SubsecondPrecisionFixed Int
a) = Int
a Int -> () -> ()
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
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Date -> ShowS
showsPrec :: Int -> Date -> ShowS
$cshow :: Date -> String
show :: Date -> String
$cshowList :: [Date] -> ShowS
showList :: [Date] -> ShowS
Show, ReadPrec [Date]
ReadPrec Date
Int -> ReadS Date
ReadS [Date]
(Int -> ReadS Date)
-> ReadS [Date] -> ReadPrec Date -> ReadPrec [Date] -> Read Date
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Date
readsPrec :: Int -> ReadS Date
$creadList :: ReadS [Date]
readList :: ReadS [Date]
$creadPrec :: ReadPrec Date
readPrec :: ReadPrec Date
$creadListPrec :: ReadPrec [Date]
readListPrec :: ReadPrec [Date]
Read, Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
/= :: Date -> Date -> Bool
Eq, Eq Date
Eq Date =>
(Date -> Date -> Ordering)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Date)
-> (Date -> Date -> Date)
-> Ord 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
$ccompare :: Date -> Date -> Ordering
compare :: Date -> Date -> Ordering
$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
>= :: Date -> Date -> Bool
$cmax :: Date -> Date -> Date
max :: Date -> Date -> Date
$cmin :: Date -> Date -> Date
min :: Date -> Date -> Date
Ord)

instance NFData Date where
  rnf :: Date -> ()
rnf (Date Year
y Month
m DayOfMonth
d) = Year
y Year -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Month
m Month -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` DayOfMonth
d DayOfMonth -> () -> ()
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 = (Year -> Date) -> f Year -> f Date
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Year
y -> Date
date {dateYear = y}) (f Year -> f Date) -> (Date -> f Year) -> Date -> f Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> f Year
f (Year -> f Year) -> (Date -> Year) -> Date -> f Year
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Year
dateYear (Date -> f Date) -> Date -> f Date
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 = (Month -> Date) -> f Month -> f Date
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Month
m -> Date
date {dateMonth = m}) (f Month -> f Date) -> (Date -> f Month) -> Date -> f Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month -> f Month
f (Month -> f Month) -> (Date -> Month) -> Date -> f Month
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Month
dateMonth (Date -> f Date) -> Date -> f Date
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 = (DayOfMonth -> Date) -> f DayOfMonth -> f Date
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DayOfMonth
d -> Date
date {dateDay = d}) (f DayOfMonth -> f Date)
-> (Date -> f DayOfMonth) -> Date -> f Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfMonth -> f DayOfMonth
f (DayOfMonth -> f DayOfMonth)
-> (Date -> DayOfMonth) -> Date -> f DayOfMonth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> DayOfMonth
dateDay (Date -> f Date) -> Date -> f Date
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
(Int -> OrdinalDate -> ShowS)
-> (OrdinalDate -> String)
-> ([OrdinalDate] -> ShowS)
-> Show OrdinalDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrdinalDate -> ShowS
showsPrec :: Int -> OrdinalDate -> ShowS
$cshow :: OrdinalDate -> String
show :: OrdinalDate -> String
$cshowList :: [OrdinalDate] -> ShowS
showList :: [OrdinalDate] -> ShowS
Show, ReadPrec [OrdinalDate]
ReadPrec OrdinalDate
Int -> ReadS OrdinalDate
ReadS [OrdinalDate]
(Int -> ReadS OrdinalDate)
-> ReadS [OrdinalDate]
-> ReadPrec OrdinalDate
-> ReadPrec [OrdinalDate]
-> Read OrdinalDate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OrdinalDate
readsPrec :: Int -> ReadS OrdinalDate
$creadList :: ReadS [OrdinalDate]
readList :: ReadS [OrdinalDate]
$creadPrec :: ReadPrec OrdinalDate
readPrec :: ReadPrec OrdinalDate
$creadListPrec :: ReadPrec [OrdinalDate]
readListPrec :: ReadPrec [OrdinalDate]
Read, OrdinalDate -> OrdinalDate -> Bool
(OrdinalDate -> OrdinalDate -> Bool)
-> (OrdinalDate -> OrdinalDate -> Bool) -> Eq OrdinalDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrdinalDate -> OrdinalDate -> Bool
== :: OrdinalDate -> OrdinalDate -> Bool
$c/= :: OrdinalDate -> OrdinalDate -> Bool
/= :: OrdinalDate -> OrdinalDate -> Bool
Eq, Eq OrdinalDate
Eq OrdinalDate =>
(OrdinalDate -> OrdinalDate -> Ordering)
-> (OrdinalDate -> OrdinalDate -> Bool)
-> (OrdinalDate -> OrdinalDate -> Bool)
-> (OrdinalDate -> OrdinalDate -> Bool)
-> (OrdinalDate -> OrdinalDate -> Bool)
-> (OrdinalDate -> OrdinalDate -> OrdinalDate)
-> (OrdinalDate -> OrdinalDate -> OrdinalDate)
-> Ord 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
$ccompare :: OrdinalDate -> OrdinalDate -> Ordering
compare :: OrdinalDate -> OrdinalDate -> Ordering
$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
>= :: OrdinalDate -> OrdinalDate -> Bool
$cmax :: OrdinalDate -> OrdinalDate -> OrdinalDate
max :: OrdinalDate -> OrdinalDate -> OrdinalDate
$cmin :: OrdinalDate -> OrdinalDate -> OrdinalDate
min :: OrdinalDate -> OrdinalDate -> OrdinalDate
Ord)

instance NFData OrdinalDate where
  rnf :: OrdinalDate -> ()
rnf (OrdinalDate Year
y DayOfYear
d) = Year
y Year -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` DayOfYear
d DayOfYear -> () -> ()
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 = (Year -> OrdinalDate) -> f Year -> f OrdinalDate
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Year
y -> OrdinalDate
date {ordinalDateYear = y}) (f Year -> f OrdinalDate)
-> (OrdinalDate -> f Year) -> OrdinalDate -> f OrdinalDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> f Year
f (Year -> f Year) -> (OrdinalDate -> Year) -> OrdinalDate -> f Year
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdinalDate -> Year
ordinalDateYear (OrdinalDate -> f OrdinalDate) -> OrdinalDate -> f OrdinalDate
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 =
  (DayOfYear -> OrdinalDate) -> f DayOfYear -> f OrdinalDate
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DayOfYear
d -> OrdinalDate
date {ordinalDateDayOfYear = d}) (f DayOfYear -> f OrdinalDate)
-> (OrdinalDate -> f DayOfYear) -> OrdinalDate -> f OrdinalDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfYear -> f DayOfYear
f (DayOfYear -> f DayOfYear)
-> (OrdinalDate -> DayOfYear) -> OrdinalDate -> f DayOfYear
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdinalDate -> DayOfYear
ordinalDateDayOfYear (OrdinalDate -> f OrdinalDate) -> OrdinalDate -> f OrdinalDate
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
(Int -> MonthDate -> ShowS)
-> (MonthDate -> String)
-> ([MonthDate] -> ShowS)
-> Show MonthDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonthDate -> ShowS
showsPrec :: Int -> MonthDate -> ShowS
$cshow :: MonthDate -> String
show :: MonthDate -> String
$cshowList :: [MonthDate] -> ShowS
showList :: [MonthDate] -> ShowS
Show, ReadPrec [MonthDate]
ReadPrec MonthDate
Int -> ReadS MonthDate
ReadS [MonthDate]
(Int -> ReadS MonthDate)
-> ReadS [MonthDate]
-> ReadPrec MonthDate
-> ReadPrec [MonthDate]
-> Read MonthDate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MonthDate
readsPrec :: Int -> ReadS MonthDate
$creadList :: ReadS [MonthDate]
readList :: ReadS [MonthDate]
$creadPrec :: ReadPrec MonthDate
readPrec :: ReadPrec MonthDate
$creadListPrec :: ReadPrec [MonthDate]
readListPrec :: ReadPrec [MonthDate]
Read, MonthDate -> MonthDate -> Bool
(MonthDate -> MonthDate -> Bool)
-> (MonthDate -> MonthDate -> Bool) -> Eq MonthDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonthDate -> MonthDate -> Bool
== :: MonthDate -> MonthDate -> Bool
$c/= :: MonthDate -> MonthDate -> Bool
/= :: MonthDate -> MonthDate -> Bool
Eq, Eq MonthDate
Eq MonthDate =>
(MonthDate -> MonthDate -> Ordering)
-> (MonthDate -> MonthDate -> Bool)
-> (MonthDate -> MonthDate -> Bool)
-> (MonthDate -> MonthDate -> Bool)
-> (MonthDate -> MonthDate -> Bool)
-> (MonthDate -> MonthDate -> MonthDate)
-> (MonthDate -> MonthDate -> MonthDate)
-> Ord 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
$ccompare :: MonthDate -> MonthDate -> Ordering
compare :: MonthDate -> MonthDate -> Ordering
$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
>= :: MonthDate -> MonthDate -> Bool
$cmax :: MonthDate -> MonthDate -> MonthDate
max :: MonthDate -> MonthDate -> MonthDate
$cmin :: MonthDate -> MonthDate -> MonthDate
min :: MonthDate -> MonthDate -> MonthDate
Ord)

instance NFData MonthDate where
  rnf :: MonthDate -> ()
rnf (MonthDate Month
m DayOfMonth
d) = Month
m Month -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` DayOfMonth
d DayOfMonth -> () -> ()
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 = (Month -> MonthDate) -> f Month -> f MonthDate
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Month
m -> MonthDate
date {monthDateMonth = m}) (f Month -> f MonthDate)
-> (MonthDate -> f Month) -> MonthDate -> f MonthDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month -> f Month
f (Month -> f Month) -> (MonthDate -> Month) -> MonthDate -> f Month
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthDate -> Month
monthDateMonth (MonthDate -> f MonthDate) -> MonthDate -> f MonthDate
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 = (DayOfMonth -> MonthDate) -> f DayOfMonth -> f MonthDate
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DayOfMonth
d -> MonthDate
date {monthDateDay = d}) (f DayOfMonth -> f MonthDate)
-> (MonthDate -> f DayOfMonth) -> MonthDate -> f MonthDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfMonth -> f DayOfMonth
f (DayOfMonth -> f DayOfMonth)
-> (MonthDate -> DayOfMonth) -> MonthDate -> f DayOfMonth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthDate -> DayOfMonth
monthDateDay (MonthDate -> f MonthDate) -> MonthDate -> f MonthDate
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
(Int -> Datetime -> ShowS)
-> (Datetime -> String) -> ([Datetime] -> ShowS) -> Show Datetime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Datetime -> ShowS
showsPrec :: Int -> Datetime -> ShowS
$cshow :: Datetime -> String
show :: Datetime -> String
$cshowList :: [Datetime] -> ShowS
showList :: [Datetime] -> ShowS
Show, ReadPrec [Datetime]
ReadPrec Datetime
Int -> ReadS Datetime
ReadS [Datetime]
(Int -> ReadS Datetime)
-> ReadS [Datetime]
-> ReadPrec Datetime
-> ReadPrec [Datetime]
-> Read Datetime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Datetime
readsPrec :: Int -> ReadS Datetime
$creadList :: ReadS [Datetime]
readList :: ReadS [Datetime]
$creadPrec :: ReadPrec Datetime
readPrec :: ReadPrec Datetime
$creadListPrec :: ReadPrec [Datetime]
readListPrec :: ReadPrec [Datetime]
Read, Datetime -> Datetime -> Bool
(Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Bool) -> Eq Datetime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Datetime -> Datetime -> Bool
== :: Datetime -> Datetime -> Bool
$c/= :: Datetime -> Datetime -> Bool
/= :: Datetime -> Datetime -> Bool
Eq, Eq Datetime
Eq Datetime =>
(Datetime -> Datetime -> Ordering)
-> (Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Bool)
-> (Datetime -> Datetime -> Datetime)
-> (Datetime -> Datetime -> Datetime)
-> Ord 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
$ccompare :: Datetime -> Datetime -> Ordering
compare :: Datetime -> Datetime -> Ordering
$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
>= :: Datetime -> Datetime -> Bool
$cmax :: Datetime -> Datetime -> Datetime
max :: Datetime -> Datetime -> Datetime
$cmin :: Datetime -> Datetime -> Datetime
min :: Datetime -> Datetime -> Datetime
Ord)

instance NFData Datetime where
  rnf :: Datetime -> ()
rnf (Datetime Date
d TimeOfDay
t) = Date
d Date -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` TimeOfDay
t TimeOfDay -> () -> ()
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 = (Date -> Datetime) -> f Date -> f Datetime
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Date
y -> Datetime
date {datetimeDate = y}) (f Date -> f Datetime)
-> (Datetime -> f Date) -> Datetime -> f Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> f Date
f (Date -> f Date) -> (Datetime -> Date) -> Datetime -> f Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> Date
datetimeDate (Datetime -> f Datetime) -> Datetime -> f Datetime
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 = (TimeOfDay -> Datetime) -> f TimeOfDay -> f Datetime
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TimeOfDay
t -> Datetime
date {datetimeTime = t}) (f TimeOfDay -> f Datetime)
-> (Datetime -> f TimeOfDay) -> Datetime -> f Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> f TimeOfDay
f (TimeOfDay -> f TimeOfDay)
-> (Datetime -> TimeOfDay) -> Datetime -> f TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> TimeOfDay
datetimeTime (Datetime -> f Datetime) -> Datetime -> f Datetime
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
(Int -> OffsetDatetime -> ShowS)
-> (OffsetDatetime -> String)
-> ([OffsetDatetime] -> ShowS)
-> Show OffsetDatetime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OffsetDatetime -> ShowS
showsPrec :: Int -> OffsetDatetime -> ShowS
$cshow :: OffsetDatetime -> String
show :: OffsetDatetime -> String
$cshowList :: [OffsetDatetime] -> ShowS
showList :: [OffsetDatetime] -> ShowS
Show, ReadPrec [OffsetDatetime]
ReadPrec OffsetDatetime
Int -> ReadS OffsetDatetime
ReadS [OffsetDatetime]
(Int -> ReadS OffsetDatetime)
-> ReadS [OffsetDatetime]
-> ReadPrec OffsetDatetime
-> ReadPrec [OffsetDatetime]
-> Read OffsetDatetime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OffsetDatetime
readsPrec :: Int -> ReadS OffsetDatetime
$creadList :: ReadS [OffsetDatetime]
readList :: ReadS [OffsetDatetime]
$creadPrec :: ReadPrec OffsetDatetime
readPrec :: ReadPrec OffsetDatetime
$creadListPrec :: ReadPrec [OffsetDatetime]
readListPrec :: ReadPrec [OffsetDatetime]
Read, OffsetDatetime -> OffsetDatetime -> Bool
(OffsetDatetime -> OffsetDatetime -> Bool)
-> (OffsetDatetime -> OffsetDatetime -> Bool) -> Eq OffsetDatetime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OffsetDatetime -> OffsetDatetime -> Bool
== :: OffsetDatetime -> OffsetDatetime -> Bool
$c/= :: OffsetDatetime -> OffsetDatetime -> Bool
/= :: OffsetDatetime -> OffsetDatetime -> Bool
Eq, Eq OffsetDatetime
Eq OffsetDatetime =>
(OffsetDatetime -> OffsetDatetime -> Ordering)
-> (OffsetDatetime -> OffsetDatetime -> Bool)
-> (OffsetDatetime -> OffsetDatetime -> Bool)
-> (OffsetDatetime -> OffsetDatetime -> Bool)
-> (OffsetDatetime -> OffsetDatetime -> Bool)
-> (OffsetDatetime -> OffsetDatetime -> OffsetDatetime)
-> (OffsetDatetime -> OffsetDatetime -> OffsetDatetime)
-> Ord 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
$ccompare :: OffsetDatetime -> OffsetDatetime -> Ordering
compare :: OffsetDatetime -> OffsetDatetime -> Ordering
$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
>= :: OffsetDatetime -> OffsetDatetime -> Bool
$cmax :: OffsetDatetime -> OffsetDatetime -> OffsetDatetime
max :: OffsetDatetime -> OffsetDatetime -> OffsetDatetime
$cmin :: OffsetDatetime -> OffsetDatetime -> OffsetDatetime
min :: OffsetDatetime -> OffsetDatetime -> OffsetDatetime
Ord)

instance NFData OffsetDatetime where
  rnf :: OffsetDatetime -> ()
rnf (OffsetDatetime Datetime
dt Offset
o) = Datetime
dt Datetime -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Offset
o Offset -> () -> ()
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 =
  (Datetime -> OffsetDatetime) -> f Datetime -> f OffsetDatetime
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Datetime
d -> OffsetDatetime
date {offsetDatetimeDatetime = d}) (f Datetime -> f OffsetDatetime)
-> (OffsetDatetime -> f Datetime)
-> OffsetDatetime
-> f OffsetDatetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datetime -> f Datetime
f (Datetime -> f Datetime)
-> (OffsetDatetime -> Datetime) -> OffsetDatetime -> f Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetDatetime -> Datetime
offsetDatetimeDatetime (OffsetDatetime -> f OffsetDatetime)
-> OffsetDatetime -> f OffsetDatetime
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 =
  (Offset -> OffsetDatetime) -> f Offset -> f OffsetDatetime
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Offset
y -> OffsetDatetime
date {offsetDatetimeOffset = y}) (f Offset -> f OffsetDatetime)
-> (OffsetDatetime -> f Offset)
-> OffsetDatetime
-> f OffsetDatetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offset -> f Offset
f (Offset -> f Offset)
-> (OffsetDatetime -> Offset) -> OffsetDatetime -> f Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetDatetime -> Offset
offsetDatetimeOffset (OffsetDatetime -> f OffsetDatetime)
-> OffsetDatetime -> f OffsetDatetime
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
(Int -> TimeOfDay -> ShowS)
-> (TimeOfDay -> String)
-> ([TimeOfDay] -> ShowS)
-> Show TimeOfDay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeOfDay -> ShowS
showsPrec :: Int -> TimeOfDay -> ShowS
$cshow :: TimeOfDay -> String
show :: TimeOfDay -> String
$cshowList :: [TimeOfDay] -> ShowS
showList :: [TimeOfDay] -> ShowS
Show, ReadPrec [TimeOfDay]
ReadPrec TimeOfDay
Int -> ReadS TimeOfDay
ReadS [TimeOfDay]
(Int -> ReadS TimeOfDay)
-> ReadS [TimeOfDay]
-> ReadPrec TimeOfDay
-> ReadPrec [TimeOfDay]
-> Read TimeOfDay
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TimeOfDay
readsPrec :: Int -> ReadS TimeOfDay
$creadList :: ReadS [TimeOfDay]
readList :: ReadS [TimeOfDay]
$creadPrec :: ReadPrec TimeOfDay
readPrec :: ReadPrec TimeOfDay
$creadListPrec :: ReadPrec [TimeOfDay]
readListPrec :: ReadPrec [TimeOfDay]
Read, TimeOfDay -> TimeOfDay -> Bool
(TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> Bool) -> Eq TimeOfDay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeOfDay -> TimeOfDay -> Bool
== :: TimeOfDay -> TimeOfDay -> Bool
$c/= :: TimeOfDay -> TimeOfDay -> Bool
/= :: TimeOfDay -> TimeOfDay -> Bool
Eq, Eq TimeOfDay
Eq TimeOfDay =>
(TimeOfDay -> TimeOfDay -> Ordering)
-> (TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> TimeOfDay)
-> (TimeOfDay -> TimeOfDay -> TimeOfDay)
-> Ord 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
$ccompare :: TimeOfDay -> TimeOfDay -> Ordering
compare :: TimeOfDay -> TimeOfDay -> Ordering
$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
>= :: TimeOfDay -> TimeOfDay -> Bool
$cmax :: TimeOfDay -> TimeOfDay -> TimeOfDay
max :: TimeOfDay -> TimeOfDay -> TimeOfDay
$cmin :: TimeOfDay -> TimeOfDay -> TimeOfDay
min :: TimeOfDay -> TimeOfDay -> TimeOfDay
Ord)

instance NFData TimeOfDay where
  rnf :: TimeOfDay -> ()
rnf (TimeOfDay Int
h Int
m Int64
s) = Int
h Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int
m Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int64
s Int64 -> () -> ()
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 =
  (Int -> TimeOfDay) -> f Int -> f TimeOfDay
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
h -> TimeOfDay
time {timeOfDayHour = h}) (f Int -> f TimeOfDay)
-> (TimeOfDay -> f Int) -> TimeOfDay -> f TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (TimeOfDay -> Int) -> TimeOfDay -> f Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Int
timeOfDayHour (TimeOfDay -> f TimeOfDay) -> TimeOfDay -> f TimeOfDay
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 =
  (Int -> TimeOfDay) -> f Int -> f TimeOfDay
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
m -> TimeOfDay
time {timeOfDayMinute = m}) (f Int -> f TimeOfDay)
-> (TimeOfDay -> f Int) -> TimeOfDay -> f TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f Int
f (Int -> f Int) -> (TimeOfDay -> Int) -> TimeOfDay -> f Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Int
timeOfDayMinute (TimeOfDay -> f TimeOfDay) -> TimeOfDay -> f TimeOfDay
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 =
  (Int64 -> TimeOfDay) -> f Int64 -> f TimeOfDay
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int64
n -> TimeOfDay
time {timeOfDayNanoseconds = n}) (f Int64 -> f TimeOfDay)
-> (TimeOfDay -> f Int64) -> TimeOfDay -> f TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> f Int64
f (Int64 -> f Int64) -> (TimeOfDay -> Int64) -> TimeOfDay -> f Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Int64
timeOfDayNanoseconds (TimeOfDay -> f TimeOfDay) -> TimeOfDay -> f TimeOfDay
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
(Int -> DatetimeFormat -> ShowS)
-> (DatetimeFormat -> String)
-> ([DatetimeFormat] -> ShowS)
-> Show DatetimeFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatetimeFormat -> ShowS
showsPrec :: Int -> DatetimeFormat -> ShowS
$cshow :: DatetimeFormat -> String
show :: DatetimeFormat -> String
$cshowList :: [DatetimeFormat] -> ShowS
showList :: [DatetimeFormat] -> ShowS
Show, ReadPrec [DatetimeFormat]
ReadPrec DatetimeFormat
Int -> ReadS DatetimeFormat
ReadS [DatetimeFormat]
(Int -> ReadS DatetimeFormat)
-> ReadS [DatetimeFormat]
-> ReadPrec DatetimeFormat
-> ReadPrec [DatetimeFormat]
-> Read DatetimeFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DatetimeFormat
readsPrec :: Int -> ReadS DatetimeFormat
$creadList :: ReadS [DatetimeFormat]
readList :: ReadS [DatetimeFormat]
$creadPrec :: ReadPrec DatetimeFormat
readPrec :: ReadPrec DatetimeFormat
$creadListPrec :: ReadPrec [DatetimeFormat]
readListPrec :: ReadPrec [DatetimeFormat]
Read, DatetimeFormat -> DatetimeFormat -> Bool
(DatetimeFormat -> DatetimeFormat -> Bool)
-> (DatetimeFormat -> DatetimeFormat -> Bool) -> Eq DatetimeFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatetimeFormat -> DatetimeFormat -> Bool
== :: DatetimeFormat -> DatetimeFormat -> Bool
$c/= :: DatetimeFormat -> DatetimeFormat -> Bool
/= :: DatetimeFormat -> DatetimeFormat -> Bool
Eq, Eq DatetimeFormat
Eq DatetimeFormat =>
(DatetimeFormat -> DatetimeFormat -> Ordering)
-> (DatetimeFormat -> DatetimeFormat -> Bool)
-> (DatetimeFormat -> DatetimeFormat -> Bool)
-> (DatetimeFormat -> DatetimeFormat -> Bool)
-> (DatetimeFormat -> DatetimeFormat -> Bool)
-> (DatetimeFormat -> DatetimeFormat -> DatetimeFormat)
-> (DatetimeFormat -> DatetimeFormat -> DatetimeFormat)
-> Ord 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
$ccompare :: DatetimeFormat -> DatetimeFormat -> Ordering
compare :: DatetimeFormat -> DatetimeFormat -> Ordering
$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
>= :: DatetimeFormat -> DatetimeFormat -> Bool
$cmax :: DatetimeFormat -> DatetimeFormat -> DatetimeFormat
max :: DatetimeFormat -> DatetimeFormat -> DatetimeFormat
$cmin :: DatetimeFormat -> DatetimeFormat -> DatetimeFormat
min :: DatetimeFormat -> DatetimeFormat -> DatetimeFormat
Ord)

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

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

instance NFData TimeInterval where
  rnf :: TimeInterval -> ()
rnf (TimeInterval Time
t1 Time
t2) = Time
t1 Time -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Time
t2 Time -> () -> ()
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)
Int -> ReadS (MeridiemLocale a)
ReadS [MeridiemLocale a]
(Int -> ReadS (MeridiemLocale a))
-> ReadS [MeridiemLocale a]
-> ReadPrec (MeridiemLocale a)
-> ReadPrec [MeridiemLocale a]
-> Read (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
$creadsPrec :: forall a. Read a => Int -> ReadS (MeridiemLocale a)
readsPrec :: Int -> ReadS (MeridiemLocale a)
$creadList :: forall a. Read a => ReadS [MeridiemLocale a]
readList :: ReadS [MeridiemLocale a]
$creadPrec :: forall a. Read a => ReadPrec (MeridiemLocale a)
readPrec :: ReadPrec (MeridiemLocale a)
$creadListPrec :: forall a. Read a => ReadPrec [MeridiemLocale a]
readListPrec :: ReadPrec [MeridiemLocale a]
Read, Int -> MeridiemLocale a -> ShowS
[MeridiemLocale a] -> ShowS
MeridiemLocale a -> String
(Int -> MeridiemLocale a -> ShowS)
-> (MeridiemLocale a -> String)
-> ([MeridiemLocale a] -> ShowS)
-> Show (MeridiemLocale a)
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
$cshowsPrec :: forall a. Show a => Int -> MeridiemLocale a -> ShowS
showsPrec :: Int -> MeridiemLocale a -> ShowS
$cshow :: forall a. Show a => MeridiemLocale a -> String
show :: MeridiemLocale a -> String
$cshowList :: forall a. Show a => [MeridiemLocale a] -> ShowS
showList :: [MeridiemLocale a] -> ShowS
Show, MeridiemLocale a -> MeridiemLocale a -> Bool
(MeridiemLocale a -> MeridiemLocale a -> Bool)
-> (MeridiemLocale a -> MeridiemLocale a -> Bool)
-> Eq (MeridiemLocale a)
forall a. Eq a => MeridiemLocale a -> MeridiemLocale a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: MeridiemLocale a -> MeridiemLocale a -> Bool
Eq, Eq (MeridiemLocale a)
Eq (MeridiemLocale a) =>
(MeridiemLocale a -> MeridiemLocale a -> Ordering)
-> (MeridiemLocale a -> MeridiemLocale a -> Bool)
-> (MeridiemLocale a -> MeridiemLocale a -> Bool)
-> (MeridiemLocale a -> MeridiemLocale a -> Bool)
-> (MeridiemLocale a -> MeridiemLocale a -> Bool)
-> (MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a)
-> (MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a)
-> Ord (MeridiemLocale a)
MeridiemLocale a -> MeridiemLocale a -> Bool
MeridiemLocale a -> MeridiemLocale a -> Ordering
MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
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
$ccompare :: forall a. Ord a => MeridiemLocale a -> MeridiemLocale a -> Ordering
compare :: MeridiemLocale a -> MeridiemLocale a -> Ordering
$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
>= :: MeridiemLocale a -> MeridiemLocale a -> Bool
$cmax :: forall a.
Ord a =>
MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
max :: MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
$cmin :: forall a.
Ord a =>
MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
min :: MeridiemLocale a -> MeridiemLocale a -> MeridiemLocale a
Ord)

instance (NFData a) => NFData (MeridiemLocale a) where
  rnf :: MeridiemLocale a -> ()
rnf (MeridiemLocale a
am a
pm) = a
am a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` a
pm a -> () -> ()
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) = MVector s Month -> Int
forall s. MVector s Month -> Int
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) = MVector s Month -> MVector s Month
forall s. MVector s Month -> MVector s Month
MV_Month (MVector s Month -> MVector s Month)
-> MVector s Month -> MVector s Month
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s Month -> MVector s Month
forall s. Int -> Int -> MVector s Month -> MVector s Month
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) = MVector s Month -> MVector s Month -> Bool
forall s. MVector s Month -> MVector s Month -> Bool
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 s. Int -> ST s (MVector s Month)
basicUnsafeNew Int
n = MVector s Month -> MVector s Month
forall s. MVector s Month -> MVector s Month
MV_Month (MVector s Month -> MVector s Month)
-> ST s (MVector s Month) -> ST s (MVector s Month)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> ST s (MVector s Month)
forall s. Int -> ST s (MVector s Month)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
MGVector.basicUnsafeNew Int
n
  basicInitialize :: forall s. MVector s Month -> ST s ()
basicInitialize (MV_Month MVector s Month
v) = MVector s Month -> ST s ()
forall s. MVector s Month -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
MGVector.basicInitialize MVector s Month
v
  basicUnsafeReplicate :: forall s. Int -> Month -> ST s (MVector s Month)
basicUnsafeReplicate Int
n Month
x = MVector s Month -> MVector s Month
forall s. MVector s Month -> MVector s Month
MV_Month (MVector s Month -> MVector s Month)
-> ST s (MVector s Month) -> ST s (MVector s Month)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> Month -> ST s (MVector s Month)
forall s. Int -> Month -> ST s (MVector s Month)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
MGVector.basicUnsafeReplicate Int
n Month
x
  basicUnsafeRead :: forall s. MVector s Month -> Int -> ST s Month
basicUnsafeRead (MV_Month MVector s Month
v) Int
i = MVector s Month -> Int -> ST s Month
forall s. MVector s Month -> Int -> ST s Month
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
MGVector.basicUnsafeRead MVector s Month
v Int
i
  basicUnsafeWrite :: forall s. MVector s Month -> Int -> Month -> ST s ()
basicUnsafeWrite (MV_Month MVector s Month
v) Int
i Month
x = MVector s Month -> Int -> Month -> ST s ()
forall s. MVector s Month -> Int -> Month -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
MGVector.basicUnsafeWrite MVector s Month
v Int
i Month
x
  basicClear :: forall s. MVector s Month -> ST s ()
basicClear (MV_Month MVector s Month
v) = MVector s Month -> ST s ()
forall s. MVector s Month -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
MGVector.basicClear MVector s Month
v
  basicSet :: forall s. MVector s Month -> Month -> ST s ()
basicSet (MV_Month MVector s Month
v) Month
x = MVector s Month -> Month -> ST s ()
forall s. MVector s Month -> Month -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
MGVector.basicSet MVector s Month
v Month
x
  basicUnsafeCopy :: forall s. MVector s Month -> MVector s Month -> ST s ()
basicUnsafeCopy (MV_Month MVector s Month
v1) (MV_Month MVector s Month
v2) = MVector s Month -> MVector s Month -> ST s ()
forall s. MVector s Month -> MVector s Month -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
MGVector.basicUnsafeCopy MVector s Month
v1 MVector s Month
v2
  basicUnsafeMove :: forall s. MVector s Month -> MVector s Month -> ST s ()
basicUnsafeMove (MV_Month MVector s Month
v1) (MV_Month MVector s Month
v2) = MVector s Month -> MVector s Month -> ST s ()
forall s. MVector s Month -> MVector s Month -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
MGVector.basicUnsafeMove MVector s Month
v1 MVector s Month
v2
  basicUnsafeGrow :: forall s. MVector s Month -> Int -> ST s (MVector s Month)
basicUnsafeGrow (MV_Month MVector s Month
v) Int
n = MVector s Month -> MVector s Month
forall s. MVector s Month -> MVector s Month
MV_Month (MVector s Month -> MVector s Month)
-> ST s (MVector s Month) -> ST s (MVector s Month)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector s Month -> Int -> ST s (MVector s Month)
forall s. MVector s Month -> Int -> ST s (MVector s Month)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
MGVector.basicUnsafeGrow MVector s 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 s. Mutable Vector s Month -> ST s (Vector Month)
basicUnsafeFreeze (MV_Month MVector s Month
v) = Vector Month -> Vector Month
V_Month (Vector Month -> Vector Month)
-> ST s (Vector Month) -> ST s (Vector Month)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector s Month -> ST s (Vector Month)
forall s. Mutable Vector s Month -> ST s (Vector Month)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
GVector.basicUnsafeFreeze Mutable Vector s Month
MVector s Month
v
  basicUnsafeThaw :: forall s. Vector Month -> ST s (Mutable Vector s Month)
basicUnsafeThaw (V_Month Vector Month
v) = MVector s Month -> MVector s Month
forall s. MVector s Month -> MVector s Month
MV_Month (MVector s Month -> MVector s Month)
-> ST s (MVector s Month) -> ST s (MVector s Month)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector Month -> ST s (Mutable Vector s Month)
forall s. Vector Month -> ST s (Mutable Vector s Month)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
GVector.basicUnsafeThaw Vector Month
v
  basicLength :: Vector Month -> Int
basicLength (V_Month Vector Month
v) = Vector Month -> Int
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 (Vector Month -> Vector Month) -> Vector Month -> Vector Month
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Month -> Vector Month
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i Int
n Vector Month
v
  basicUnsafeIndexM :: Vector Month -> Int -> Box Month
basicUnsafeIndexM (V_Month Vector Month
v) Int
i = Vector Month -> Int -> Box Month
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
GVector.basicUnsafeIndexM Vector Month
v Int
i
  basicUnsafeCopy :: forall s. Mutable Vector s Month -> Vector Month -> ST s ()
basicUnsafeCopy (MV_Month MVector s Month
mv) (V_Month Vector Month
v) = Mutable Vector s Month -> Vector Month -> ST s ()
forall s. Mutable Vector s Month -> Vector Month -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
GVector.basicUnsafeCopy Mutable Vector s Month
MVector s Month
mv Vector Month
v
  elemseq :: forall b. Vector Month -> Month -> b -> b
elemseq Vector Month
_ = Month -> b -> b
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) = MVector s DayOfMonth -> Int
forall s. MVector s DayOfMonth -> Int
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) = MVector s DayOfMonth -> MVector s DayOfMonth
forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth (MVector s DayOfMonth -> MVector s DayOfMonth)
-> MVector s DayOfMonth -> MVector s DayOfMonth
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s DayOfMonth -> MVector s DayOfMonth
forall s.
Int -> Int -> MVector s DayOfMonth -> MVector s DayOfMonth
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) = MVector s DayOfMonth -> MVector s DayOfMonth -> Bool
forall s. MVector s DayOfMonth -> MVector s DayOfMonth -> Bool
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 s. Int -> ST s (MVector s DayOfMonth)
basicUnsafeNew Int
n = MVector s DayOfMonth -> MVector s DayOfMonth
forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth (MVector s DayOfMonth -> MVector s DayOfMonth)
-> ST s (MVector s DayOfMonth) -> ST s (MVector s DayOfMonth)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> ST s (MVector s DayOfMonth)
forall s. Int -> ST s (MVector s DayOfMonth)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
MGVector.basicUnsafeNew Int
n
  basicInitialize :: forall s. MVector s DayOfMonth -> ST s ()
basicInitialize (MV_DayOfMonth MVector s DayOfMonth
v) = MVector s DayOfMonth -> ST s ()
forall s. MVector s DayOfMonth -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
MGVector.basicInitialize MVector s DayOfMonth
v
  basicUnsafeReplicate :: forall s. Int -> DayOfMonth -> ST s (MVector s DayOfMonth)
basicUnsafeReplicate Int
n DayOfMonth
x = MVector s DayOfMonth -> MVector s DayOfMonth
forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth (MVector s DayOfMonth -> MVector s DayOfMonth)
-> ST s (MVector s DayOfMonth) -> ST s (MVector s DayOfMonth)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> DayOfMonth -> ST s (MVector s DayOfMonth)
forall s. Int -> DayOfMonth -> ST s (MVector s DayOfMonth)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
MGVector.basicUnsafeReplicate Int
n DayOfMonth
x
  basicUnsafeRead :: forall s. MVector s DayOfMonth -> Int -> ST s DayOfMonth
basicUnsafeRead (MV_DayOfMonth MVector s DayOfMonth
v) Int
i = MVector s DayOfMonth -> Int -> ST s DayOfMonth
forall s. MVector s DayOfMonth -> Int -> ST s DayOfMonth
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
MGVector.basicUnsafeRead MVector s DayOfMonth
v Int
i
  basicUnsafeWrite :: forall s. MVector s DayOfMonth -> Int -> DayOfMonth -> ST s ()
basicUnsafeWrite (MV_DayOfMonth MVector s DayOfMonth
v) Int
i DayOfMonth
x = MVector s DayOfMonth -> Int -> DayOfMonth -> ST s ()
forall s. MVector s DayOfMonth -> Int -> DayOfMonth -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
MGVector.basicUnsafeWrite MVector s DayOfMonth
v Int
i DayOfMonth
x
  basicClear :: forall s. MVector s DayOfMonth -> ST s ()
basicClear (MV_DayOfMonth MVector s DayOfMonth
v) = MVector s DayOfMonth -> ST s ()
forall s. MVector s DayOfMonth -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
MGVector.basicClear MVector s DayOfMonth
v
  basicSet :: forall s. MVector s DayOfMonth -> DayOfMonth -> ST s ()
basicSet (MV_DayOfMonth MVector s DayOfMonth
v) DayOfMonth
x = MVector s DayOfMonth -> DayOfMonth -> ST s ()
forall s. MVector s DayOfMonth -> DayOfMonth -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
MGVector.basicSet MVector s DayOfMonth
v DayOfMonth
x
  basicUnsafeCopy :: forall s. MVector s DayOfMonth -> MVector s DayOfMonth -> ST s ()
basicUnsafeCopy (MV_DayOfMonth MVector s DayOfMonth
v1) (MV_DayOfMonth MVector s DayOfMonth
v2) = MVector s DayOfMonth -> MVector s DayOfMonth -> ST s ()
forall s. MVector s DayOfMonth -> MVector s DayOfMonth -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
MGVector.basicUnsafeCopy MVector s DayOfMonth
v1 MVector s DayOfMonth
v2
  basicUnsafeMove :: forall s. MVector s DayOfMonth -> MVector s DayOfMonth -> ST s ()
basicUnsafeMove (MV_DayOfMonth MVector s DayOfMonth
v1) (MV_DayOfMonth MVector s DayOfMonth
v2) = MVector s DayOfMonth -> MVector s DayOfMonth -> ST s ()
forall s. MVector s DayOfMonth -> MVector s DayOfMonth -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
MGVector.basicUnsafeMove MVector s DayOfMonth
v1 MVector s DayOfMonth
v2
  basicUnsafeGrow :: forall s.
MVector s DayOfMonth -> Int -> ST s (MVector s DayOfMonth)
basicUnsafeGrow (MV_DayOfMonth MVector s DayOfMonth
v) Int
n = MVector s DayOfMonth -> MVector s DayOfMonth
forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth (MVector s DayOfMonth -> MVector s DayOfMonth)
-> ST s (MVector s DayOfMonth) -> ST s (MVector s DayOfMonth)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector s DayOfMonth -> Int -> ST s (MVector s DayOfMonth)
forall s.
MVector s DayOfMonth -> Int -> ST s (MVector s DayOfMonth)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
MGVector.basicUnsafeGrow MVector s 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 s. Mutable Vector s DayOfMonth -> ST s (Vector DayOfMonth)
basicUnsafeFreeze (MV_DayOfMonth MVector s DayOfMonth
v) = Vector DayOfMonth -> Vector DayOfMonth
V_DayOfMonth (Vector DayOfMonth -> Vector DayOfMonth)
-> ST s (Vector DayOfMonth) -> ST s (Vector DayOfMonth)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector s DayOfMonth -> ST s (Vector DayOfMonth)
forall s. Mutable Vector s DayOfMonth -> ST s (Vector DayOfMonth)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
GVector.basicUnsafeFreeze Mutable Vector s DayOfMonth
MVector s DayOfMonth
v
  basicUnsafeThaw :: forall s. Vector DayOfMonth -> ST s (Mutable Vector s DayOfMonth)
basicUnsafeThaw (V_DayOfMonth Vector DayOfMonth
v) = MVector s DayOfMonth -> MVector s DayOfMonth
forall s. MVector s DayOfMonth -> MVector s DayOfMonth
MV_DayOfMonth (MVector s DayOfMonth -> MVector s DayOfMonth)
-> ST s (MVector s DayOfMonth) -> ST s (MVector s DayOfMonth)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector DayOfMonth -> ST s (Mutable Vector s DayOfMonth)
forall s. Vector DayOfMonth -> ST s (Mutable Vector s DayOfMonth)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
GVector.basicUnsafeThaw Vector DayOfMonth
v
  basicLength :: Vector DayOfMonth -> Int
basicLength (V_DayOfMonth Vector DayOfMonth
v) = Vector DayOfMonth -> Int
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 (Vector DayOfMonth -> Vector DayOfMonth)
-> Vector DayOfMonth -> Vector DayOfMonth
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector DayOfMonth -> Vector DayOfMonth
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i Int
n Vector DayOfMonth
v
  basicUnsafeIndexM :: Vector DayOfMonth -> Int -> Box DayOfMonth
basicUnsafeIndexM (V_DayOfMonth Vector DayOfMonth
v) Int
i = Vector DayOfMonth -> Int -> Box DayOfMonth
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
GVector.basicUnsafeIndexM Vector DayOfMonth
v Int
i
  basicUnsafeCopy :: forall s.
Mutable Vector s DayOfMonth -> Vector DayOfMonth -> ST s ()
basicUnsafeCopy (MV_DayOfMonth MVector s DayOfMonth
mv) (V_DayOfMonth Vector DayOfMonth
v) = Mutable Vector s DayOfMonth -> Vector DayOfMonth -> ST s ()
forall s.
Mutable Vector s DayOfMonth -> Vector DayOfMonth -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
GVector.basicUnsafeCopy Mutable Vector s DayOfMonth
MVector s DayOfMonth
mv Vector DayOfMonth
v
  elemseq :: forall b. Vector DayOfMonth -> DayOfMonth -> b -> b
elemseq Vector DayOfMonth
_ = DayOfMonth -> b -> b
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 (Int -> Day -> Day
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 = Day -> Day -> Int
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 (Int -> Day -> Day
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 = Day -> Day -> Int
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 = Day -> Int
forall a. Enum a => a -> Int
fromEnum (Date -> Day
dateToDay Date
d)
  toEnum :: Int -> Date
toEnum Int
i = Day -> Date
dayToDate (Int -> Day
forall a. Enum a => Int -> a
toEnum Int
i)

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

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

instance FromJSON Datetime where
  parseJSON :: Value -> Parser Datetime
parseJSON =
    String -> (Text -> Parser Datetime) -> Value -> Parser Datetime
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 =
  (String -> Parser Datetime)
-> (Datetime -> Parser Datetime)
-> Either String Datetime
-> Parser Datetime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser Datetime -> String -> Parser Datetime
forall a b. a -> b -> a
const (String -> Parser Datetime
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not parse Datetime")) Datetime -> Parser Datetime
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Datetime -> Parser Datetime)
-> (Text -> Either String Datetime) -> Text -> Parser Datetime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Datetime -> Text -> Either String Datetime
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Datetime
parser_lenient Parser Datetime -> Parser Text () -> Parser Datetime
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AT.endOfInput)

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

instance FromJSON Offset where
  parseJSON :: Value -> Parser Offset
parseJSON = String -> (Text -> Parser Offset) -> Value -> Parser Offset
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 =
    (Offset -> Key)
-> (Offset -> Encoding' Key) -> ToJSONKeyFunction Offset
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
AE.ToJSONKeyText
      (Text -> Key
keyFromText (Text -> Key) -> (Offset -> Text) -> Offset -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetFormat -> Offset -> Text
encodeOffset OffsetFormat
OffsetFormatColonOn)
      (\Offset
x -> Builder -> Encoding' Key
forall a. Builder -> Encoding' a
AEE.unsafeToEncoding (Char -> Builder
BB.char7 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
SG.<> OffsetFormat -> Offset -> Builder
builderOffsetUtf8 OffsetFormat
OffsetFormatColonOn Offset
x Builder -> Builder -> Builder
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 = (Text -> Parser Offset) -> FromJSONKeyFunction Offset
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 -> String -> Parser Offset
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not parse Offset"
  Just Offset
x -> Offset -> Parser Offset
forall a. a -> Parser a
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
(TimeParts -> TimeParts -> Bool)
-> (TimeParts -> TimeParts -> Bool) -> Eq TimeParts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeParts -> TimeParts -> Bool
== :: TimeParts -> TimeParts -> Bool
$c/= :: TimeParts -> TimeParts -> Bool
/= :: TimeParts -> TimeParts -> Bool
Eq, ReadPrec [TimeParts]
ReadPrec TimeParts
Int -> ReadS TimeParts
ReadS [TimeParts]
(Int -> ReadS TimeParts)
-> ReadS [TimeParts]
-> ReadPrec TimeParts
-> ReadPrec [TimeParts]
-> Read TimeParts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TimeParts
readsPrec :: Int -> ReadS TimeParts
$creadList :: ReadS [TimeParts]
readList :: ReadS [TimeParts]
$creadPrec :: ReadPrec TimeParts
readPrec :: ReadPrec TimeParts
$creadListPrec :: ReadPrec [TimeParts]
readListPrec :: ReadPrec [TimeParts]
Read, Int -> TimeParts -> ShowS
[TimeParts] -> ShowS
TimeParts -> String
(Int -> TimeParts -> ShowS)
-> (TimeParts -> String)
-> ([TimeParts] -> ShowS)
-> Show TimeParts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeParts -> ShowS
showsPrec :: Int -> TimeParts -> ShowS
$cshow :: TimeParts -> String
show :: TimeParts -> String
$cshowList :: [TimeParts] -> ShowS
showList :: [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 Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int
mo Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int
y Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int
h Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int
m Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int
s Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int
ss Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int
o Int -> () -> ()
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) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
divMod Int64
s Int64
100000000
   in
    TimeParts
      { timePartsDay :: Int
timePartsDay = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DayOfMonth -> Int
getDayOfMonth DayOfMonth
d)
      , timePartsMonth :: Int
timePartsMonth = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Month -> Int
getMonth Month
mo)
      , timePartsYear :: Int
timePartsYear = Int -> Int
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 = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
wholeSeconds
      , timePartsSubsecond :: Int
timePartsSubsecond = Int64 -> Int
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 s. Parser () s Datetime) -> Bytes -> Maybe Datetime
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
BVP.parseBytesMaybe
    ( do
        Datetime
d <- Char -> Parser () s Datetime
forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless Char
'T'
        Bytes
remaining <- Parser () s Bytes
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x5A -> Datetime -> Parser () s Datetime
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datetime
d
          Int
3 | CString -> Bytes -> Bool
Bytes.equalsCString (Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"+00"#) Bytes
remaining -> Datetime -> Parser () s Datetime
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datetime
d
          Int
6 | CString -> Bytes -> Bool
Bytes.equalsCString (Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
"+00:00"#) Bytes
remaining -> Datetime -> Parser () s Datetime
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datetime
d
          Int
_ -> () -> Parser () s Datetime
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 s. Parser () s Datetime) -> Bytes -> Maybe Datetime
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
BVP.parseBytesMaybe (Char -> Parser () s Datetime
forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless Char
'T' Parser () s Datetime -> Parser () s () -> Parser () s Datetime
forall a b. Parser () s a -> Parser () s b -> Parser () s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* () -> Parser () s ()
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 s. Parser () s Datetime) -> Bytes -> Maybe Datetime
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
BVP.parseBytesMaybe (Char -> Parser () s Datetime
forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless Char
' ' Parser () s Datetime -> Parser () s () -> Parser () s Datetime
forall a b. Parser () s a -> Parser () s b -> Parser () s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* () -> Parser () s ()
forall e s. e -> Parser e s ()
BVP.endOfInput ()) Bytes
b

decodeUtf8BytesIso8601 :: Bytes -> Maybe Chronos.OffsetDatetime
decodeUtf8BytesIso8601 :: Bytes -> Maybe OffsetDatetime
decodeUtf8BytesIso8601 !Bytes
b =
  (forall s. Parser () s OffsetDatetime)
-> Bytes -> Maybe OffsetDatetime
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
BVP.parseBytesMaybe (Parser () s OffsetDatetime
forall s. Parser () s OffsetDatetime
parserUtf8BytesIso8601 Parser () s OffsetDatetime
-> Parser () s () -> Parser () s OffsetDatetime
forall a b. Parser () s a -> Parser () s b -> Parser () s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* () -> Parser () s ()
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 <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
  () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'-'
  Word
month' <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
  let !month :: Word
month = Word
month' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
  Bool -> Parser () s () -> Parser () s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
month Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
12) (() -> Parser () s ()
forall e s a. e -> Parser e s a
BVP.fail ())
  () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'-'
  Word
dayWord <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
  Bool -> Parser () s () -> Parser () s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
dayWord Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
31) (() -> Parser () s ()
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 (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
year))
          (Int -> Month
Chronos.Month (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
month))
          (Int -> DayOfMonth
Chronos.DayOfMonth (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
dayWord))
  () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
sep
  Word8
hourWord <- () -> Parser () s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  Bool -> Parser () s () -> Parser () s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
hourWord Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
23) (() -> Parser () s ()
forall e s a. e -> Parser e s a
BVP.fail ())
  () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
  Word8
minuteWord <- () -> Parser () s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  Bool -> Parser () s () -> Parser () s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
minuteWord Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
59) (() -> Parser () s ()
forall e s a. e -> Parser e s a
BVP.fail ())
  () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
  Word8
sec <- () -> Parser () s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  Bool -> Parser () s () -> Parser () s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sec Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
59) (() -> Parser () s ()
forall e s a. e -> Parser e s a
BVP.fail ())
  !Word64
nanos <-
    (Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Parser () s Bool
-> (Bool -> Parser () s Word64) -> Parser () s Word64
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> do
        (Int
n, Word64
w) <- Parser () s Word64 -> Parser () s (Int, Word64)
forall e s a. Parser e s a -> Parser e s (Int, a)
BVP.measure (() -> Parser () s Word64
forall e s. e -> Parser e s Word64
Latin.decWord64 ())
        Bool -> Parser () s () -> Parser () s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (() -> Parser () s ()
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 t -> t -> t
forall a. Num a => a -> a -> a
* t
10) (t
b t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
            !ns :: Word64
ns = Word64 -> Int -> Word64
forall {t} {t}. (Eq t, Num t, Num t) => t -> t -> t
go Word64
w (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
        Word64 -> Parser () s Word64
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
ns
      Bool
False -> Word64 -> Parser () s Word64
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
  let !td :: TimeOfDay
td =
        Int -> Int -> Int64 -> TimeOfDay
Chronos.TimeOfDay
          (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
hourWord)
          (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
minuteWord)
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Int64 (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
sec Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000000000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
nanos))
  Datetime -> Parser () s Datetime
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Datetime -> Parser () s Datetime)
-> Datetime -> Parser () s Datetime
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 <- Char -> Parser () s Datetime
forall s. Char -> Parser () s Datetime
parserUtf8BytesIso8601Zoneless Char
'T'
  Int
off <-
    () -> Parser () s Char
forall e s. e -> Parser e s Char
Latin.any () Parser () s Char -> (Char -> Parser () s Int) -> Parser () s Int
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Char
'Z' -> Int -> Parser () s Int
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
      Char
'+' -> Parser () s Int
forall s. Parser () s Int
parserBytesOffset
      Char
'-' -> do
        !Int
off <- Parser () s Int
forall s. Parser () s Int
parserBytesOffset
        Int -> Parser () s Int
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int
forall a. Num a => a -> a
negate Int
off)
      Char
_ -> () -> Parser () s Int
forall e s a. e -> Parser e s a
BVP.fail ()
  OffsetDatetime -> Parser () s OffsetDatetime
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OffsetDatetime -> Parser () s OffsetDatetime)
-> OffsetDatetime -> Parser () s OffsetDatetime
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 <- () -> Parser () s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 ()
  () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
  Word8
m <- () -> Parser () s Word8
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) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Int Word8
m
  Int -> Parser () s Int
forall a. a -> Parser () s a
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) =
        Nat 45 -> Builder 45 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run
          Nat 45
forall (n :: Nat). KnownNat n => Nat n
Nat.constant
          ( Datetime -> Builder 44
boundedBuilderUtf8BytesIso8601Zoneless Datetime
dt
              Builder 44 -> Builder 1 -> Builder (44 + 1)
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) =
        Nat 44 -> Builder 44 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run
          Nat 44
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) =
        Nat 50 -> Builder 50 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run
          Nat 50
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
      Builder 44 -> Builder 6 -> Builder (44 + 6)
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) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Int64
sns Int64
1_000_000_000
   in Word -> Builder 19
Bounded.wordDec (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
        Builder 19 -> Builder 25 -> Builder (19 + 25)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Char -> Builder 1
Bounded.ascii Char
'-'
        Builder 1 -> Builder 24 -> Builder (1 + 24)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Word -> Builder 2
Bounded.wordPaddedDec2 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
mth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        Builder 2 -> Builder 22 -> Builder (2 + 22)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Char -> Builder 1
Bounded.ascii Char
'-'
        Builder 1 -> Builder 21 -> Builder (1 + 21)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Word -> Builder 2
Bounded.wordPaddedDec2 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
        Builder 2 -> Builder 19 -> Builder (2 + 19)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Char -> Builder 1
Bounded.ascii Char
'T'
        Builder 1 -> Builder 18 -> Builder (1 + 18)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Word -> Builder 2
Bounded.wordPaddedDec2 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
        Builder 2 -> Builder 16 -> Builder (2 + 16)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Char -> Builder 1
Bounded.ascii Char
':'
        Builder 1 -> Builder 15 -> Builder (1 + 15)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Word -> Builder 2
Bounded.wordPaddedDec2 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mt)
        Builder 2 -> Builder 13 -> Builder (2 + 13)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Char -> Builder 1
Bounded.ascii Char
':'
        Builder 1 -> Builder 12 -> Builder (1 + 12)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Word -> Builder 2
Bounded.wordPaddedDec2 (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s)
        Builder 2 -> Builder 10 -> Builder (2 + 10)
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 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
'.'
                                Builder 1 -> Builder 9 -> Builder (1 + 9)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Word -> Builder 9
Bounded.wordPaddedDec9 (Int64 -> Word
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 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 (Int -> Int
forall a. Num a => a -> a
abs Int
mins)
        !absHrs :: Word
absHrs = Word -> Word -> Word
forall a. Integral a => a -> a -> a
quot Word
absMins Word
60
        !absMinutes :: Word
absMinutes = Word -> Word -> Word
forall a. Integral a => a -> a -> a
rem Word
absMins Word
60
     in Char -> Builder 1
Bounded.ascii (Char -> Char -> Bool -> Char
forall a. a -> a -> Bool -> a
bool Char
'-' Char
'+' (Int
mins Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0))
          Builder 1 -> Builder 5 -> Builder (1 + 5)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Word -> Builder 2
Bounded.wordPaddedDec2 Word
absHrs
          Builder 2 -> Builder 3 -> Builder (2 + 3)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Char -> Builder 1
Bounded.ascii Char
':'
          Builder 1 -> Builder 2 -> Builder (1 + 2)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`Bounded.append` Word -> Builder 2
Bounded.wordPaddedDec2 Word
absMinutes