pact-time 0.1.0.0 → 0.2.0.0

raw patch · 19 files changed

+2156/−2153 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−1
• pact-time.cabal +9/−9
• src/Data/Time.hs +0/−57
• src/Data/Time/Format.hs +0/−24
• src/Data/Time/Format/External.hs +0/−149
• src/Data/Time/Format/Internal.hs +0/−1240
• src/Data/Time/Format/Locale.hs +0/−97
• src/Data/Time/Internal.hs +0/−316
• src/Data/Time/System.hs +0/−37
• src/Pact/Time.hs +57/−0
• src/Pact/Time/Format.hs +24/−0
• src/Pact/Time/Format/External.hs +148/−0
• src/Pact/Time/Format/Internal.hs +1240/−0
• src/Pact/Time/Format/Locale.hs +97/−0
• src/Pact/Time/Internal.hs +316/−0
• src/Pact/Time/System.hs +37/−0
• test/Main.hs +2/−2
• test/Test/Data/Time/Format.hs +0/−221
• test/Test/Pact/Time/Format.hs +221/−0

@@ -1,5 +1,9 @@ # Revision history for pact-time +## 0.2.0.0 -- 2021-05-07++*   Move all modules from `Data.Time` to `Pact.Time`.+ ## 0.1.0.0 -- 2021-05-06 -* First version. Released on an unsuspecting world.+*   First version. Released on an unsuspecting world.

@@ -1,6 +1,6 @@ cabal-version: 2.4 name: pact-time-version: 0.1.0.0+version: 0.2.0.0 synopsis: Time Library for Pact Description:     A minimal time library for usage with the [Pact Smart Contract@@ -50,10 +50,10 @@     ghc-options:         -Wall     exposed-modules:-        Data.Time-        Data.Time.Internal-        Data.Time.Format-        Data.Time.System+        Pact.Time+        Pact.Time.Internal+        Pact.Time.Format+        Pact.Time.System     build-depends:         -- external         , Decimal >=0.4@@ -70,13 +70,13 @@    if flag(with-time)     cpp-options: -DWITH_TIME=1-    other-modules: Data.Time.Format.External+    other-modules: Pact.Time.Format.External     build-depends: time >= 1.8   else     cpp-options: -DWITH_TIME=0     other-modules:-        Data.Time.Format.Internal-        Data.Time.Format.Locale+        Pact.Time.Format.Internal+        Pact.Time.Format.Locale     build-depends:         , clock >= 0.7.2         , mtl >=2.2@@ -92,7 +92,7 @@         -with-rtsopts=-N     main-is: Main.hs     other-modules:-        Test.Data.Time.Format+        Test.Pact.Time.Format     build-depends:         pact-time 

@@ -1,57 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module: Data.Time--- Copyright: Copyright © 2021 Kadena LLC.--- License: MIT--- Maintainer: Lars Kuhtz <lars@kadena.io>--- Stability: experimental------ A minimal time library for usage with the [Pact Smart Contract--- Language](https://github.com/kadena-io/pact/).------ The focus of this library is on minimality, performance, and binary level--- stability. Time is represented as 64-bit integral value that counts nominal--- micro-seconds since the modified Julian date epoch (MJD). The implementation--- ignores leap seconds.------ While the library can parse date-time values with time zones, internally all--- date-times are represented as UTC and formatting only supports UTC. Only the--- default English language locale is supported.------ Details about supported formats can be found in the [Pact Language--- Reference](https://pact-language.readthedocs.io/en/stable/pact-reference.html#time-formats).----module Data.Time-(--- * NominalDiffTime-  NominalDiffTime(..)-, toMicroseconds-, fromMicroseconds-, toSeconds-, fromSeconds-, nominalDay---- * UTCTime-, UTCTime-, getCurrentTime-, day-, dayTime-, fromDayAndDayTime-, toPosixTimestampMicros-, fromPosixTimestampMicros-, posixEpoch-, mjdEpoch---- * Formatting and Parsing-, parseTime-, formatTime---- * Reexports-, AffineSpace(..)-, VectorSpace(..)-) where--import Data.Time.Format-import Data.Time.Internal-

@@ -1,24 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module: Data.Time.Format--- Copyright: Copyright © 2021 Kadena LLC.--- License: MIT--- Maintainer: Lars Kuhtz <lars@kadena.io>--- Stability: experimental------ TODO----module Data.Time.Format-(--- * Formatting and Parsing-  parseTime-, formatTime-) where--#if WITH_TIME-import Data.Time.Format.External-#else-import Data.Time.Format.Internal-#endif-

@@ -1,149 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- |--- Module: Data.Time.Format.External--- Copyright: Copyright © 2021 Kadena LLC.--- License: MIT--- Maintainer: Lars Kuhtz <lars@kadena.io>--- Stability: experimental------ TODO----module Data.Time.Format.External-(--- * Formatting and Parsing-  parseTime-, formatTime-) where--import Data.Aeson-import qualified "time" Data.Time as T--import Text.Read (readPrec)---- internal modules--import Data.Time.Internal---- -------------------------------------------------------------------------- ----- Internal Utils--toUtcTime :: UTCTime -> T.UTCTime-toUtcTime t = T.UTCTime (T.ModifiedJulianDay (fromIntegral d)) $ realToFrac dt / 1000000-  where-    ModifiedJulianDate (ModifiedJulianDay d) (NominalDiffTime dt)-        = toModifiedJulianDate t--fromUtcTime :: T.UTCTime -> UTCTime-fromUtcTime (T.UTCTime (T.ModifiedJulianDay d) t) = fromModifiedJulianDate-    $ ModifiedJulianDate (ModifiedJulianDay (fromIntegral d)) (NominalDiffTime $ round (t * 1000000))---- -------------------------------------------------------------------------- ----- Formatting and Parsing---- | Parse a 'UTCTime' using the supplied format string.------ Please refer to the [Pact Language--- Reference](https://pact-language.readthedocs.io/en/stable/pact-reference.html#time-formats) for details on the--- supported format strings.----#if MIN_VERSION_time(1,9,0)-parseTime :: MonadFail m => String -> String -> m UTCTime-#else-parseTime :: String -> String -> Maybe UTCTime-#endif-parseTime format = fmap fromUtcTime . parseTime_ T.defaultTimeLocale format-{-# INLINE parseTime #-}---- | Format a 'UTCTime' value using the supplied format string.------ Please refer to the [Pact Language--- Reference](https://pact-language.readthedocs.io/en/stable/pact-reference.html#time-formats) for details on the--- supported format strings.----formatTime :: String -> UTCTime -> String-formatTime format = formatTime_ T.defaultTimeLocale format . toUtcTime-{-# INLINE formatTime #-}---- -------------------------------------------------------------------------- ----- Inherited instances---- | The 'Show' instance is inherited from the "official" time package.----instance Show NominalDiffTime where-    show = show @T.NominalDiffTime . realToFrac . toSeconds-    {-# INLINE show #-}---- | The 'Show' instance is inherited from the "official" time package.----instance Show UTCTime where-    show = show . toUtcTime-    {-# INLINE show #-}---- | The 'Read' instance is inherited from the "official" time package.----instance Read UTCTime where-    readPrec = fromUtcTime <$> readPrec-    {-# INLINE readPrec #-}---- | The 'ToJSON' instance is inherited from the instance of 'T.UTCTime' from--- the "official" time package.----instance ToJSON UTCTime where-    toJSON = toJSON . toUtcTime-    {-# INLINE toJSON #-}---- | The 'FromJSON' instance is inherited from the instance of 'T.UTCTime' from--- the "official" time package.----instance FromJSON UTCTime where-    parseJSON = fmap fromUtcTime . parseJSON-    {-# INLINE parseJSON #-}---- -------------------------------------------------------------------------- ----- Ported Implementations from Time--#if MIN_VERSION_time(1,9,0)-parseTime_ :: MonadFail m => T.TimeLocale -> String -> String -> m T.UTCTime-#else-parseTime_ :: T.TimeLocale -> String -> String -> Maybe T.UTCTime-#endif-parseTime_ locale formatStr = T.parseTimeM False locale (mapFormat formatStr)-    where-    mapFormat ('%':'%':t) = "%%" <> mapFormat t-    mapFormat ('.':'%':'v':t) = "%Q" <> mapFormat t-    mapFormat ('%':'N':t) = "%z" <> mapFormat t-    mapFormat [] = []-    mapFormat (h:t) = h : mapFormat t--formatTime_ :: T.TimeLocale -> String -> T.UTCTime -> String-#if MIN_VERSION_time(1,9,0)-formatTime_ locale formatStr = T.formatTime locale (mapFormat formatStr)-  where-    mapFormat ('%':'%':t) = "%%" <> mapFormat t-    mapFormat ('%':'v':t) = "%6q" <> mapFormat t-    mapFormat ('%':'N':t) = "%Ez" <> mapFormat t-    mapFormat [] = []-    mapFormat (h:t) = h : mapFormat t-#else-formatTime_ locale formatStr timeValue = concat . snd $ go0 formatStr-  where-    format f = T.formatTime locale f timeValue-    n = let (h,m) = splitAt 3 $ format "%z" in h <> ":" <> m-    v = format "%6q"--    go0 s = let (a, b) = go1 s in ("", format a : b)--    go1 ('%':'%':t) = let (a, b) = go1 t in ("", "%" : format a : b)-    go1 ('%':'v':t) = let (a, b) = go1 t in ("", v : format a : b)-    go1 ('%':'N':t) = let (a, b) = go1 t in ("", n : format a : b)-    go1 (h:t) = let (a, b) = go1 t in (h:a, b)-    go1 "" = ("", [])-#endif-

@@ -1,1240 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE ViewPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- |--- Module: Data.Time.Format.Internal--- Copyright: Copyright © 2021 Kadena LLC.---                      © 2013−2014 Liyang HU Liyang HU--- License: MIT--- Maintainer: Lars Kuhtz <lars@kadena.io>--- Stability: experimental------ The code in this module is derived from various modules of the thyme package,--- which is copyright (c) 2013 Liyang HU and distributed under a BSD3 license.----module Data.Time.Format.Internal-( formatTime-, parseTime-, readTime-, readsTime-) where--import Control.Applicative-import Control.Monad.State.Strict--import Data.Aeson (FromJSON(..), ToJSON(..), withText, Value(String))-import Data.Attoparsec.ByteString.Char8 (Parser, Result, IResult (..))-import qualified Data.Attoparsec.ByteString.Char8 as P-import Data.Bits-import qualified Data.ByteString.Builder as B-import qualified Data.ByteString.Char8 as S-import qualified Data.ByteString.Lazy as L-import Data.Char-import Data.Int-import qualified Data.Text as T-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Data.Vector.Unboxed as VU-import Data.VectorSpace--import Lens.Micro---- internal modules--import Data.Time.Internal-import Data.Time.Format.Locale---- -------------------------------------------------------------------------- ----- Lens Utils (from microlens-mtl)--infix 4 .=--(.=) :: MonadState s m => ASetter s s a b -> b -> m ()-l .= x = modify (l .~ x)-{-# INLINE (.=) #-}--assign :: MonadState s m => ASetter s s a b -> b -> m ()-assign l x = l .= x-{-# INLINE assign #-}---- -------------------------------------------------------------------------- ----- Misc Utils--shows02 :: Int -> ShowS-shows02 n = if n < 10 then (:) '0' . shows n else shows n-{-# INLINE shows02 #-}--shows_2 :: Int -> ShowS-shows_2 n = if n < 10 then (:) ' ' . shows n else shows n-{-# INLINE shows_2 #-}--shows03 :: Int -> ShowS-shows03 n-    | n < 10 = (++) "00" . shows n-    | n < 100 = (++) "0" . shows n-    | otherwise = shows n-{-# INLINE shows03 #-}--showsYear :: Int -> ShowS-showsYear n@(abs -> u)-    | u < 10 = neg . (++) "000" . shows u-    | u < 100 = neg . (++) "00" . shows u-    | u < 1000 = neg . (++) "0" . shows u-    | otherwise = neg . shows u-  where-    neg = if n < 0 then (:) '-' else id-{-# INLINE showsYear #-}--fills06 :: Micros -> ShowS-fills06 n-    | n < 10 = (++) "00000"-    | n < 100 = (++) "0000"-    | n < 1000 = (++) "000"-    | n < 10000 = (++) "00"-    | n < 100000 = (++) "0"-    | otherwise = id-{-# INLINE fills06 #-}--drops0 :: Micros -> ShowS-drops0 n = case divMod n 10 of-    (q, 0) -> drops0 q-    _ -> shows n-{-# INLINE drops0 #-}---- -------------------------------------------------------------------------- ----- Misc Types---- Unbounded-type UnboundedInt = Int--type Minutes = UnboundedInt-type Days = UnboundedInt-type Year = UnboundedInt-type Century = UnboundedInt---- Bounded-type BoundedInt = Int--type Hour = BoundedInt-type Minute = BoundedInt-type Second = BoundedInt-type Month = BoundedInt-type DayOfMonth = BoundedInt-type DayOfYear = BoundedInt-type DayOfWeek = BoundedInt-type WeekOfYear = BoundedInt---- -------------------------------------------------------------------------- ----- Year Month Day--data YearMonthDay = YearMonthDay-    { _ymdYear :: {-# UNPACK #-} !Year-    , _ymdMonth :: {-# UNPACK #-} !Month-    , _ymdDay :: {-# UNPACK #-} !DayOfMonth-    }--ymdFromOrdinal :: OrdinalDate -> YearMonthDay-ymdFromOrdinal (OrdinalDate y yd) = YearMonthDay y m d-  where-    MonthDay m d = monthDaysFromDayOfYear (isLeapYear y) yd-{-# INLINEABLE ymdFromOrdinal #-}--ymdToOrdinal :: YearMonthDay -> OrdinalDate-ymdToOrdinal (YearMonthDay y m d) = OrdinalDate y $-    monthDaysToDayOfYear (isLeapYear y) (MonthDay m d)--{-# INLINEABLE ymdToOrdinal #-}--toGregorian :: YearMonthDay -> ModifiedJulianDay-toGregorian = fromOrdinalDate . ymdToOrdinal-{-# INLINEABLE toGregorian #-}---- -------------------------------------------------------------------------- ----- Ordinal Dates--data OrdinalDate = OrdinalDate-    { _odYear :: {-# UNPACK #-} !Year-    , _odDay :: {-# UNPACK #-} !DayOfYear-    }---- | Gregorian leap year?-isLeapYear :: Year -> Bool-isLeapYear y = y .&. 3 == 0 && (r100 /= 0 || q100 .&. 3 == 0)-  where-    (q100, r100) = y `quotRem` 100--toOrdinalDate :: ModifiedJulianDay -> OrdinalDate-toOrdinalDate (ModifiedJulianDay mjd)-    | dayB0 <= 0 = case toOrdB0 dayInQC of-        OrdinalDate y yd -> OrdinalDate (y + quadCent * 400) yd-    | otherwise = toOrdB0 dayB0-  where-    dayB0 = mjd + 678575-    (quadCent, dayInQC) = dayB0 `divMod` 146097--    -- Input: days since 1-1-1. Precondition: has to be positive!-    toOrdB0 dB0 = res-      where-        (y0, r) = (400 * dB0) `quotRem` 146097-        d0 = dayInYear y0 dB0-        d1 = dayInYear (y0 + 1) dB0-        res = if r > 146097 - 600 && d1 > 0-                then OrdinalDate (y0 + 1 + 1) d1-                else OrdinalDate (y0 + 1) d0-    {-# INLINE toOrdB0 #-}--    -- Input: (year - 1) (day as days since 1-1-1)-    -- Precondition: year is positive!-    dayInYear y0 dB0 = dB0 - 365 * y0 - leaps + 1-      where-        leaps = y0 `shiftR` 2 - centuries + centuries `shiftR` 2-        centuries = y0 `quot` 100-    {-# INLINE dayInYear #-}-{-# INLINEABLE toOrdinalDate #-}---fromOrdinalDate :: OrdinalDate -> ModifiedJulianDay-fromOrdinalDate (OrdinalDate year yd) = ModifiedJulianDay mjd-  where-    years = year - 1-    centuries = years `div` 100-    leaps = years `shiftR` 2 - centuries + centuries `shiftR` 2-    mjd = 365 * years + leaps - 678576-        + clip 1 (if isLeapYear year then 366 else 365) yd-    clip a b = max a . min b-{-# INLINEABLE fromOrdinalDate #-}---- -------------------------------------------------------------------------- ----- Months--monthLengths :: VU.Vector Days-monthLengths     = VU.fromList [31,28,31,30,31,30,31,31,30,31,30,31]-{-# NOINLINE monthLengths #-}--monthLengthsLeap :: VU.Vector Days-monthLengthsLeap = VU.fromList [31,29,31,30,31,30,31,31,30,31,30,31]-{-# NOINLINE monthLengthsLeap #-}--monthDays :: VU.Vector ({-Month-}Int8, {-DayOfMonth-}Int8)-monthDays = VU.generate 365 go-  where-    dom01 = VU.prescanl' (+) 0 monthLengths-    go yd = (fromIntegral m, fromIntegral d)-      where-        m = maybe 12 id $ VU.findIndex (yd <) dom01-        d = succ yd - VU.unsafeIndex dom01 (pred m)-{-# NOINLINE monthDays #-}--monthDaysLeap :: VU.Vector ({-Month-}Int8, {-DayOfMonth-}Int8)-monthDaysLeap = VU.generate 366 go-  where-    dom01 = VU.prescanl' (+) 0 monthLengthsLeap-    go yd = (fromIntegral m, fromIntegral d)-      where-        m = maybe 12 id $ VU.findIndex (yd <) dom01-        d = succ yd - VU.unsafeIndex dom01 (pred m)-{-# NOINLINE monthDaysLeap #-}--data MonthDay = MonthDay-    { _mdMonth :: {-# UNPACK #-} !Month-    , _mdDay :: {-# UNPACK #-} !DayOfMonth-    }--monthDaysFromDayOfYear :: Bool -> DayOfYear -> MonthDay-monthDaysFromDayOfYear leap yd = MonthDay m d-  where-    i = max 0 . min lastDay $ pred yd-    (fromIntegral -> m, fromIntegral -> d) = VU.unsafeIndex table i-    (lastDay, table) = if leap-      then (365, monthDaysLeap)-      else (364, monthDays)-{-# INLINE monthDaysFromDayOfYear #-}--monthDaysToDayOfYear :: Bool -> MonthDay -> DayOfYear-monthDaysToDayOfYear leap (MonthDay month mday) = div (367 * m - 362) 12 + k + d-  where-    m = max 1 . min 12 $ month-    l = VU.unsafeIndex lengths (pred m)-    d = max 1 . min l $ mday-    k = if m <= 2 then 0 else ok--    (lengths, ok) = if leap-      then (monthLengthsLeap, -1)-      else (monthLengths, -2)-{-# INLINE monthDaysToDayOfYear #-}---- -------------------------------------------------------------------------- ----- Week Date--data WeekDate = WeekDate-    { _wdYear :: {-# UNPACK #-} !Year-    , _wdWeek :: {-# UNPACK #-} !WeekOfYear-    , _wdDay :: {-# UNPACK #-} !DayOfWeek-    }--toWeekDate :: ModifiedJulianDay -> WeekDate-toWeekDate = join (toWeekOrdinal . toOrdinalDate)-{-# INLINEABLE toWeekDate #-}--fromWeekDate :: WeekDate -> ModifiedJulianDay-fromWeekDate wd@(WeekDate y _ _) = fromWeekLast (lastWeekOfYear y) wd-{-# INLINEABLE fromWeekDate #-}--toWeekOrdinal :: OrdinalDate -> ModifiedJulianDay -> WeekDate-toWeekOrdinal (OrdinalDate y0 yd) (ModifiedJulianDay mjd) =-    WeekDate y1 (w1 + 1) (d7mod + 1)-  where-    -- pilfered and refactored; no idea what foo and bar mean-    d = mjd + 2-    (d7div, d7mod) = divMod d 7--    -- foo :: Year -> {-WeekOfYear-1-}Int-    foo y = bar $ fromOrdinalDate $ OrdinalDate y 6--    -- bar :: ModifiedJulianDay -> {-WeekOfYear-1-}Int-    bar (ModifiedJulianDay k) = d7div - div k 7--    w0 = bar $ ModifiedJulianDay (d - yd + 4)-    (y1, w1) = case w0 of-        -1 -> (y0 - 1, foo (y0 - 1))-        52 | foo (y0 + 1) == 0 -> (y0 + 1, 0)-        _ -> (y0, w0)-{-# INLINE toWeekOrdinal #-}--lastWeekOfYear :: Year -> WeekOfYear-lastWeekOfYear y = if _wdWeek wd == 53 then 53 else 52-  where-    wd = toWeekDate $ fromOrdinalDate $ OrdinalDate y 365-{-# INLINE lastWeekOfYear #-}--fromWeekLast :: WeekOfYear -> WeekDate -> ModifiedJulianDay-fromWeekLast wMax (WeekDate y w d) = ModifiedJulianDay mjd-  where-    -- pilfered and refactored-    ModifiedJulianDay k = fromOrdinalDate $ OrdinalDate y 6-    mjd = k - mod k 7 - 10 + clip 1 7 d + clip 1 wMax w * 7-    clip a b = max a . min b-{-# INLINE fromWeekLast #-}---- -------------------------------------------------------------------------- ----- Sunday Weeks---- | Weeks numbered from 0 to 53, starting with the first Sunday of the year--- as the first day of week 1. The last week of a given year and week 0 of--- the next both refer to the same week, but not all 'DayOfWeek' are valid.--- 'Year' coincides with that of 'gregorian'.----data SundayWeek = SundayWeek-    { _swYear :: {-# UNPACK #-} !Year-    , _swWeek :: {-# UNPACK #-} !WeekOfYear-    , _swDay :: {-# UNPACK #-} !DayOfWeek-    }--fromSundayWeek :: SundayWeek -> ModifiedJulianDay-fromSundayWeek (SundayWeek y w d) = ModifiedJulianDay (firstDay + yd)-  where-    ModifiedJulianDay firstDay = fromOrdinalDate $ OrdinalDate y 1-    -- following are all 0-based year days-    firstSunday = mod (4 - firstDay) 7-    yd = firstSunday + 7 * (w - 1) + d-{-# INLINEABLE fromSundayWeek #-}--toSundayOrdinal :: OrdinalDate -> ModifiedJulianDay -> SundayWeek-toSundayOrdinal (OrdinalDate y yd) (ModifiedJulianDay mjd) =-    SundayWeek y (d7div - div k 7) d7mod-  where-    d = mjd + 3-    k = d - yd-    (d7div, d7mod) = divMod d 7-{-# INLINE toSundayOrdinal #-}---- -------------------------------------------------------------------------- ----- Monaday Weeks---- | Weeks numbered from 0 to 53, starting with the first Monday of the year--- as the first day of week 1. The last week of a given year and week 0 of--- the next both refer to the same week, but not all 'DayOfWeek' are valid.--- 'Year' coincides with that of 'gregorian'.----data MondayWeek = MondayWeek-    { _mwYear :: {-# UNPACK #-} !Year-    , _mwWeek :: {-# UNPACK #-} !WeekOfYear-    , _mwDay :: {-# UNPACK #-} !DayOfWeek-    }--fromMondayWeek :: MondayWeek -> ModifiedJulianDay-fromMondayWeek (MondayWeek y w d) = ModifiedJulianDay (firstDay + yd)-  where-    ModifiedJulianDay firstDay = fromOrdinalDate $ OrdinalDate y 1-    -- following are all 0-based year days-    firstMonday = mod (5 - firstDay) 7-    yd = firstMonday + 7 * (w - 1) + d - 1-{-# INLINEABLE fromMondayWeek #-}--toMondayOrdinal :: OrdinalDate -> ModifiedJulianDay -> MondayWeek-toMondayOrdinal (OrdinalDate y yd) (ModifiedJulianDay mjd) =-    MondayWeek y (d7div - div k 7) (d7mod + 1)-  where-    d = mjd + 2-    k = d - yd-    (d7div, d7mod) = divMod d 7-{-# INLINE toMondayOrdinal #-}---- -------------------------------------------------------------------------- ----- Time Of Day--data TimeOfDay = TimeOfDay-    { _todHour :: {-# UNPACK #-} !Hour-    , _todMin :: {-# UNPACK #-} !Minute-    , _todSec :: {-# UNPACK #-} !NominalDiffTime-    }--timeOfDayFromNominalDiffTime :: NominalDiffTime -> TimeOfDay-timeOfDayFromNominalDiffTime (NominalDiffTime t) = TimeOfDay-    (fromIntegral h) (fromIntegral m) (NominalDiffTime s)-  where-    (h, ms) = quotRem t 3600000000-    (m, s) = quotRem ms 60000000-{-# INLINEABLE timeOfDayFromNominalDiffTime #-}---- -------------------------------------------------------------------------- ----- Format Time--class FormatTime t where-    showsTime :: t -> (Char -> ShowS) -> Char -> ShowS--formatTime :: (FormatTime t) => String -> t -> String-formatTime spec t = formatTimeS spec t ""-{-# INLINEABLE formatTime #-}--formatTimeS :: (FormatTime t) => String -> t -> ShowS-formatTimeS spec t = go spec-  where-    -- leave unrecognised codes as they are-    format = showsTime t (\c s -> '%' : c : s)-    go s = case s of-        '%' : c : rest -> case c of-            -- aggregate-            'c' -> go (dateTimeFmt l ++ rest)-            'r' -> go (time12Fmt l ++ rest)-            'X' -> go (timeFmt l ++ rest)-            'x' -> go (dateFmt l ++ rest)-            -- modifier (whatever)-            '-' -> go ('%' : rest)-            '_' -> go ('%' : rest)-            '0' -> go ('%' : rest)-            '^' -> go ('%' : rest)-            '#' -> go ('%' : rest)-            -- escape (why would anyone need %t and %n?)-            '%' -> (:) '%' . go rest-            -- default-            _ -> format c . go rest-        c : rest -> (:) c . go rest-        [] -> id-      where-        l = defaultTimeLocale-{-# INLINEABLE formatTimeS #-}--instance FormatTime TimeOfDay where-    showsTime (TimeOfDay h m (NominalDiffTime s)) = \ def c -> case c of-        -- aggregate-        'R' -> shows02 h . (:) ':' . shows02 m-        'T' -> shows02 h . (:) ':' . shows02 m . (:) ':' . shows02 si-        -- AM/PM-        'P' -> (++) $ toLower <$> if h < 12 then fst amPm else snd amPm-        'p' -> (++) $ if h < 12 then fst amPm else snd amPm-        -- Hour-        'H' -> shows02 h-        'I' -> shows02 $ 1 + mod (h - 1) 12-        'k' -> shows_2 h-        'l' -> shows_2 $ 1 + mod (h - 1) 12-        -- Minute-        'M' -> shows02 m-        -- Second-        'S' -> shows02 si--        -- TODO: Unsupported by Pact-        'q' -> fills06 su . shows su . (++) "000000"--        'v' -> fills06 su . shows su-        'Q' -> if su == 0 then id else (:) '.' . fills06 su . drops0 su-        -- default-        _ -> def c-      where-        (fromIntegral -> si, su) = quotRem s 1000000-        TimeLocale {..} = defaultTimeLocale-    {-# INLINEABLE showsTime #-}--instance FormatTime SundayWeek where-    showsTime (SundayWeek y w d) = \ def c -> case c of-        -- Year-        'Y' -> showsYear y-        'y' -> shows02 (mod y 100)-        'C' -> shows02 (div y 100)-        -- WeekOfYear-        'U' -> shows02 w-        -- DayOfWeek-        'u' -> shows $ if d == 0 then 7 else d-        'w' -> shows $ if d == 7 then 0 else d-        'A' -> (++) . fst $ wDays !! mod d 7-        'a' -> (++) . snd $ wDays !! mod d 7-        -- default-        _ -> def c-      where-        TimeLocale {..} = defaultTimeLocale-    {-# INLINEABLE showsTime #-}--instance FormatTime MondayWeek where-    showsTime (MondayWeek y w d) = \ def c -> case c of-        -- Year-        'Y' -> showsYear y-        'y' -> shows02 (mod y 100)-        'C' -> shows02 (div y 100)-        -- WeekOfYear-        'W' -> shows02 w-        -- DayOfWeek-        'u' -> shows $ if d == 0 then 7 else d-        'w' -> shows $ if d == 7 then 0 else d-        'A' -> (++) . fst $ wDays !! mod d 7-        'a' -> (++) . snd $ wDays !! mod d 7-        -- default-        _ -> def c-      where-        TimeLocale {..} = defaultTimeLocale-    {-# INLINEABLE showsTime #-}--instance FormatTime WeekDate where-    showsTime (WeekDate y w d) = \ def c -> case c of-        -- Year-        'G' -> showsYear y-        'g' -> shows02 (mod y 100)-        'f' -> shows02 (div y 100)-        -- WeekOfYear-        'V' -> shows02 w-        -- DayOfWeek-        'u' -> shows $ if d == 0 then 7 else d-        'w' -> shows $ if d == 7 then 0 else d-        'A' -> (++) . fst $ wDays !! mod d 7-        'a' -> (++) . snd $ wDays !! mod d 7-        -- default-        _ -> def c-      where-        TimeLocale {..} = defaultTimeLocale-    {-# INLINEABLE showsTime #-}--instance FormatTime YearMonthDay where-    showsTime (YearMonthDay y m d) def c = case c of-        -- aggregate-        'D' -> shows02 m . (:) '/' . shows02 d . (:) '/' . shows02 (mod y 100)-        'F' -> showsYear y . (:) '-' . shows02 m . (:) '-' . shows02 d-        -- Year-        'Y' -> showsYear y-        'y' -> shows02 (mod y 100)-        'C' -> shows02 (div y 100)-        -- Month-        'B' -> (++) . fst $ months !! (m - 1)-        'b' -> (++) . snd $ months !! (m - 1)-        'h' -> (++) . snd $ months !! (m - 1)-        'm' -> shows02 m-        -- DayOfMonth-        'd' -> shows02 d-        'e' -> shows_2 d-        -- default-        _ -> def c-      where-        TimeLocale {..} = defaultTimeLocale-    {-# INLINEABLE showsTime #-}--instance FormatTime MonthDay where-    showsTime (MonthDay m d) def c = case c of-        -- Month-        'B' -> (++) . fst $ months !! (m - 1)-        'b' -> (++) . snd $ months !! (m - 1)-        'h' -> (++) . snd $ months !! (m - 1)-        'm' -> shows02 m-        -- DayOfMonth-        'd' -> shows02 d-        'e' -> shows_2 d-        -- default-        _ -> def c-      where-        TimeLocale {..} = defaultTimeLocale-    {-# INLINEABLE showsTime #-}--instance FormatTime OrdinalDate where-    showsTime (OrdinalDate y d) def c = case c of-        -- Year-        'Y' -> showsYear y-        'y' -> shows02 (mod y 100)-        'C' -> shows02 (div y 100)-        -- DayOfYear-        'j' -> shows03 d-        -- default-        _ -> def c-    {-# INLINEABLE showsTime #-}---- | Format Date that is represented as 'ModifiedJulianDay'----instance FormatTime ModifiedJulianDay where-    showsTime d@(toOrdinalDate -> ordinal)-        = showsTime ordinal-        . showsTime (ymdFromOrdinal ordinal)-        . showsTime (toWeekOrdinal ordinal d)-        . showsTime (toSundayOrdinal ordinal d)-        . showsTime (toMondayOrdinal ordinal d)-    {-# INLINEABLE showsTime #-}--instance FormatTime ModifiedJulianDate where-    showsTime (ModifiedJulianDate d dt) =-        showsTime d . showsTime (timeOfDayFromNominalDiffTime dt)-    {-# INLINEABLE showsTime #-}--instance FormatTime UTCTime where-    showsTime t def c = case c of-        's' -> shows . fst $ quotRem (toPosixTimestampMicros t) 1000000-        _ -> (showsTime (toModifiedJulianDate t) . formatUtcZone) def c-    {-# INLINEABLE showsTime #-}---- | Pact only supports UTC----formatUtcZone :: (Char -> ShowS) -> Char -> ShowS-formatUtcZone def c = case c of-    'z' -> (++) "+0000"-    'N' -> (++) "+00:00"-    'Z' -> (++) "UTC"-    _ -> def c-{-# INLINEABLE formatUtcZone #-}---- -------------------------------------------------------------------------- ----- Parser Utils--utf8Char :: Char -> S.ByteString-utf8Char = L.toStrict . B.toLazyByteString . B.charUtf8-{-# INLINE utf8Char #-}--utf8String :: String -> S.ByteString-utf8String = L.toStrict . B.toLazyByteString . B.stringUtf8-{-# INLINE utf8String #-}--parserToReadS :: Parser a -> ReadS a-parserToReadS = go . P.parse-  where-    go :: (S.ByteString -> Result a) -> ReadS a-    go k (splitAt 32 -> (h, t)) = case k (utf8String h) of-        -- `date -R | wc -c` is 32 characters-        Fail rest cxts msg -> fail $ concat [ "parserToReadS: ", msg-            , "; remaining: ", show (utf8Decode rest), "; stack: ", show cxts ]-        Partial k' -> go k' t-        Done rest a -> return (a, utf8Decode rest ++ t)-    {-# INLINEABLE go #-}--    utf8Decode :: S.ByteString -> String-    utf8Decode = Text.unpack . Text.decodeUtf8-    {-# INLINE utf8Decode #-}-{-# INLINEABLE parserToReadS #-}--indexOfCI :: [String] -> Parser Int-indexOfCI = P.choice . zipWith (\i s -> i <$ stringCI s) [0..]-{-# INLINE indexOfCI #-}---- | Case-insensitive UTF-8 ByteString parser------ Matches one character at a time. Slow.----stringCI :: String -> Parser ()-stringCI = foldl (\p c -> p *> charCI c) (pure ())-{-# INLINE stringCI #-}---- | Case-insensitive UTF-8 ByteString parser------ We can't easily perform upper/lower case conversion on the input, so--- instead we accept either one of @toUpper c@ and @toLower c@.----charCI :: Char -> Parser ()-charCI c = if u == l then charU8 c else charU8 l <|> charU8 u-  where-    l = toLower c-    u = toUpper c-{-# INLINE charCI #-}--charU8 :: Char -> Parser ()-charU8 c = () <$ P.string (utf8Char c)-{-# INLINE charU8 #-}---- | Number may be prefixed with '-'----negative :: (Integral n) => Parser n -> Parser n-negative p = ($) <$> (negate <$ P.char '-' <|> pure id) <*> p-{-# INLINE negative #-}---- | Fixed-length 0-padded decimal----dec0 :: Int -> Parser Int-dec0 n = either fail return . P.parseOnly P.decimal =<< P.take n-{-# INLINE dec0 #-}---- | Fixed-length space-padded decimal----dec_ :: Int -> Parser Int-dec_ n = P.take n >>= either fail return-    . P.parseOnly P.decimal-    . S.dropWhile isSpace-{-# INLINE dec_ #-}---- -------------------------------------------------------------------------- ----- Time Zones--data TimeZone = TimeZone-    { _timeZoneMinutes :: {-# UNPACK #-} !Minutes-    , _timeZoneSummerOnly :: !Bool-    , _timeZoneName :: String-    }--timeZoneMinutes :: Lens' TimeZone Minutes-timeZoneMinutes = lens _timeZoneMinutes $ \a b -> a { _timeZoneMinutes = b }-{-# INLINE timeZoneMinutes #-}--utc :: TimeZone-utc = TimeZone 0 False "UTC"--timeZoneOffset :: TimeZone -> NominalDiffTime-timeZoneOffset = fromMicroseconds . fromIntegral . (*) 60000000 . negate . _timeZoneMinutes-{-# INLINE timeZoneOffset #-}---- -------------------------------------------------------------------------- ----- Parse String into a Time Parse Value--data TimeFlag-    = PostMeridiem-    | TwelveHour-    | HasCentury-    | IsPOSIXTime-    | IsOrdinalDate-    | IsGregorian-    | IsWeekDate-    | IsSundayWeek-    | IsMondayWeek-    deriving (Enum, Show)--data TimeParse = TimeParse-    { _tpCentury :: {-# UNPACK #-} !Century-    , _tpCenturyYear :: {-# UNPACK #-} !Int{-YearOfCentury-}-    , _tpMonth :: {-# UNPACK #-} !Month-    , _tpWeekOfYear :: {-# UNPACK #-} !WeekOfYear-    , _tpDayOfMonth :: {-# UNPACK #-} !DayOfMonth-    , _tpDayOfYear :: {-# UNPACK #-} !DayOfYear-    , _tpDayOfWeek :: {-# UNPACK #-} !DayOfWeek-    , _tpFlags :: {-# UNPACK #-} !Int{-BitSet TimeFlag-}-    , _tpHour :: {-# UNPACK #-} !Hour-    , _tpMinute :: {-# UNPACK #-} !Minute-    , _tpSecond :: {-# UNPACK #-} !Second-    , _tpSecFrac :: {-# UNPACK #-} !NominalDiffTime-    , _tpPOSIXTime :: {-# UNPACK #-} !NominalDiffTime-    , _tpTimeZone :: !TimeZone-    }--flag :: TimeFlag -> Lens' TimeParse Bool-flag (fromEnum -> f) = tpFlags . lens-    (`testBit` f) (\ n b -> (if b then setBit else clearBit) n f)-{-# INLINE flag #-}--tpYear :: TimeParse -> Year-tpYear tp = _tpCenturyYear tp + 100 * if tp ^. flag HasCentury-  then _tpCentury tp-  else if _tpCenturyYear tp < 69-    then 20-    else 19-{-# INLINE tpYear #-}---- | Time 'Parser' for UTF-8 encoded 'ByteString's.------ Attoparsec easily beats any 'String' parser out there, but we do have to--- be careful to convert the input to UTF-8 'ByteString's.----timeParser :: String -> Parser TimeParse-timeParser = flip execStateT unixEpoch . go-  where--    go :: String -> StateT TimeParse Parser ()-    go spec = case spec of-        '%' : cspec : rspec -> case cspec of-            -- aggregate-            'c' -> go (dateTimeFmt l ++ rspec)-            'r' -> go (time12Fmt l ++ rspec)-            'X' -> go (timeFmt l ++ rspec)-            'x' -> go (dateFmt l ++ rspec)-            'R' -> go ("%H:%M" ++ rspec)-            'T' -> go ("%H:%M:%S" ++ rspec)-            'D' -> go ("%m/%d/%y" ++ rspec)-            'F' -> go ("%Y-%m-%d" ++ rspec)-            -- AM/PM-            'P' -> dayHalf-            'p' -> dayHalf-            -- Hour-            'H' -> lift (dec0 2) >>= setHour24-            'I' -> lift (dec0 2) >>= setHour12-            'k' -> (lift (dec_ 2) >>= setHour24)-                <|> (lift (dec_ 1) >>= setHour24)-            'l' -> (lift (dec_ 2) >>= setHour12)-                <|> (lift (dec_ 1) >>= setHour12)-            -- Minute-            'M' -> lift (dec0 2) >>= assign tpMinute >> go rspec-            -- Second-            'S' -> lift (dec0 2) >>= assign tpSecond >> go rspec--            -- TODO: Unsupported by pact-            'q' -> lift micro >>= assign tpSecFrac . NominalDiffTime >> go rspec--            'v' -> lift micro >>= assign tpSecFrac . NominalDiffTime >> go rspec-            'Q' -> lift ((P.char '.' >> NominalDiffTime <$> micro) <|> return zeroV)-                >>= assign tpSecFrac >> go rspec--            -- Year-            'Y' -> fullYear-            'y' -> lift (dec0 2) >>= setCenturyYear-            'C' -> lift (dec0 2) >>= setCentury-            -- Month-            'B' -> lift (indexOfCI $ fst <$> months l) >>= setMonth . succ-            'b' -> lift (indexOfCI $ snd <$> months l) >>= setMonth . succ-            'h' -> lift (indexOfCI $ snd <$> months l) >>= setMonth . succ-            'm' -> lift (dec0 2) >>= setMonth-            -- DayOfMonth-            'd' -> lift (dec0 2) >>= setDayOfMonth-            'e' -> (lift (dec_ 2) >>= setDayOfMonth)-                <|> (lift (dec_ 1) >>= setDayOfMonth)-            -- DayOfYear-            'j' -> lift (dec0 3) >>= assign tpDayOfYear-                >> flag IsOrdinalDate .= True >> go rspec--            -- Year (WeekDate)-            -- FIXME: problematic if input contains both %Y and %G-            'G' -> flag IsWeekDate .= True >> fullYear-            'g' -> flag IsWeekDate .= True >> lift (dec0 2) >>= setCenturyYear-            'f' -> flag IsWeekDate .= True >> lift (dec0 2) >>= setCentury-            -- WeekOfYear-            -- FIXME: problematic if more than one of the following-            'V' -> flag IsWeekDate .= True >> lift (dec0 2) >>= setWeekOfYear-            'U' -> flag IsSundayWeek .= True >> lift (dec0 2) >>= setWeekOfYear-            'W' -> flag IsMondayWeek .= True >> lift (dec0 2) >>= setWeekOfYear-            -- DayOfWeek-            'w' -> lift (dec0 1) >>= setDayOfWeek-            'u' -> lift (dec0 1) >>= setDayOfWeek-            'A' -> lift (indexOfCI $ fst <$> wDays l) >>= setDayOfWeek-            'a' -> lift (indexOfCI $ snd <$> wDays l) >>= setDayOfWeek--            -- TimeZone-            'z' -> do tzOffset; go rspec-            'N' -> do tzOffset; go rspec-            'Z' -> do tzOffset <|> tzName; go rspec-            -- UTCTime-            's' -> do-                s <- lift (negative P.decimal)-                tpPOSIXTime .= fromMicroseconds (1000000 * s)-                flag IsPOSIXTime .= True-                go rspec--            -- modifier (whatever)-            '-' -> go ('%' : rspec)-            '_' -> go ('%' : rspec)-            '0' -> go ('%' : rspec)-            -- escape (why would anyone need %t and %n?)-            '%' -> lift (P.char '%') >> go rspec-            _ -> lift . fail $ "Unknown format character: " ++ show cspec--          where-            l = defaultTimeLocale-            dayHalf = do-                pm <- lift $ False <$ stringCI (fst $ amPm l)-                    <|> True <$ stringCI (snd $ amPm l)-                flag PostMeridiem .= pm-                flag TwelveHour .= True-                go rspec-            -- NOTE: if a greedy parse fails or causes a later failure,-            -- then backtrack and only accept 4-digit years; see #5.-            fullYear = year (negative P.decimal) <|> year (dec0 4)-              where-                year p = do-                    (c, y) <- (`divMod` 100) <$> lift p-                    flag HasCentury .= True-                    tpCentury .= c-                    tpCenturyYear .= y-                    go rspec-            setHour12 h = do-                flag TwelveHour .= True-                tpHour .= h-                go rspec-            setHour24 h = do-                flag TwelveHour .= False-                tpHour .= h-                go rspec-            setCenturyYear y = do tpCenturyYear .= y; go rspec-            setCentury c = do-                tpCentury .= c-                flag HasCentury .= True-                go rspec-            setMonth m = do-                flag IsGregorian .= True-                tpMonth .= m-                go rspec-            setDayOfMonth d = do-                flag IsGregorian .= True-                tpDayOfMonth .= d-                go rspec-            setWeekOfYear w = do tpWeekOfYear .= w; go rspec-            setDayOfWeek d = do tpDayOfWeek .= d; go rspec-            tzOffset = do-                s <- lift (id <$ P.char '+' <|> negate <$ P.char '-')-                h <- lift (dec0 2)-                () <$ lift (P.char ':') <|> pure ()-                m <- lift (dec0 2)-                tpTimeZone . timeZoneMinutes .= s (h * 60 + m)-            tzName = lift timeZoneParser >>= assign tpTimeZone--        c : rspec | P.isSpace c ->-            lift (P.takeWhile P.isSpace) >> go (dropWhile P.isSpace rspec)-        c : rspec | isAscii c -> lift (P.char c) >> go rspec-        c : rspec -> lift (charU8 c) >> go rspec-        "" -> return ()--    micro :: Parser Int64-    micro = do-        us10 <- either fail return . P.parseOnly P.decimal . S.take 7-            . (`S.append` S.pack "000000") =<< P.takeWhile1 P.isDigit-        return (div (us10 + 5) 10)-    {-# INLINE micro #-}--    unixEpoch :: TimeParse-    unixEpoch = TimeParse-        { _tpCentury = 19-        , _tpCenturyYear = 70-        , _tpMonth = 1-        , _tpWeekOfYear = 1-        , _tpDayOfYear = 1-        , _tpDayOfMonth = 1-        , _tpDayOfWeek = 4-        , _tpFlags = 0-        , _tpHour = 0-        , _tpMinute = 0-        , _tpSecond = 0-        , _tpSecFrac = zeroV-        , _tpPOSIXTime = zeroV-        , _tpTimeZone = utc-        }-    {-# INLINE unixEpoch #-}-{-# INLINEABLE timeParser #-}--parseTime :: String -> String -> Maybe UTCTime-parseTime spec = either (const Nothing) Just-    . P.parseOnly parser . utf8String-  where-    parser = buildTime <$ P.skipSpace <*> timeParser spec-        <* P.skipSpace <* P.endOfInput-{-# INLINEABLE parseTime #-}--readTime :: (ParseTime t) => String -> String -> t-readTime spec = either error id . P.parseOnly parser . utf8String-  where-    parser = buildTime <$ P.skipSpace <*> timeParser spec-        <* P.skipSpace <* P.endOfInput-{-# INLINEABLE readTime #-}--readsTime :: (ParseTime t) => String -> ReadS t-readsTime spec = parserToReadS $-    buildTime <$ P.skipSpace <*> timeParser spec-{-# INLINEABLE readsTime #-}---- -------------------------------------------------------------------------- ----- Build Parse Time--class ParseTime t where-    buildTime :: TimeParse -> t--instance ParseTime TimeOfDay where-    buildTime tp = TimeOfDay h (_tpMinute tp)-        (fromMicroseconds (1000000 * fromIntegral (_tpSecond tp)) ^+^ _tpSecFrac tp)-      where-        h = if tp ^. flag TwelveHour-              then if tp ^. flag PostMeridiem-                then if _tpHour tp < 12-                  then _tpHour tp + 12-                  else _tpHour tp-                else mod (_tpHour tp) 12-              else _tpHour tp-    {-# INLINE buildTime #-}--instance ParseTime YearMonthDay where-    buildTime tp = YearMonthDay (tpYear tp) (_tpMonth tp) (_tpDayOfMonth tp)-    {-# INLINE buildTime #-}--instance ParseTime OrdinalDate where-    buildTime tp = OrdinalDate (tpYear tp) (_tpDayOfYear tp)-    {-# INLINE buildTime #-}--instance ParseTime WeekDate where-    buildTime tp = WeekDate (tpYear tp) (_tpWeekOfYear tp)-        (if _tpDayOfWeek tp == 0 then 7 else _tpDayOfWeek tp)-    {-# INLINE buildTime #-}--instance ParseTime SundayWeek where-    buildTime tp = SundayWeek (tpYear tp) (_tpWeekOfYear tp)-        (if _tpDayOfWeek tp == 7 then 0 else _tpDayOfWeek tp)-    {-# INLINE buildTime #-}--instance ParseTime MondayWeek where-    buildTime tp = MondayWeek (tpYear tp) (_tpWeekOfYear tp)-        (if _tpDayOfWeek tp == 0 then 7 else _tpDayOfWeek tp)-    {-# INLINE buildTime #-}--instance ParseTime ModifiedJulianDay where-    {-# INLINE buildTime #-}-    buildTime tp-        | tp ^. flag IsOrdinalDate = fromOrdinalDate $ buildTime tp-        | tp ^. flag IsGregorian = toGregorian $ buildTime tp-        | tp ^. flag IsWeekDate = fromWeekDate $ buildTime tp-        | tp ^. flag IsSundayWeek = fromSundayWeek $ buildTime tp-        | tp ^. flag IsMondayWeek = fromMondayWeek $ buildTime tp-        | otherwise = fromOrdinalDate $ buildTime tp-        -- TODO: Better conflict handling when multiple flags are set?--instance ParseTime TimeZone where-    buildTime = _tpTimeZone-    {-# INLINE buildTime #-}--instance ParseTime UTCTime where-    buildTime tp = if tp ^. flag IsPOSIXTime-        then  fromPosixTimestampMicros $ toMicroseconds $ _tpPOSIXTime tp-        else zoned-      where-        d :: ModifiedJulianDay-        d = buildTime tp--        dt :: TimeOfDay-        dt = buildTime tp--        tz :: TimeZone-        tz = buildTime tp--        jul :: ModifiedJulianDate-        jul = ModifiedJulianDate d (toDayTime dt)--        zoned :: UTCTime-        zoned = fromModifiedJulianDate jul .+^ timeZoneOffset tz--        toDayTime :: TimeOfDay -> NominalDiffTime-        toDayTime (TimeOfDay h m s) = s-            ^+^ fromIntegral m *^ NominalDiffTime 60000000-            ^+^ fromIntegral h *^ NominalDiffTime 3600000000-        {-# INLINEABLE toDayTime #-}-    {-# INLINE buildTime #-}---- -------------------------------------------------------------------------- ----- Time Zone Parser--timeZoneParser :: Parser TimeZone-timeZoneParser = zone "TAI" 0 False <|> zone "UT1" 0 False--    <|> zone "ZULU" (($+) 00 00) False --  Same as UTC-    <|> zone "Z" (($+) 00 00) False --  Same as UTC-    <|> zone "YST" (($-) 09 00) False -- Yukon Standard Time-    <|> zone "YDT" (($-) 08 00) True -- Yukon Daylight-Saving Time-    <|> zone "WST" (($+) 08 00) False -- West Australian Standard Time-    <|> zone "WETDST" (($+) 01 00) True -- Western European Daylight-Saving Time-    <|> zone "WET" (($+) 00 00) False --  Western European Time-    <|> zone "WDT" (($+) 09 00) True -- West Australian Daylight-Saving Time-    <|> zone "WAT" (($-) 01 00) False -- West Africa Time-    <|> zone "WAST" (($+) 07 00) False -- West Australian Standard Time-    <|> zone "WADT" (($+) 08 00) True -- West Australian Daylight-Saving Time-    <|> zone "UTC" (($+) 00 00) False --  Universal Coordinated Time-    <|> zone "UT" (($+) 00 00) False --  Universal Time-    <|> zone "TFT" (($+) 05 00) False -- Kerguelen Time-    <|> zone "SWT" (($+) 01 00) False -- Swedish Winter Time-    <|> zone "SST" (($+) 02 00) False -- Swedish Summer Time-    <|> zone "SET" (($+) 01 00) False -- Seychelles Time-    <|> zone "SCT" (($+) 04 00) False -- Mahe Island Time-    <|> zone "SAST" (($+) 09 30) False -- South Australia Standard Time-    <|> zone "SADT" (($+) 10 30) True -- South Australian Daylight-Saving Time-    <|> zone "RET" (($+) 04 00) False -- Reunion Island Time-    <|> zone "PST" (($-) 08 00) False -- Pacific Standard Time-    <|> zone "PDT" (($-) 07 00) True -- Pacific Daylight-Saving Time-    <|> zone "NZT" (($+) 12 00) False -- New Zealand Time-    <|> zone "NZST" (($+) 12 00) False -- New Zealand Standard Time-    <|> zone "NZDT" (($+) 13 00) True -- New Zealand Daylight-Saving Time-    <|> zone "NT" (($-) 11 00) False -- Nome Time-    <|> zone "NST" (($-) 03 30) False -- Newfoundland Standard Time-    <|> zone "NOR" (($+) 01 00) False -- Norway Standard Time-    <|> zone "NFT" (($-) 03 30) False -- Newfoundland Standard Time-    <|> zone "NDT" (($-) 02 30) True -- Newfoundland Daylight-Saving Time-    <|> zone "MVT" (($+) 05 00) False -- Maldives Island Time-    <|> zone "MUT" (($+) 04 00) False -- Mauritius Island Time-    <|> zone "MT" (($+) 08 30) False -- Moluccas Time-    <|> zone "MST" (($-) 07 00) False -- Mountain Standard Time-    <|> zone "MMT" (($+) 06 30) False -- Myanmar Time-    <|> zone "MHT" (($+) 09 00) False -- Kwajalein Time-    <|> zone "MEZ" (($+) 01 00) False -- Mitteleuropaeische Zeit-    <|> zone "MEWT" (($+) 01 00) False -- Middle European Winter Time-    <|> zone "METDST" (($+) 02 00) True -- Middle Europe Daylight-Saving Time-    <|> zone "MET" (($+) 01 00) False -- Middle European Time-    <|> zone "MEST" (($+) 02 00) False -- Middle European Summer Time-    <|> zone "MDT" (($-) 06 00) True -- Mountain Daylight-Saving Time-    <|> zone "MAWT" (($+) 06 00) False -- Mawson (Antarctica) Time-    <|> zone "MART" (($-) 09 30) False -- Marquesas Time-    <|> zone "LIGT" (($+) 10 00) False -- Melbourne, Australia-    <|> zone "KST" (($+) 09 00) False -- Korea Standard Time-    <|> zone "JT" (($+) 07 30) False -- Java Time-    <|> zone "JST" (($+) 09 00) False -- Japan Standard Time, Russia zone 8-    <|> zone "IT" (($+) 03 30) False -- Iran Time-    <|> zone "IST" (($+) 02 00) False -- Israel Standard Time-    <|> zone "IRT" (($+) 03 30) False -- Iran Time-    <|> zone "IOT" (($+) 05 00) False -- Indian Chagos Time-    <|> zone "IDLW" (($-) 12 00) False -- International Date Line, West-    <|> zone "IDLE" (($+) 12 00) False -- International Date Line, East-    <|> zone "HST" (($-) 10 00) False -- Hawaii Standard Time-    <|> zone "HMT" (($+) 03 00) False -- Hellas Mediterranean Time (?)-    <|> zone "HDT" (($-) 09 00) True -- Hawaii/Alaska Daylight-Saving Time-    <|> zone "GST" (($+) 10 00) False -- Guam Standard Time, Russia zone 9-    <|> zone "GMT" (($+) 00 00) False --  Greenwich Mean Time-    <|> zone "FWT" (($+) 02 00) False -- French Winter Time-    <|> zone "FST" (($+) 01 00) False -- French Summer Time-    <|> zone "FNT" (($-) 02 00) False -- Fernando de Noronha Time-    <|> zone "FNST" (($-) 01 00) False -- Fernando de Noronha Summer Time-    <|> zone "EST" (($-) 05 00) False -- Eastern Standard Time-    <|> zone "EETDST" (($+) 03 00) True -- Eastern Europe Daylight-Saving Time-    <|> zone "EET" (($+) 02 00) False -- Eastern European Time, Russia zone 1-    <|> zone "EDT" (($-) 04 00) True -- Eastern Daylight-Saving Time-    <|> zone "EAT" (($+) 03 00) False -- Antananarivo, Comoro Time-    <|> zone "EAST" (($+) 10 00) False -- East Australian Standard Time-    <|> zone "EAST" (($+) 04 00) False -- Antananarivo Summer Time-    <|> zone "DNT" (($+) 01 00) False -- Dansk Normal Tid-    <|> zone "CXT" (($+) 07 00) False -- Christmas (Island) Time-    <|> zone "CST" (($-) 06 00) False -- Central Standard Time-    <|> zone "CETDST" (($+) 02 00) True -- Central European Daylight-Saving Time-    <|> zone "CET" (($+) 01 00) False -- Central European Time-    <|> zone "CEST" (($+) 02 00) False -- Central European Summer Time-    <|> zone "CDT" (($-) 05 00) True -- Central Daylight-Saving Time-    <|> zone "CCT" (($+) 08 00) False -- China Coastal Time-    <|> zone "CAT" (($-) 10 00) False -- Central Alaska Time-    <|> zone "CAST" (($+) 09 30) False -- Central Australia Standard Time-    <|> zone "CADT" (($+) 10 30) True -- Central Australia Daylight-Saving Time-    <|> zone "BT" (($+) 03 00) False -- Baghdad Time-    <|> zone "BST" (($+) 01 00) False -- British Summer Time-    <|> zone "BRT" (($-) 03 00) False -- Brasilia Time-    <|> zone "BRST" (($-) 02 00) False -- Brasilia Summer Time-    <|> zone "BDST" (($+) 02 00) False -- British Double Summer Time-    <|> zone "AWT" (($-) 03 00) False -- (unknown)-    <|> zone "AWST" (($+) 08 00) False -- Australia Western Standard Time-    <|> zone "AWSST" (($+) 09 00) False -- Australia Western Summer Standard Time-    <|> zone "AST" (($-) 04 00) False -- Atlantic Standard Time (Canada)-    <|> zone "ALMT" (($+) 06 00) False -- Almaty Time-    <|> zone "ALMST" (($+) 07 00) False -- Almaty Summer Time-    <|> zone "AKST" (($-) 09 00) False -- Alaska Standard Time-    <|> zone "AKDT" (($-) 08 00) True -- Alaska Daylight-Saving Time-    <|> zone "AHST" (($-) 10 00) False -- Alaska/Hawaii Standard Time-    <|> zone "AFT" (($+) 04 30) False -- Afghanistan Time-    <|> zone "AEST" (($+) 10 00) False -- Australia Eastern Standard Time-    <|> zone "AESST" (($+) 11 00) False -- Australia Eastern Summer Standard Time-    <|> zone "ADT" (($-) 03 00) True -- Atlantic Daylight-Saving Time-    <|> zone "ACT" (($-) 05 00) False -- Atlantic/Porto Acre Standard Time-    <|> zone "ACST" (($-) 04 00) False -- Atlantic/Porto Acre Summer Time-    <|> zone "ACSST" (($+) 10 30) False -- Central Australia Summer Standard Time-  where-    zone name offset dst = TimeZone offset dst name <$ P.string (S.pack name)-    ($+) h m = h * 60 + m-    ($-) h m = negate (h * 60 + m)---- -------------------------------------------------------------------------- ----- Orphan Read Instances--instance Read UTCTime where-    readsPrec _ = readParen False $-        readsTime "%Y-%m-%d %H:%M:%S%Q %Z"-    {-# INLINEABLE readsPrec #-}---- -------------------------------------------------------------------------- ----- Orphan Show Instances--instance Show UTCTime where-    showsPrec _ = formatTimeS "%Y-%m-%d %H:%M:%S%Q %Z"--instance Show NominalDiffTime where-    showsPrec p (NominalDiffTime a) rest = showsPrec p a ('s' : rest)---- -------------------------------------------------------------------------- ----- Orphan Aeson instances--instance ToJSON UTCTime where-    toJSON t = String $ T.pack $ formatTime "%FT%T%QZ" t-    {-# INLINE toJSON #-}--instance FromJSON UTCTime where-    parseJSON = withText "UTCTime" $ \t ->-        case parseTime "%FT%T%QZ" (T.unpack t) of-          Just d -> pure d-          _      -> fail "could not parse ISO-8601 date"-    {-# INLINE parseJSON #-}---- -------------------------------------------------------------------------- ----- TimeParse Lenses--tpCentury :: Lens' TimeParse Int-tpCentury = lens _tpCentury (\a b -> a { _tpCentury = b })-{-# INLINE tpCentury #-}--tpCenturyYear :: Lens' TimeParse Int-tpCenturyYear = lens _tpCenturyYear (\a b -> a { _tpCenturyYear = b })-{-# INLINE tpCenturyYear #-}--tpMonth :: Lens' TimeParse Int-tpMonth = lens _tpMonth (\a b -> a { _tpMonth = b })-{-# INLINE tpMonth #-}--tpWeekOfYear :: Lens' TimeParse Int-tpWeekOfYear = lens _tpWeekOfYear (\a b -> a { _tpWeekOfYear = b })-{-# INLINE tpWeekOfYear #-}--tpDayOfMonth :: Lens' TimeParse Int-tpDayOfMonth = lens _tpDayOfMonth (\a b -> a { _tpDayOfMonth = b })-{-# INLINE tpDayOfMonth #-}--tpDayOfYear :: Lens' TimeParse Int-tpDayOfYear = lens _tpDayOfYear (\a b -> a { _tpDayOfYear = b })-{-# INLINE tpDayOfYear #-}--tpDayOfWeek :: Lens' TimeParse Int-tpDayOfWeek = lens _tpDayOfWeek (\a b -> a { _tpDayOfWeek = b })-{-# INLINE tpDayOfWeek #-}--tpFlags :: Lens' TimeParse Int-tpFlags = lens _tpFlags (\a b -> a { _tpFlags = b })-{-# INLINE tpFlags #-}--tpHour :: Lens' TimeParse Int-tpHour = lens _tpHour (\a b -> a { _tpHour = b })-{-# INLINE tpHour #-}--tpMinute :: Lens' TimeParse Int-tpMinute = lens _tpMinute (\a b -> a { _tpMinute = b })-{-# INLINE tpMinute #-}--tpSecond :: Lens' TimeParse Int-tpSecond = lens _tpSecond (\a b -> a { _tpSecond = b })-{-# INLINE tpSecond #-}--tpSecFrac :: Lens' TimeParse NominalDiffTime-tpSecFrac = lens _tpSecFrac (\a b -> a { _tpSecFrac = b })-{-# INLINE tpSecFrac #-}--tpPOSIXTime :: Lens' TimeParse NominalDiffTime-tpPOSIXTime = lens _tpPOSIXTime (\a b -> a { _tpPOSIXTime = b })-{-# INLINE tpPOSIXTime #-}--tpTimeZone :: Lens' TimeParse TimeZone-tpTimeZone = lens _tpTimeZone (\a b -> a { _tpTimeZone = b })-{-# INLINE tpTimeZone #-}-

@@ -1,97 +0,0 @@-{-# LANGUAGE Safe #-}--- |--- Module: Data.Time.Format.Locale--- Description : Short description--- Copyright   : (c) Kadena LLC, 2021---                   Ashley Yakeley and contributors, 2004-2021---                   The University of Glasgow 2001--- License     : MIT--- Maintainer  : Lars Kuhtz <lars@kadena.io>--- Stability   : experimental------ The code in this module is derived from time:Data.Time.Format.Locale. The--- code is included here in order to guarnatee binary stability of formated time--- values in Pact, even when the upstream code changes.------ The original code has the following Copyright and License:------ @--- TimeLib is Copyright (c) Ashley Yakeley and contributors, 2004-2021. All rights reserved.--- Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:------ - Redistributions of source code must retain the above copyright notice, this---   list of conditions and the following disclaimer.------ - Neither name of the copyright holders nor the names of its contributors may---   be used to endorse or promote products derived from this software without---   specific prior written permission.------ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"--- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE--- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE--- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR--- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF--- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS--- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN--- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)--- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE--- POSSIBILITY OF SUCH DAMAGE.--- @----module Data.Time.Format.Locale-( TimeLocale(..)-, defaultTimeLocale-) where--data TimeLocale = TimeLocale-    { wDays :: ![(String, String)]-        -- ^ full and abbreviated week days, starting with Sunday-    , months :: ![(String, String)]-        -- ^ full and abbreviated months-    , amPm :: !(String, String)-        -- ^ AM\/PM symbols-    , dateTimeFmt :: !String-    , dateFmt :: !String-    , timeFmt :: !String-    , time12Fmt :: !String-    }-    deriving (Eq, Ord, Show)---- | Locale representing American usage.----defaultTimeLocale :: TimeLocale-defaultTimeLocale = TimeLocale-    { wDays =-          [ ("Sunday", "Sun")-          , ("Monday", "Mon")-          , ("Tuesday", "Tue")-          , ("Wednesday", "Wed")-          , ("Thursday", "Thu")-          , ("Friday", "Fri")-          , ("Saturday", "Sat")-          ]-    , months =-          [ ("January", "Jan")-          , ("February", "Feb")-          , ("March", "Mar")-          , ("April", "Apr")-          , ("May", "May")-          , ("June", "Jun")-          , ("July", "Jul")-          , ("August", "Aug")-          , ("September", "Sep")-          , ("October", "Oct")-          , ("November", "Nov")-          , ("December", "Dec")-          ]-    , amPm = ("AM", "PM")-    , dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y"-    , dateFmt = "%m/%d/%y"-    , timeFmt = "%H:%M:%S"-    , time12Fmt = "%I:%M:%S %p"-    }-

@@ -1,316 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module: Data.Time.Internal--- Copyright: Copyright © 2021 Kadena LLC.--- License: MIT--- Maintainer: Lars Kuhtz <lars@kadena.io>--- Stability: experimental------ This is an internal module. No guarantee is provided regarding the stability--- of the functions in this module. Use at your own risk.----module Data.Time.Internal-(-  Micros-, Day---- * NominalDiffTime-, NominalDiffTime(..)-, toMicroseconds-, fromMicroseconds-, toSeconds-, fromSeconds-, nominalDay---- * UTCTime-, UTCTime(..)-, getCurrentTime-, day-, dayTime-, fromDayAndDayTime-, toPosixTimestampMicros-, fromPosixTimestampMicros-, mjdEpoch-, posixEpoch---- * Julian Dates-, ModifiedJulianDay(..)-, ModifiedJulianDate(..)-, toModifiedJulianDate-, fromModifiedJulianDate---- * Reexports-, AffineSpace(..)-, VectorSpace(..)-) where--import Control.DeepSeq--import Data.AdditiveGroup-import Data.AffineSpace-import Data.Decimal-import Data.Serialize-import Data.VectorSpace--import GHC.Generics hiding (from)-import GHC.Int (Int64)--import Lens.Micro---- internal modules--import Data.Time.System---- -------------------------------------------------------------------------- ----- Types for internal representations--type Micros = Int64-type Day = Int---- -------------------------------------------------------------------------- ----- Nominal Diff Time---- | A time interval as measured by UTC, that does not take leap-seconds into--- account.----newtype NominalDiffTime = NominalDiffTime { _microseconds :: Micros }-    deriving (Eq, Ord)-    deriving newtype (NFData)---- | Convert from 'NominalDiffTime' to a 64-bit representation of microseconds.----toMicroseconds :: NominalDiffTime -> Micros-toMicroseconds = _microseconds-{-# INLINE toMicroseconds #-}---- | Convert from a 64-bit representation of microseconds to 'NominalDiffTime'.----fromMicroseconds :: Micros -> NominalDiffTime-fromMicroseconds = NominalDiffTime-{-# INLINE fromMicroseconds #-}--instance AdditiveGroup NominalDiffTime where-    zeroV = NominalDiffTime 0-    NominalDiffTime a ^+^ NominalDiffTime b = NominalDiffTime (a + b)-    negateV (NominalDiffTime v) = NominalDiffTime (-v)-    NominalDiffTime a ^-^ NominalDiffTime b = NominalDiffTime (a - b)-    {-# INLINE zeroV #-}-    {-# INLINE (^+^) #-}-    {-# INLINE negateV #-}-    {-# INLINE (^-^) #-}--instance VectorSpace NominalDiffTime where-    type Scalar NominalDiffTime = Rational-    s *^ (NominalDiffTime m) = NominalDiffTime $ round (s * fromIntegral m)-    {-# INLINE (*^) #-}---- | Serializes 'NominalDiffTime' as 64-bit signed microseconds in little endian--- encoding.----instance Serialize NominalDiffTime where-    put (NominalDiffTime m) = putInt64le m-    get = NominalDiffTime <$> getInt64le-    {-# INLINE put #-}-    {-# INLINE get #-}---- | Convert from 'NominalDiffTime' to a 'Decimal' representation of seconds.----toSeconds :: NominalDiffTime -> Decimal-toSeconds (NominalDiffTime m) = realToFrac m / 1000000-{-# INLINE toSeconds #-}---- | Convert from 'Decimal' representation of seconds to 'NominalDiffTime'.------ The result is rounded using banker's method, i.e. remainders of 0.5 a rounded--- to the next even integer.----fromSeconds :: Decimal -> NominalDiffTime-fromSeconds d = NominalDiffTime $ round $ d * 1000000-{-# INLINE fromSeconds #-}---- | The nominal length of a day: precisely 86400 SI seconds.----nominalDay :: NominalDiffTime-nominalDay = NominalDiffTime $ 86400 * 1000000-{-# INLINE nominalDay #-}--toPosixTimestampMicros :: UTCTime -> Micros-toPosixTimestampMicros = toTimestampMicros . toPosix-{-# INLINE toPosixTimestampMicros #-}--fromPosixTimestampMicros :: Micros -> UTCTime-fromPosixTimestampMicros = fromPosix . fromTimestampMicros-{-# INLINE fromPosixTimestampMicros #-}---- -------------------------------------------------------------------------- ----- UTCTime---- | UTCTime with microseconds precision. Internally it is represented as 64-bit--- count nominal microseconds since MJD Epoch.------ This implementation ignores leap seconds. Time differences are  measured as--- nominal time, with a nominal day having exaxtly @24 * 60 * 60@ SI seconds. As--- a consequence the difference between two dates as computed by this module is--- generally equal or smaller than what is actually measured by a clock.----newtype UTCTime = UTCTime { _utcTime :: NominalDiffTime }-    deriving (Eq, Ord)-    deriving (Generic)-    deriving newtype (NFData)-    deriving newtype (Serialize)--instance AffineSpace UTCTime where-    type Diff UTCTime = NominalDiffTime-    UTCTime a .-. UTCTime b = a ^-^ b-    UTCTime a .+^ b = UTCTime (a ^+^ b)-    {-# INLINE (.-.) #-}-    {-# INLINE (.+^) #-}--getCurrentTime :: IO UTCTime-getCurrentTime = UTCTime . (^+^ _utcTime posixEpoch) . _posixTime-    <$> getPOSIXTime-{-# INLINE getCurrentTime #-}---- | The date of a UTCTime value represented as modified Julian 'Day'.----day :: Lens' UTCTime ModifiedJulianDay-day = lens-    (_mjdDay . toModifiedJulianDate)-    (\a b -> fromModifiedJulianDate . set mjdDay b $ toModifiedJulianDate a)-{-# INLINE day #-}---- | The day time of a 'UTCTime' value represented as 'NominalDiffTime' since--- @00:00:00@ of that respective day.----dayTime :: Lens' UTCTime NominalDiffTime-dayTime = lens-    (_mjdTime . toModifiedJulianDate)-    (\a b -> fromModifiedJulianDate . set mjdTime b $ toModifiedJulianDate a)-{-# INLINE dayTime #-}---- | Create a 'UTCTime' from a date and a daytime. The date is represented--- as modified Julian 'Day' and the day time is represented as--- 'NominalDiffTime' since '00:00:00' of the respective day.------ Note that this implementation does not support representation of leap--- seconds.----fromDayAndDayTime :: ModifiedJulianDay -> NominalDiffTime -> UTCTime-fromDayAndDayTime d t = fromModifiedJulianDate $ ModifiedJulianDate d t-{-# INLINE fromDayAndDayTime #-}---- | The POSIX Epoch represented as UTCTime.----posixEpoch :: UTCTime-posixEpoch = UTCTime (fromIntegral d *^ nominalDay)-  where-    ModifiedJulianDay d = posixEpochDay-{-# INLINE posixEpoch #-}---- | The Epoch of the modified Julian day represented as 'UTCTime'.----mjdEpoch :: UTCTime-mjdEpoch = UTCTime zeroV-{-# INLINE mjdEpoch #-}---- -------------------------------------------------------------------------- ----- POSIX Timestamps---- | POSIX time is the nominal time since 1970-01-01 00:00 UTC. It is--- represented as 64-bit count of microseconds.------ Users who only need POSIX timestamps can ignore this type and just use--- 'UTCTime' with 'toPosxiTimestampMicros' and 'fromPosixTimestampMicros'.----newtype POSIXTime = POSIXTime { _posixTime :: NominalDiffTime }-    deriving (Eq, Ord)-    deriving newtype (NFData)---- | Represent POSIXTime as 64-bit value of microseconds since 'posixEpoch'.----toTimestampMicros :: POSIXTime -> Micros-toTimestampMicros = _microseconds . _posixTime-{-# INLINE toTimestampMicros #-}---- | Create POSIXTime from 64-bit value of microseconds since 'posixEpoch'.----fromTimestampMicros :: Micros -> POSIXTime-fromTimestampMicros = POSIXTime . fromMicroseconds-{-# INLINE fromTimestampMicros #-}---- | The day of the epoch of 'SystemTime', 1970-01-01----posixEpochDay :: ModifiedJulianDay-posixEpochDay = ModifiedJulianDay 40587-{-# INLINE posixEpochDay #-}---- | Get current POSIX time----getPOSIXTime :: IO POSIXTime-getPOSIXTime = POSIXTime . NominalDiffTime . fromIntegral <$> getSystemTimeMicros-{-# INLINE getPOSIXTime #-}---- The following conversions between POSIXTime and UTCTime are efficient because--- all constants are inlined.---- | Convert from UTCTime to POSIXTime----toPosix :: UTCTime -> POSIXTime-toPosix t = POSIXTime $ _utcTime t ^-^ _utcTime posixEpoch-{-# INLINE toPosix #-}---- | Convert from POSIXTime to UTCTime----fromPosix :: POSIXTime -> UTCTime-fromPosix p = UTCTime $ _posixTime p ^+^ _utcTime posixEpoch-{-# INLINE fromPosix #-}---- -------------------------------------------------------------------------- ----- Modified Julian Day Representation of UTC--newtype ModifiedJulianDay = ModifiedJulianDay Day-    deriving newtype (Eq, Ord, NFData)---- | Modified Julian Day Representation of UTC----data ModifiedJulianDate = ModifiedJulianDate-    { _mjdDay :: !ModifiedJulianDay-    , _mjdTime :: !NominalDiffTime-    }-    deriving (Eq, Ord, Generic)-    deriving anyclass (NFData)--mjdDay :: Lens' ModifiedJulianDate ModifiedJulianDay-mjdDay = lens _mjdDay $ \a b -> a { _mjdDay = b }-{-# INLINE mjdDay #-}--mjdTime :: Lens' ModifiedJulianDate NominalDiffTime-mjdTime = lens _mjdTime $ \a b -> a { _mjdTime = b }-{-# INLINE mjdTime #-}---- | Convert from 'UTCTime' to modified 'Julian' Day time.----toModifiedJulianDate :: UTCTime -> ModifiedJulianDate-toModifiedJulianDate (UTCTime (NominalDiffTime m)) = ModifiedJulianDate-    (ModifiedJulianDay (fromIntegral d))-    (NominalDiffTime t)-  where-    (d, t) = divMod m n-    NominalDiffTime n = nominalDay-{-# INLINE toModifiedJulianDate #-}---- | Convert from modified 'Julian' Day time to 'UTCTime'.----fromModifiedJulianDate :: ModifiedJulianDate -> UTCTime-fromModifiedJulianDate (ModifiedJulianDate (ModifiedJulianDay d) t)-    = UTCTime $ (fromIntegral d *^ nominalDay) ^+^ t-{-# INLINE fromModifiedJulianDate #-}-

@@ -1,37 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module: Data.Time.System--- Copyright: Copyright © 2021 Kadena LLC.--- License: MIT--- Maintainer: Lars Kuhtz <lars@kadena.io>--- Stability: experimental------ Returns the time of the system clock as 64-bit value that counts microseconds--- since the POSIX epoch.----module Data.Time.System-( getSystemTimeMicros-) where--import Data.Int (Int64)--#if WITH_TIME-import qualified Data.Time.Clock.POSIX (getPOSIXTime)-#else-import System.Clock (getTime, TimeSpec(..), Clock(Realtime))-#endif--getSystemTimeMicros :: IO Int64-getSystemTimeMicros = do--#if WITH_TIME-    s <- Data.Time.Clock.POSIX.getPOSIXTime-    return $ round $ s * 1000000-#else-    TimeSpec s ns <- getTime Realtime-    return $ (s * 1000000) + (ns `quot` 1000)-#endif--{-# INLINE getSystemTimeMicros #-}-

@@ -0,0 +1,57 @@+{-# LANGUAGE CPP #-}++-- |+-- Module: Pact.Time+-- Copyright: Copyright © 2021 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- A minimal time library for usage with the [Pact Smart Contract+-- Language](https://github.com/kadena-io/pact/).+--+-- The focus of this library is on minimality, performance, and binary level+-- stability. Time is represented as 64-bit integral value that counts nominal+-- micro-seconds since the modified Julian date epoch (MJD). The implementation+-- ignores leap seconds.+--+-- While the library can parse date-time values with time zones, internally all+-- date-times are represented as UTC and formatting only supports UTC. Only the+-- default English language locale is supported.+--+-- Details about supported formats can be found in the [Pact Language+-- Reference](https://pact-language.readthedocs.io/en/stable/pact-reference.html#time-formats).+--+module Pact.Time+(+-- * NominalDiffTime+  NominalDiffTime(..)+, toMicroseconds+, fromMicroseconds+, toSeconds+, fromSeconds+, nominalDay++-- * UTCTime+, UTCTime+, getCurrentTime+, day+, dayTime+, fromDayAndDayTime+, toPosixTimestampMicros+, fromPosixTimestampMicros+, posixEpoch+, mjdEpoch++-- * Formatting and Parsing+, parseTime+, formatTime++-- * Reexports+, AffineSpace(..)+, VectorSpace(..)+) where++import Pact.Time.Format+import Pact.Time.Internal+

@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}++-- |+-- Module: Pact.Time.Format+-- Copyright: Copyright © 2021 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- TODO+--+module Pact.Time.Format+(+-- * Formatting and Parsing+  parseTime+, formatTime+) where++#if WITH_TIME+import Pact.Time.Format.External+#else+import Pact.Time.Format.Internal+#endif+

@@ -0,0 +1,148 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Pact.Time.Format.External+-- Copyright: Copyright © 2021 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- TODO+--+module Pact.Time.Format.External+(+-- * Formatting and Parsing+  parseTime+, formatTime+) where++import Data.Aeson+import qualified Data.Time as T++import Text.Read (readPrec)++-- internal modules++import Pact.Time.Internal++-- -------------------------------------------------------------------------- --+-- Internal Utils++toUtcTime :: UTCTime -> T.UTCTime+toUtcTime t = T.UTCTime (T.ModifiedJulianDay (fromIntegral d)) $ realToFrac dt / 1000000+  where+    ModifiedJulianDate (ModifiedJulianDay d) (NominalDiffTime dt)+        = toModifiedJulianDate t++fromUtcTime :: T.UTCTime -> UTCTime+fromUtcTime (T.UTCTime (T.ModifiedJulianDay d) t) = fromModifiedJulianDate+    $ ModifiedJulianDate (ModifiedJulianDay (fromIntegral d)) (NominalDiffTime $ round (t * 1000000))++-- -------------------------------------------------------------------------- --+-- Formatting and Parsing++-- | Parse a 'UTCTime' using the supplied format string.+--+-- Please refer to the [Pact Language+-- Reference](https://pact-language.readthedocs.io/en/stable/pact-reference.html#time-formats) for details on the+-- supported format strings.+--+#if MIN_VERSION_time(1,9,0)+parseTime :: MonadFail m => String -> String -> m UTCTime+#else+parseTime :: String -> String -> Maybe UTCTime+#endif+parseTime format = fmap fromUtcTime . parseTime_ T.defaultTimeLocale format+{-# INLINE parseTime #-}++-- | Format a 'UTCTime' value using the supplied format string.+--+-- Please refer to the [Pact Language+-- Reference](https://pact-language.readthedocs.io/en/stable/pact-reference.html#time-formats) for details on the+-- supported format strings.+--+formatTime :: String -> UTCTime -> String+formatTime format = formatTime_ T.defaultTimeLocale format . toUtcTime+{-# INLINE formatTime #-}++-- -------------------------------------------------------------------------- --+-- Inherited instances++-- | The 'Show' instance is inherited from the "official" time package.+--+instance Show NominalDiffTime where+    show = show @T.NominalDiffTime . realToFrac . toSeconds+    {-# INLINE show #-}++-- | The 'Show' instance is inherited from the "official" time package.+--+instance Show UTCTime where+    show = show . toUtcTime+    {-# INLINE show #-}++-- | The 'Read' instance is inherited from the "official" time package.+--+instance Read UTCTime where+    readPrec = fromUtcTime <$> readPrec+    {-# INLINE readPrec #-}++-- | The 'ToJSON' instance is inherited from the instance of 'T.UTCTime' from+-- the "official" time package.+--+instance ToJSON UTCTime where+    toJSON = toJSON . toUtcTime+    {-# INLINE toJSON #-}++-- | The 'FromJSON' instance is inherited from the instance of 'T.UTCTime' from+-- the "official" time package.+--+instance FromJSON UTCTime where+    parseJSON = fmap fromUtcTime . parseJSON+    {-# INLINE parseJSON #-}++-- -------------------------------------------------------------------------- --+-- Ported Implementations from Time++#if MIN_VERSION_time(1,9,0)+parseTime_ :: MonadFail m => T.TimeLocale -> String -> String -> m T.UTCTime+#else+parseTime_ :: T.TimeLocale -> String -> String -> Maybe T.UTCTime+#endif+parseTime_ locale formatStr = T.parseTimeM False locale (mapFormat formatStr)+    where+    mapFormat ('%':'%':t) = "%%" <> mapFormat t+    mapFormat ('.':'%':'v':t) = "%Q" <> mapFormat t+    mapFormat ('%':'N':t) = "%z" <> mapFormat t+    mapFormat [] = []+    mapFormat (h:t) = h : mapFormat t++formatTime_ :: T.TimeLocale -> String -> T.UTCTime -> String+#if MIN_VERSION_time(1,9,0)+formatTime_ locale formatStr = T.formatTime locale (mapFormat formatStr)+  where+    mapFormat ('%':'%':t) = "%%" <> mapFormat t+    mapFormat ('%':'v':t) = "%6q" <> mapFormat t+    mapFormat ('%':'N':t) = "%Ez" <> mapFormat t+    mapFormat [] = []+    mapFormat (h:t) = h : mapFormat t+#else+formatTime_ locale formatStr timeValue = concat . snd $ go0 formatStr+  where+    format f = T.formatTime locale f timeValue+    n = let (h,m) = splitAt 3 $ format "%z" in h <> ":" <> m+    v = format "%6q"++    go0 s = let (a, b) = go1 s in ("", format a : b)++    go1 ('%':'%':t) = let (a, b) = go1 t in ("", "%" : format a : b)+    go1 ('%':'v':t) = let (a, b) = go1 t in ("", v : format a : b)+    go1 ('%':'N':t) = let (a, b) = go1 t in ("", n : format a : b)+    go1 (h:t) = let (a, b) = go1 t in (h:a, b)+    go1 "" = ("", [])+#endif+

@@ -0,0 +1,1240 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Pact.Time.Format.Internal+-- Copyright: Copyright © 2021 Kadena LLC.+--                      © 2013−2014 Liyang HU Liyang HU+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- The code in this module is derived from various modules of the thyme package,+-- which is copyright (c) 2013 Liyang HU and distributed under a BSD3 license.+--+module Pact.Time.Format.Internal+( formatTime+, parseTime+, readTime+, readsTime+) where++import Control.Applicative+import Control.Monad.State.Strict++import Data.Aeson (FromJSON(..), ToJSON(..), withText, Value(String))+import Data.Attoparsec.ByteString.Char8 (Parser, Result, IResult (..))+import qualified Data.Attoparsec.ByteString.Char8 as P+import Data.Bits+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy as L+import Data.Char+import Data.Int+import qualified Data.Text as T+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.Vector.Unboxed as VU+import Data.VectorSpace++import Lens.Micro++-- internal modules++import Pact.Time.Internal+import Pact.Time.Format.Locale++-- -------------------------------------------------------------------------- --+-- Lens Utils (from microlens-mtl)++infix 4 .=++(.=) :: MonadState s m => ASetter s s a b -> b -> m ()+l .= x = modify (l .~ x)+{-# INLINE (.=) #-}++assign :: MonadState s m => ASetter s s a b -> b -> m ()+assign l x = l .= x+{-# INLINE assign #-}++-- -------------------------------------------------------------------------- --+-- Misc Utils++shows02 :: Int -> ShowS+shows02 n = if n < 10 then (:) '0' . shows n else shows n+{-# INLINE shows02 #-}++shows_2 :: Int -> ShowS+shows_2 n = if n < 10 then (:) ' ' . shows n else shows n+{-# INLINE shows_2 #-}++shows03 :: Int -> ShowS+shows03 n+    | n < 10 = (++) "00" . shows n+    | n < 100 = (++) "0" . shows n+    | otherwise = shows n+{-# INLINE shows03 #-}++showsYear :: Int -> ShowS+showsYear n@(abs -> u)+    | u < 10 = neg . (++) "000" . shows u+    | u < 100 = neg . (++) "00" . shows u+    | u < 1000 = neg . (++) "0" . shows u+    | otherwise = neg . shows u+  where+    neg = if n < 0 then (:) '-' else id+{-# INLINE showsYear #-}++fills06 :: Micros -> ShowS+fills06 n+    | n < 10 = (++) "00000"+    | n < 100 = (++) "0000"+    | n < 1000 = (++) "000"+    | n < 10000 = (++) "00"+    | n < 100000 = (++) "0"+    | otherwise = id+{-# INLINE fills06 #-}++drops0 :: Micros -> ShowS+drops0 n = case divMod n 10 of+    (q, 0) -> drops0 q+    _ -> shows n+{-# INLINE drops0 #-}++-- -------------------------------------------------------------------------- --+-- Misc Types++-- Unbounded+type UnboundedInt = Int++type Minutes = UnboundedInt+type Days = UnboundedInt+type Year = UnboundedInt+type Century = UnboundedInt++-- Bounded+type BoundedInt = Int++type Hour = BoundedInt+type Minute = BoundedInt+type Second = BoundedInt+type Month = BoundedInt+type DayOfMonth = BoundedInt+type DayOfYear = BoundedInt+type DayOfWeek = BoundedInt+type WeekOfYear = BoundedInt++-- -------------------------------------------------------------------------- --+-- Year Month Day++data YearMonthDay = YearMonthDay+    { _ymdYear :: {-# UNPACK #-} !Year+    , _ymdMonth :: {-# UNPACK #-} !Month+    , _ymdDay :: {-# UNPACK #-} !DayOfMonth+    }++ymdFromOrdinal :: OrdinalDate -> YearMonthDay+ymdFromOrdinal (OrdinalDate y yd) = YearMonthDay y m d+  where+    MonthDay m d = monthDaysFromDayOfYear (isLeapYear y) yd+{-# INLINEABLE ymdFromOrdinal #-}++ymdToOrdinal :: YearMonthDay -> OrdinalDate+ymdToOrdinal (YearMonthDay y m d) = OrdinalDate y $+    monthDaysToDayOfYear (isLeapYear y) (MonthDay m d)++{-# INLINEABLE ymdToOrdinal #-}++toGregorian :: YearMonthDay -> ModifiedJulianDay+toGregorian = fromOrdinalDate . ymdToOrdinal+{-# INLINEABLE toGregorian #-}++-- -------------------------------------------------------------------------- --+-- Ordinal Dates++data OrdinalDate = OrdinalDate+    { _odYear :: {-# UNPACK #-} !Year+    , _odDay :: {-# UNPACK #-} !DayOfYear+    }++-- | Gregorian leap year?+isLeapYear :: Year -> Bool+isLeapYear y = y .&. 3 == 0 && (r100 /= 0 || q100 .&. 3 == 0)+  where+    (q100, r100) = y `quotRem` 100++toOrdinalDate :: ModifiedJulianDay -> OrdinalDate+toOrdinalDate (ModifiedJulianDay mjd)+    | dayB0 <= 0 = case toOrdB0 dayInQC of+        OrdinalDate y yd -> OrdinalDate (y + quadCent * 400) yd+    | otherwise = toOrdB0 dayB0+  where+    dayB0 = mjd + 678575+    (quadCent, dayInQC) = dayB0 `divMod` 146097++    -- Input: days since 1-1-1. Precondition: has to be positive!+    toOrdB0 dB0 = res+      where+        (y0, r) = (400 * dB0) `quotRem` 146097+        d0 = dayInYear y0 dB0+        d1 = dayInYear (y0 + 1) dB0+        res = if r > 146097 - 600 && d1 > 0+                then OrdinalDate (y0 + 1 + 1) d1+                else OrdinalDate (y0 + 1) d0+    {-# INLINE toOrdB0 #-}++    -- Input: (year - 1) (day as days since 1-1-1)+    -- Precondition: year is positive!+    dayInYear y0 dB0 = dB0 - 365 * y0 - leaps + 1+      where+        leaps = y0 `shiftR` 2 - centuries + centuries `shiftR` 2+        centuries = y0 `quot` 100+    {-# INLINE dayInYear #-}+{-# INLINEABLE toOrdinalDate #-}+++fromOrdinalDate :: OrdinalDate -> ModifiedJulianDay+fromOrdinalDate (OrdinalDate year yd) = ModifiedJulianDay mjd+  where+    years = year - 1+    centuries = years `div` 100+    leaps = years `shiftR` 2 - centuries + centuries `shiftR` 2+    mjd = 365 * years + leaps - 678576+        + clip 1 (if isLeapYear year then 366 else 365) yd+    clip a b = max a . min b+{-# INLINEABLE fromOrdinalDate #-}++-- -------------------------------------------------------------------------- --+-- Months++monthLengths :: VU.Vector Days+monthLengths     = VU.fromList [31,28,31,30,31,30,31,31,30,31,30,31]+{-# NOINLINE monthLengths #-}++monthLengthsLeap :: VU.Vector Days+monthLengthsLeap = VU.fromList [31,29,31,30,31,30,31,31,30,31,30,31]+{-# NOINLINE monthLengthsLeap #-}++monthDays :: VU.Vector ({-Month-}Int8, {-DayOfMonth-}Int8)+monthDays = VU.generate 365 go+  where+    dom01 = VU.prescanl' (+) 0 monthLengths+    go yd = (fromIntegral m, fromIntegral d)+      where+        m = maybe 12 id $ VU.findIndex (yd <) dom01+        d = succ yd - VU.unsafeIndex dom01 (pred m)+{-# NOINLINE monthDays #-}++monthDaysLeap :: VU.Vector ({-Month-}Int8, {-DayOfMonth-}Int8)+monthDaysLeap = VU.generate 366 go+  where+    dom01 = VU.prescanl' (+) 0 monthLengthsLeap+    go yd = (fromIntegral m, fromIntegral d)+      where+        m = maybe 12 id $ VU.findIndex (yd <) dom01+        d = succ yd - VU.unsafeIndex dom01 (pred m)+{-# NOINLINE monthDaysLeap #-}++data MonthDay = MonthDay+    { _mdMonth :: {-# UNPACK #-} !Month+    , _mdDay :: {-# UNPACK #-} !DayOfMonth+    }++monthDaysFromDayOfYear :: Bool -> DayOfYear -> MonthDay+monthDaysFromDayOfYear leap yd = MonthDay m d+  where+    i = max 0 . min lastDay $ pred yd+    (fromIntegral -> m, fromIntegral -> d) = VU.unsafeIndex table i+    (lastDay, table) = if leap+      then (365, monthDaysLeap)+      else (364, monthDays)+{-# INLINE monthDaysFromDayOfYear #-}++monthDaysToDayOfYear :: Bool -> MonthDay -> DayOfYear+monthDaysToDayOfYear leap (MonthDay month mday) = div (367 * m - 362) 12 + k + d+  where+    m = max 1 . min 12 $ month+    l = VU.unsafeIndex lengths (pred m)+    d = max 1 . min l $ mday+    k = if m <= 2 then 0 else ok++    (lengths, ok) = if leap+      then (monthLengthsLeap, -1)+      else (monthLengths, -2)+{-# INLINE monthDaysToDayOfYear #-}++-- -------------------------------------------------------------------------- --+-- Week Date++data WeekDate = WeekDate+    { _wdYear :: {-# UNPACK #-} !Year+    , _wdWeek :: {-# UNPACK #-} !WeekOfYear+    , _wdDay :: {-# UNPACK #-} !DayOfWeek+    }++toWeekDate :: ModifiedJulianDay -> WeekDate+toWeekDate = join (toWeekOrdinal . toOrdinalDate)+{-# INLINEABLE toWeekDate #-}++fromWeekDate :: WeekDate -> ModifiedJulianDay+fromWeekDate wd@(WeekDate y _ _) = fromWeekLast (lastWeekOfYear y) wd+{-# INLINEABLE fromWeekDate #-}++toWeekOrdinal :: OrdinalDate -> ModifiedJulianDay -> WeekDate+toWeekOrdinal (OrdinalDate y0 yd) (ModifiedJulianDay mjd) =+    WeekDate y1 (w1 + 1) (d7mod + 1)+  where+    -- pilfered and refactored; no idea what foo and bar mean+    d = mjd + 2+    (d7div, d7mod) = divMod d 7++    -- foo :: Year -> {-WeekOfYear-1-}Int+    foo y = bar $ fromOrdinalDate $ OrdinalDate y 6++    -- bar :: ModifiedJulianDay -> {-WeekOfYear-1-}Int+    bar (ModifiedJulianDay k) = d7div - div k 7++    w0 = bar $ ModifiedJulianDay (d - yd + 4)+    (y1, w1) = case w0 of+        -1 -> (y0 - 1, foo (y0 - 1))+        52 | foo (y0 + 1) == 0 -> (y0 + 1, 0)+        _ -> (y0, w0)+{-# INLINE toWeekOrdinal #-}++lastWeekOfYear :: Year -> WeekOfYear+lastWeekOfYear y = if _wdWeek wd == 53 then 53 else 52+  where+    wd = toWeekDate $ fromOrdinalDate $ OrdinalDate y 365+{-# INLINE lastWeekOfYear #-}++fromWeekLast :: WeekOfYear -> WeekDate -> ModifiedJulianDay+fromWeekLast wMax (WeekDate y w d) = ModifiedJulianDay mjd+  where+    -- pilfered and refactored+    ModifiedJulianDay k = fromOrdinalDate $ OrdinalDate y 6+    mjd = k - mod k 7 - 10 + clip 1 7 d + clip 1 wMax w * 7+    clip a b = max a . min b+{-# INLINE fromWeekLast #-}++-- -------------------------------------------------------------------------- --+-- Sunday Weeks++-- | Weeks numbered from 0 to 53, starting with the first Sunday of the year+-- as the first day of week 1. The last week of a given year and week 0 of+-- the next both refer to the same week, but not all 'DayOfWeek' are valid.+-- 'Year' coincides with that of 'gregorian'.+--+data SundayWeek = SundayWeek+    { _swYear :: {-# UNPACK #-} !Year+    , _swWeek :: {-# UNPACK #-} !WeekOfYear+    , _swDay :: {-# UNPACK #-} !DayOfWeek+    }++fromSundayWeek :: SundayWeek -> ModifiedJulianDay+fromSundayWeek (SundayWeek y w d) = ModifiedJulianDay (firstDay + yd)+  where+    ModifiedJulianDay firstDay = fromOrdinalDate $ OrdinalDate y 1+    -- following are all 0-based year days+    firstSunday = mod (4 - firstDay) 7+    yd = firstSunday + 7 * (w - 1) + d+{-# INLINEABLE fromSundayWeek #-}++toSundayOrdinal :: OrdinalDate -> ModifiedJulianDay -> SundayWeek+toSundayOrdinal (OrdinalDate y yd) (ModifiedJulianDay mjd) =+    SundayWeek y (d7div - div k 7) d7mod+  where+    d = mjd + 3+    k = d - yd+    (d7div, d7mod) = divMod d 7+{-# INLINE toSundayOrdinal #-}++-- -------------------------------------------------------------------------- --+-- Monaday Weeks++-- | Weeks numbered from 0 to 53, starting with the first Monday of the year+-- as the first day of week 1. The last week of a given year and week 0 of+-- the next both refer to the same week, but not all 'DayOfWeek' are valid.+-- 'Year' coincides with that of 'gregorian'.+--+data MondayWeek = MondayWeek+    { _mwYear :: {-# UNPACK #-} !Year+    , _mwWeek :: {-# UNPACK #-} !WeekOfYear+    , _mwDay :: {-# UNPACK #-} !DayOfWeek+    }++fromMondayWeek :: MondayWeek -> ModifiedJulianDay+fromMondayWeek (MondayWeek y w d) = ModifiedJulianDay (firstDay + yd)+  where+    ModifiedJulianDay firstDay = fromOrdinalDate $ OrdinalDate y 1+    -- following are all 0-based year days+    firstMonday = mod (5 - firstDay) 7+    yd = firstMonday + 7 * (w - 1) + d - 1+{-# INLINEABLE fromMondayWeek #-}++toMondayOrdinal :: OrdinalDate -> ModifiedJulianDay -> MondayWeek+toMondayOrdinal (OrdinalDate y yd) (ModifiedJulianDay mjd) =+    MondayWeek y (d7div - div k 7) (d7mod + 1)+  where+    d = mjd + 2+    k = d - yd+    (d7div, d7mod) = divMod d 7+{-# INLINE toMondayOrdinal #-}++-- -------------------------------------------------------------------------- --+-- Time Of Day++data TimeOfDay = TimeOfDay+    { _todHour :: {-# UNPACK #-} !Hour+    , _todMin :: {-# UNPACK #-} !Minute+    , _todSec :: {-# UNPACK #-} !NominalDiffTime+    }++timeOfDayFromNominalDiffTime :: NominalDiffTime -> TimeOfDay+timeOfDayFromNominalDiffTime (NominalDiffTime t) = TimeOfDay+    (fromIntegral h) (fromIntegral m) (NominalDiffTime s)+  where+    (h, ms) = quotRem t 3600000000+    (m, s) = quotRem ms 60000000+{-# INLINEABLE timeOfDayFromNominalDiffTime #-}++-- -------------------------------------------------------------------------- --+-- Format Time++class FormatTime t where+    showsTime :: t -> (Char -> ShowS) -> Char -> ShowS++formatTime :: (FormatTime t) => String -> t -> String+formatTime spec t = formatTimeS spec t ""+{-# INLINEABLE formatTime #-}++formatTimeS :: (FormatTime t) => String -> t -> ShowS+formatTimeS spec t = go spec+  where+    -- leave unrecognised codes as they are+    format = showsTime t (\c s -> '%' : c : s)+    go s = case s of+        '%' : c : rest -> case c of+            -- aggregate+            'c' -> go (dateTimeFmt l ++ rest)+            'r' -> go (time12Fmt l ++ rest)+            'X' -> go (timeFmt l ++ rest)+            'x' -> go (dateFmt l ++ rest)+            -- modifier (whatever)+            '-' -> go ('%' : rest)+            '_' -> go ('%' : rest)+            '0' -> go ('%' : rest)+            '^' -> go ('%' : rest)+            '#' -> go ('%' : rest)+            -- escape (why would anyone need %t and %n?)+            '%' -> (:) '%' . go rest+            -- default+            _ -> format c . go rest+        c : rest -> (:) c . go rest+        [] -> id+      where+        l = defaultTimeLocale+{-# INLINEABLE formatTimeS #-}++instance FormatTime TimeOfDay where+    showsTime (TimeOfDay h m (NominalDiffTime s)) = \ def c -> case c of+        -- aggregate+        'R' -> shows02 h . (:) ':' . shows02 m+        'T' -> shows02 h . (:) ':' . shows02 m . (:) ':' . shows02 si+        -- AM/PM+        'P' -> (++) $ toLower <$> if h < 12 then fst amPm else snd amPm+        'p' -> (++) $ if h < 12 then fst amPm else snd amPm+        -- Hour+        'H' -> shows02 h+        'I' -> shows02 $ 1 + mod (h - 1) 12+        'k' -> shows_2 h+        'l' -> shows_2 $ 1 + mod (h - 1) 12+        -- Minute+        'M' -> shows02 m+        -- Second+        'S' -> shows02 si++        -- TODO: Unsupported by Pact+        'q' -> fills06 su . shows su . (++) "000000"++        'v' -> fills06 su . shows su+        'Q' -> if su == 0 then id else (:) '.' . fills06 su . drops0 su+        -- default+        _ -> def c+      where+        (fromIntegral -> si, su) = quotRem s 1000000+        TimeLocale {..} = defaultTimeLocale+    {-# INLINEABLE showsTime #-}++instance FormatTime SundayWeek where+    showsTime (SundayWeek y w d) = \ def c -> case c of+        -- Year+        'Y' -> showsYear y+        'y' -> shows02 (mod y 100)+        'C' -> shows02 (div y 100)+        -- WeekOfYear+        'U' -> shows02 w+        -- DayOfWeek+        'u' -> shows $ if d == 0 then 7 else d+        'w' -> shows $ if d == 7 then 0 else d+        'A' -> (++) . fst $ wDays !! mod d 7+        'a' -> (++) . snd $ wDays !! mod d 7+        -- default+        _ -> def c+      where+        TimeLocale {..} = defaultTimeLocale+    {-# INLINEABLE showsTime #-}++instance FormatTime MondayWeek where+    showsTime (MondayWeek y w d) = \ def c -> case c of+        -- Year+        'Y' -> showsYear y+        'y' -> shows02 (mod y 100)+        'C' -> shows02 (div y 100)+        -- WeekOfYear+        'W' -> shows02 w+        -- DayOfWeek+        'u' -> shows $ if d == 0 then 7 else d+        'w' -> shows $ if d == 7 then 0 else d+        'A' -> (++) . fst $ wDays !! mod d 7+        'a' -> (++) . snd $ wDays !! mod d 7+        -- default+        _ -> def c+      where+        TimeLocale {..} = defaultTimeLocale+    {-# INLINEABLE showsTime #-}++instance FormatTime WeekDate where+    showsTime (WeekDate y w d) = \ def c -> case c of+        -- Year+        'G' -> showsYear y+        'g' -> shows02 (mod y 100)+        'f' -> shows02 (div y 100)+        -- WeekOfYear+        'V' -> shows02 w+        -- DayOfWeek+        'u' -> shows $ if d == 0 then 7 else d+        'w' -> shows $ if d == 7 then 0 else d+        'A' -> (++) . fst $ wDays !! mod d 7+        'a' -> (++) . snd $ wDays !! mod d 7+        -- default+        _ -> def c+      where+        TimeLocale {..} = defaultTimeLocale+    {-# INLINEABLE showsTime #-}++instance FormatTime YearMonthDay where+    showsTime (YearMonthDay y m d) def c = case c of+        -- aggregate+        'D' -> shows02 m . (:) '/' . shows02 d . (:) '/' . shows02 (mod y 100)+        'F' -> showsYear y . (:) '-' . shows02 m . (:) '-' . shows02 d+        -- Year+        'Y' -> showsYear y+        'y' -> shows02 (mod y 100)+        'C' -> shows02 (div y 100)+        -- Month+        'B' -> (++) . fst $ months !! (m - 1)+        'b' -> (++) . snd $ months !! (m - 1)+        'h' -> (++) . snd $ months !! (m - 1)+        'm' -> shows02 m+        -- DayOfMonth+        'd' -> shows02 d+        'e' -> shows_2 d+        -- default+        _ -> def c+      where+        TimeLocale {..} = defaultTimeLocale+    {-# INLINEABLE showsTime #-}++instance FormatTime MonthDay where+    showsTime (MonthDay m d) def c = case c of+        -- Month+        'B' -> (++) . fst $ months !! (m - 1)+        'b' -> (++) . snd $ months !! (m - 1)+        'h' -> (++) . snd $ months !! (m - 1)+        'm' -> shows02 m+        -- DayOfMonth+        'd' -> shows02 d+        'e' -> shows_2 d+        -- default+        _ -> def c+      where+        TimeLocale {..} = defaultTimeLocale+    {-# INLINEABLE showsTime #-}++instance FormatTime OrdinalDate where+    showsTime (OrdinalDate y d) def c = case c of+        -- Year+        'Y' -> showsYear y+        'y' -> shows02 (mod y 100)+        'C' -> shows02 (div y 100)+        -- DayOfYear+        'j' -> shows03 d+        -- default+        _ -> def c+    {-# INLINEABLE showsTime #-}++-- | Format Date that is represented as 'ModifiedJulianDay'+--+instance FormatTime ModifiedJulianDay where+    showsTime d@(toOrdinalDate -> ordinal)+        = showsTime ordinal+        . showsTime (ymdFromOrdinal ordinal)+        . showsTime (toWeekOrdinal ordinal d)+        . showsTime (toSundayOrdinal ordinal d)+        . showsTime (toMondayOrdinal ordinal d)+    {-# INLINEABLE showsTime #-}++instance FormatTime ModifiedJulianDate where+    showsTime (ModifiedJulianDate d dt) =+        showsTime d . showsTime (timeOfDayFromNominalDiffTime dt)+    {-# INLINEABLE showsTime #-}++instance FormatTime UTCTime where+    showsTime t def c = case c of+        's' -> shows . fst $ quotRem (toPosixTimestampMicros t) 1000000+        _ -> (showsTime (toModifiedJulianDate t) . formatUtcZone) def c+    {-# INLINEABLE showsTime #-}++-- | Pact only supports UTC+--+formatUtcZone :: (Char -> ShowS) -> Char -> ShowS+formatUtcZone def c = case c of+    'z' -> (++) "+0000"+    'N' -> (++) "+00:00"+    'Z' -> (++) "UTC"+    _ -> def c+{-# INLINEABLE formatUtcZone #-}++-- -------------------------------------------------------------------------- --+-- Parser Utils++utf8Char :: Char -> S.ByteString+utf8Char = L.toStrict . B.toLazyByteString . B.charUtf8+{-# INLINE utf8Char #-}++utf8String :: String -> S.ByteString+utf8String = L.toStrict . B.toLazyByteString . B.stringUtf8+{-# INLINE utf8String #-}++parserToReadS :: Parser a -> ReadS a+parserToReadS = go . P.parse+  where+    go :: (S.ByteString -> Result a) -> ReadS a+    go k (splitAt 32 -> (h, t)) = case k (utf8String h) of+        -- `date -R | wc -c` is 32 characters+        Fail rest cxts msg -> fail $ concat [ "parserToReadS: ", msg+            , "; remaining: ", show (utf8Decode rest), "; stack: ", show cxts ]+        Partial k' -> go k' t+        Done rest a -> return (a, utf8Decode rest ++ t)+    {-# INLINEABLE go #-}++    utf8Decode :: S.ByteString -> String+    utf8Decode = Text.unpack . Text.decodeUtf8+    {-# INLINE utf8Decode #-}+{-# INLINEABLE parserToReadS #-}++indexOfCI :: [String] -> Parser Int+indexOfCI = P.choice . zipWith (\i s -> i <$ stringCI s) [0..]+{-# INLINE indexOfCI #-}++-- | Case-insensitive UTF-8 ByteString parser+--+-- Matches one character at a time. Slow.+--+stringCI :: String -> Parser ()+stringCI = foldl (\p c -> p *> charCI c) (pure ())+{-# INLINE stringCI #-}++-- | Case-insensitive UTF-8 ByteString parser+--+-- We can't easily perform upper/lower case conversion on the input, so+-- instead we accept either one of @toUpper c@ and @toLower c@.+--+charCI :: Char -> Parser ()+charCI c = if u == l then charU8 c else charU8 l <|> charU8 u+  where+    l = toLower c+    u = toUpper c+{-# INLINE charCI #-}++charU8 :: Char -> Parser ()+charU8 c = () <$ P.string (utf8Char c)+{-# INLINE charU8 #-}++-- | Number may be prefixed with '-'+--+negative :: (Integral n) => Parser n -> Parser n+negative p = ($) <$> (negate <$ P.char '-' <|> pure id) <*> p+{-# INLINE negative #-}++-- | Fixed-length 0-padded decimal+--+dec0 :: Int -> Parser Int+dec0 n = either fail return . P.parseOnly P.decimal =<< P.take n+{-# INLINE dec0 #-}++-- | Fixed-length space-padded decimal+--+dec_ :: Int -> Parser Int+dec_ n = P.take n >>= either fail return+    . P.parseOnly P.decimal+    . S.dropWhile isSpace+{-# INLINE dec_ #-}++-- -------------------------------------------------------------------------- --+-- Time Zones++data TimeZone = TimeZone+    { _timeZoneMinutes :: {-# UNPACK #-} !Minutes+    , _timeZoneSummerOnly :: !Bool+    , _timeZoneName :: String+    }++timeZoneMinutes :: Lens' TimeZone Minutes+timeZoneMinutes = lens _timeZoneMinutes $ \a b -> a { _timeZoneMinutes = b }+{-# INLINE timeZoneMinutes #-}++utc :: TimeZone+utc = TimeZone 0 False "UTC"++timeZoneOffset :: TimeZone -> NominalDiffTime+timeZoneOffset = fromMicroseconds . fromIntegral . (*) 60000000 . negate . _timeZoneMinutes+{-# INLINE timeZoneOffset #-}++-- -------------------------------------------------------------------------- --+-- Parse String into a Time Parse Value++data TimeFlag+    = PostMeridiem+    | TwelveHour+    | HasCentury+    | IsPOSIXTime+    | IsOrdinalDate+    | IsGregorian+    | IsWeekDate+    | IsSundayWeek+    | IsMondayWeek+    deriving (Enum, Show)++data TimeParse = TimeParse+    { _tpCentury :: {-# UNPACK #-} !Century+    , _tpCenturyYear :: {-# UNPACK #-} !Int{-YearOfCentury-}+    , _tpMonth :: {-# UNPACK #-} !Month+    , _tpWeekOfYear :: {-# UNPACK #-} !WeekOfYear+    , _tpDayOfMonth :: {-# UNPACK #-} !DayOfMonth+    , _tpDayOfYear :: {-# UNPACK #-} !DayOfYear+    , _tpDayOfWeek :: {-# UNPACK #-} !DayOfWeek+    , _tpFlags :: {-# UNPACK #-} !Int{-BitSet TimeFlag-}+    , _tpHour :: {-# UNPACK #-} !Hour+    , _tpMinute :: {-# UNPACK #-} !Minute+    , _tpSecond :: {-# UNPACK #-} !Second+    , _tpSecFrac :: {-# UNPACK #-} !NominalDiffTime+    , _tpPOSIXTime :: {-# UNPACK #-} !NominalDiffTime+    , _tpTimeZone :: !TimeZone+    }++flag :: TimeFlag -> Lens' TimeParse Bool+flag (fromEnum -> f) = tpFlags . lens+    (`testBit` f) (\ n b -> (if b then setBit else clearBit) n f)+{-# INLINE flag #-}++tpYear :: TimeParse -> Year+tpYear tp = _tpCenturyYear tp + 100 * if tp ^. flag HasCentury+  then _tpCentury tp+  else if _tpCenturyYear tp < 69+    then 20+    else 19+{-# INLINE tpYear #-}++-- | Time 'Parser' for UTF-8 encoded 'ByteString's.+--+-- Attoparsec easily beats any 'String' parser out there, but we do have to+-- be careful to convert the input to UTF-8 'ByteString's.+--+timeParser :: String -> Parser TimeParse+timeParser = flip execStateT unixEpoch . go+  where++    go :: String -> StateT TimeParse Parser ()+    go spec = case spec of+        '%' : cspec : rspec -> case cspec of+            -- aggregate+            'c' -> go (dateTimeFmt l ++ rspec)+            'r' -> go (time12Fmt l ++ rspec)+            'X' -> go (timeFmt l ++ rspec)+            'x' -> go (dateFmt l ++ rspec)+            'R' -> go ("%H:%M" ++ rspec)+            'T' -> go ("%H:%M:%S" ++ rspec)+            'D' -> go ("%m/%d/%y" ++ rspec)+            'F' -> go ("%Y-%m-%d" ++ rspec)+            -- AM/PM+            'P' -> dayHalf+            'p' -> dayHalf+            -- Hour+            'H' -> lift (dec0 2) >>= setHour24+            'I' -> lift (dec0 2) >>= setHour12+            'k' -> (lift (dec_ 2) >>= setHour24)+                <|> (lift (dec_ 1) >>= setHour24)+            'l' -> (lift (dec_ 2) >>= setHour12)+                <|> (lift (dec_ 1) >>= setHour12)+            -- Minute+            'M' -> lift (dec0 2) >>= assign tpMinute >> go rspec+            -- Second+            'S' -> lift (dec0 2) >>= assign tpSecond >> go rspec++            -- TODO: Unsupported by pact+            'q' -> lift micro >>= assign tpSecFrac . NominalDiffTime >> go rspec++            'v' -> lift micro >>= assign tpSecFrac . NominalDiffTime >> go rspec+            'Q' -> lift ((P.char '.' >> NominalDiffTime <$> micro) <|> return zeroV)+                >>= assign tpSecFrac >> go rspec++            -- Year+            'Y' -> fullYear+            'y' -> lift (dec0 2) >>= setCenturyYear+            'C' -> lift (dec0 2) >>= setCentury+            -- Month+            'B' -> lift (indexOfCI $ fst <$> months l) >>= setMonth . succ+            'b' -> lift (indexOfCI $ snd <$> months l) >>= setMonth . succ+            'h' -> lift (indexOfCI $ snd <$> months l) >>= setMonth . succ+            'm' -> lift (dec0 2) >>= setMonth+            -- DayOfMonth+            'd' -> lift (dec0 2) >>= setDayOfMonth+            'e' -> (lift (dec_ 2) >>= setDayOfMonth)+                <|> (lift (dec_ 1) >>= setDayOfMonth)+            -- DayOfYear+            'j' -> lift (dec0 3) >>= assign tpDayOfYear+                >> flag IsOrdinalDate .= True >> go rspec++            -- Year (WeekDate)+            -- FIXME: problematic if input contains both %Y and %G+            'G' -> flag IsWeekDate .= True >> fullYear+            'g' -> flag IsWeekDate .= True >> lift (dec0 2) >>= setCenturyYear+            'f' -> flag IsWeekDate .= True >> lift (dec0 2) >>= setCentury+            -- WeekOfYear+            -- FIXME: problematic if more than one of the following+            'V' -> flag IsWeekDate .= True >> lift (dec0 2) >>= setWeekOfYear+            'U' -> flag IsSundayWeek .= True >> lift (dec0 2) >>= setWeekOfYear+            'W' -> flag IsMondayWeek .= True >> lift (dec0 2) >>= setWeekOfYear+            -- DayOfWeek+            'w' -> lift (dec0 1) >>= setDayOfWeek+            'u' -> lift (dec0 1) >>= setDayOfWeek+            'A' -> lift (indexOfCI $ fst <$> wDays l) >>= setDayOfWeek+            'a' -> lift (indexOfCI $ snd <$> wDays l) >>= setDayOfWeek++            -- TimeZone+            'z' -> do tzOffset; go rspec+            'N' -> do tzOffset; go rspec+            'Z' -> do tzOffset <|> tzName; go rspec+            -- UTCTime+            's' -> do+                s <- lift (negative P.decimal)+                tpPOSIXTime .= fromMicroseconds (1000000 * s)+                flag IsPOSIXTime .= True+                go rspec++            -- modifier (whatever)+            '-' -> go ('%' : rspec)+            '_' -> go ('%' : rspec)+            '0' -> go ('%' : rspec)+            -- escape (why would anyone need %t and %n?)+            '%' -> lift (P.char '%') >> go rspec+            _ -> lift . fail $ "Unknown format character: " ++ show cspec++          where+            l = defaultTimeLocale+            dayHalf = do+                pm <- lift $ False <$ stringCI (fst $ amPm l)+                    <|> True <$ stringCI (snd $ amPm l)+                flag PostMeridiem .= pm+                flag TwelveHour .= True+                go rspec+            -- NOTE: if a greedy parse fails or causes a later failure,+            -- then backtrack and only accept 4-digit years; see #5.+            fullYear = year (negative P.decimal) <|> year (dec0 4)+              where+                year p = do+                    (c, y) <- (`divMod` 100) <$> lift p+                    flag HasCentury .= True+                    tpCentury .= c+                    tpCenturyYear .= y+                    go rspec+            setHour12 h = do+                flag TwelveHour .= True+                tpHour .= h+                go rspec+            setHour24 h = do+                flag TwelveHour .= False+                tpHour .= h+                go rspec+            setCenturyYear y = do tpCenturyYear .= y; go rspec+            setCentury c = do+                tpCentury .= c+                flag HasCentury .= True+                go rspec+            setMonth m = do+                flag IsGregorian .= True+                tpMonth .= m+                go rspec+            setDayOfMonth d = do+                flag IsGregorian .= True+                tpDayOfMonth .= d+                go rspec+            setWeekOfYear w = do tpWeekOfYear .= w; go rspec+            setDayOfWeek d = do tpDayOfWeek .= d; go rspec+            tzOffset = do+                s <- lift (id <$ P.char '+' <|> negate <$ P.char '-')+                h <- lift (dec0 2)+                () <$ lift (P.char ':') <|> pure ()+                m <- lift (dec0 2)+                tpTimeZone . timeZoneMinutes .= s (h * 60 + m)+            tzName = lift timeZoneParser >>= assign tpTimeZone++        c : rspec | P.isSpace c ->+            lift (P.takeWhile P.isSpace) >> go (dropWhile P.isSpace rspec)+        c : rspec | isAscii c -> lift (P.char c) >> go rspec+        c : rspec -> lift (charU8 c) >> go rspec+        "" -> return ()++    micro :: Parser Int64+    micro = do+        us10 <- either fail return . P.parseOnly P.decimal . S.take 7+            . (`S.append` S.pack "000000") =<< P.takeWhile1 P.isDigit+        return (div (us10 + 5) 10)+    {-# INLINE micro #-}++    unixEpoch :: TimeParse+    unixEpoch = TimeParse+        { _tpCentury = 19+        , _tpCenturyYear = 70+        , _tpMonth = 1+        , _tpWeekOfYear = 1+        , _tpDayOfYear = 1+        , _tpDayOfMonth = 1+        , _tpDayOfWeek = 4+        , _tpFlags = 0+        , _tpHour = 0+        , _tpMinute = 0+        , _tpSecond = 0+        , _tpSecFrac = zeroV+        , _tpPOSIXTime = zeroV+        , _tpTimeZone = utc+        }+    {-# INLINE unixEpoch #-}+{-# INLINEABLE timeParser #-}++parseTime :: String -> String -> Maybe UTCTime+parseTime spec = either (const Nothing) Just+    . P.parseOnly parser . utf8String+  where+    parser = buildTime <$ P.skipSpace <*> timeParser spec+        <* P.skipSpace <* P.endOfInput+{-# INLINEABLE parseTime #-}++readTime :: (ParseTime t) => String -> String -> t+readTime spec = either error id . P.parseOnly parser . utf8String+  where+    parser = buildTime <$ P.skipSpace <*> timeParser spec+        <* P.skipSpace <* P.endOfInput+{-# INLINEABLE readTime #-}++readsTime :: (ParseTime t) => String -> ReadS t+readsTime spec = parserToReadS $+    buildTime <$ P.skipSpace <*> timeParser spec+{-# INLINEABLE readsTime #-}++-- -------------------------------------------------------------------------- --+-- Build Parse Time++class ParseTime t where+    buildTime :: TimeParse -> t++instance ParseTime TimeOfDay where+    buildTime tp = TimeOfDay h (_tpMinute tp)+        (fromMicroseconds (1000000 * fromIntegral (_tpSecond tp)) ^+^ _tpSecFrac tp)+      where+        h = if tp ^. flag TwelveHour+              then if tp ^. flag PostMeridiem+                then if _tpHour tp < 12+                  then _tpHour tp + 12+                  else _tpHour tp+                else mod (_tpHour tp) 12+              else _tpHour tp+    {-# INLINE buildTime #-}++instance ParseTime YearMonthDay where+    buildTime tp = YearMonthDay (tpYear tp) (_tpMonth tp) (_tpDayOfMonth tp)+    {-# INLINE buildTime #-}++instance ParseTime OrdinalDate where+    buildTime tp = OrdinalDate (tpYear tp) (_tpDayOfYear tp)+    {-# INLINE buildTime #-}++instance ParseTime WeekDate where+    buildTime tp = WeekDate (tpYear tp) (_tpWeekOfYear tp)+        (if _tpDayOfWeek tp == 0 then 7 else _tpDayOfWeek tp)+    {-# INLINE buildTime #-}++instance ParseTime SundayWeek where+    buildTime tp = SundayWeek (tpYear tp) (_tpWeekOfYear tp)+        (if _tpDayOfWeek tp == 7 then 0 else _tpDayOfWeek tp)+    {-# INLINE buildTime #-}++instance ParseTime MondayWeek where+    buildTime tp = MondayWeek (tpYear tp) (_tpWeekOfYear tp)+        (if _tpDayOfWeek tp == 0 then 7 else _tpDayOfWeek tp)+    {-# INLINE buildTime #-}++instance ParseTime ModifiedJulianDay where+    {-# INLINE buildTime #-}+    buildTime tp+        | tp ^. flag IsOrdinalDate = fromOrdinalDate $ buildTime tp+        | tp ^. flag IsGregorian = toGregorian $ buildTime tp+        | tp ^. flag IsWeekDate = fromWeekDate $ buildTime tp+        | tp ^. flag IsSundayWeek = fromSundayWeek $ buildTime tp+        | tp ^. flag IsMondayWeek = fromMondayWeek $ buildTime tp+        | otherwise = fromOrdinalDate $ buildTime tp+        -- TODO: Better conflict handling when multiple flags are set?++instance ParseTime TimeZone where+    buildTime = _tpTimeZone+    {-# INLINE buildTime #-}++instance ParseTime UTCTime where+    buildTime tp = if tp ^. flag IsPOSIXTime+        then  fromPosixTimestampMicros $ toMicroseconds $ _tpPOSIXTime tp+        else zoned+      where+        d :: ModifiedJulianDay+        d = buildTime tp++        dt :: TimeOfDay+        dt = buildTime tp++        tz :: TimeZone+        tz = buildTime tp++        jul :: ModifiedJulianDate+        jul = ModifiedJulianDate d (toDayTime dt)++        zoned :: UTCTime+        zoned = fromModifiedJulianDate jul .+^ timeZoneOffset tz++        toDayTime :: TimeOfDay -> NominalDiffTime+        toDayTime (TimeOfDay h m s) = s+            ^+^ fromIntegral m *^ NominalDiffTime 60000000+            ^+^ fromIntegral h *^ NominalDiffTime 3600000000+        {-# INLINEABLE toDayTime #-}+    {-# INLINE buildTime #-}++-- -------------------------------------------------------------------------- --+-- Time Zone Parser++timeZoneParser :: Parser TimeZone+timeZoneParser = zone "TAI" 0 False <|> zone "UT1" 0 False++    <|> zone "ZULU" (($+) 00 00) False --  Same as UTC+    <|> zone "Z" (($+) 00 00) False --  Same as UTC+    <|> zone "YST" (($-) 09 00) False -- Yukon Standard Time+    <|> zone "YDT" (($-) 08 00) True -- Yukon Daylight-Saving Time+    <|> zone "WST" (($+) 08 00) False -- West Australian Standard Time+    <|> zone "WETDST" (($+) 01 00) True -- Western European Daylight-Saving Time+    <|> zone "WET" (($+) 00 00) False --  Western European Time+    <|> zone "WDT" (($+) 09 00) True -- West Australian Daylight-Saving Time+    <|> zone "WAT" (($-) 01 00) False -- West Africa Time+    <|> zone "WAST" (($+) 07 00) False -- West Australian Standard Time+    <|> zone "WADT" (($+) 08 00) True -- West Australian Daylight-Saving Time+    <|> zone "UTC" (($+) 00 00) False --  Universal Coordinated Time+    <|> zone "UT" (($+) 00 00) False --  Universal Time+    <|> zone "TFT" (($+) 05 00) False -- Kerguelen Time+    <|> zone "SWT" (($+) 01 00) False -- Swedish Winter Time+    <|> zone "SST" (($+) 02 00) False -- Swedish Summer Time+    <|> zone "SET" (($+) 01 00) False -- Seychelles Time+    <|> zone "SCT" (($+) 04 00) False -- Mahe Island Time+    <|> zone "SAST" (($+) 09 30) False -- South Australia Standard Time+    <|> zone "SADT" (($+) 10 30) True -- South Australian Daylight-Saving Time+    <|> zone "RET" (($+) 04 00) False -- Reunion Island Time+    <|> zone "PST" (($-) 08 00) False -- Pacific Standard Time+    <|> zone "PDT" (($-) 07 00) True -- Pacific Daylight-Saving Time+    <|> zone "NZT" (($+) 12 00) False -- New Zealand Time+    <|> zone "NZST" (($+) 12 00) False -- New Zealand Standard Time+    <|> zone "NZDT" (($+) 13 00) True -- New Zealand Daylight-Saving Time+    <|> zone "NT" (($-) 11 00) False -- Nome Time+    <|> zone "NST" (($-) 03 30) False -- Newfoundland Standard Time+    <|> zone "NOR" (($+) 01 00) False -- Norway Standard Time+    <|> zone "NFT" (($-) 03 30) False -- Newfoundland Standard Time+    <|> zone "NDT" (($-) 02 30) True -- Newfoundland Daylight-Saving Time+    <|> zone "MVT" (($+) 05 00) False -- Maldives Island Time+    <|> zone "MUT" (($+) 04 00) False -- Mauritius Island Time+    <|> zone "MT" (($+) 08 30) False -- Moluccas Time+    <|> zone "MST" (($-) 07 00) False -- Mountain Standard Time+    <|> zone "MMT" (($+) 06 30) False -- Myanmar Time+    <|> zone "MHT" (($+) 09 00) False -- Kwajalein Time+    <|> zone "MEZ" (($+) 01 00) False -- Mitteleuropaeische Zeit+    <|> zone "MEWT" (($+) 01 00) False -- Middle European Winter Time+    <|> zone "METDST" (($+) 02 00) True -- Middle Europe Daylight-Saving Time+    <|> zone "MET" (($+) 01 00) False -- Middle European Time+    <|> zone "MEST" (($+) 02 00) False -- Middle European Summer Time+    <|> zone "MDT" (($-) 06 00) True -- Mountain Daylight-Saving Time+    <|> zone "MAWT" (($+) 06 00) False -- Mawson (Antarctica) Time+    <|> zone "MART" (($-) 09 30) False -- Marquesas Time+    <|> zone "LIGT" (($+) 10 00) False -- Melbourne, Australia+    <|> zone "KST" (($+) 09 00) False -- Korea Standard Time+    <|> zone "JT" (($+) 07 30) False -- Java Time+    <|> zone "JST" (($+) 09 00) False -- Japan Standard Time, Russia zone 8+    <|> zone "IT" (($+) 03 30) False -- Iran Time+    <|> zone "IST" (($+) 02 00) False -- Israel Standard Time+    <|> zone "IRT" (($+) 03 30) False -- Iran Time+    <|> zone "IOT" (($+) 05 00) False -- Indian Chagos Time+    <|> zone "IDLW" (($-) 12 00) False -- International Date Line, West+    <|> zone "IDLE" (($+) 12 00) False -- International Date Line, East+    <|> zone "HST" (($-) 10 00) False -- Hawaii Standard Time+    <|> zone "HMT" (($+) 03 00) False -- Hellas Mediterranean Time (?)+    <|> zone "HDT" (($-) 09 00) True -- Hawaii/Alaska Daylight-Saving Time+    <|> zone "GST" (($+) 10 00) False -- Guam Standard Time, Russia zone 9+    <|> zone "GMT" (($+) 00 00) False --  Greenwich Mean Time+    <|> zone "FWT" (($+) 02 00) False -- French Winter Time+    <|> zone "FST" (($+) 01 00) False -- French Summer Time+    <|> zone "FNT" (($-) 02 00) False -- Fernando de Noronha Time+    <|> zone "FNST" (($-) 01 00) False -- Fernando de Noronha Summer Time+    <|> zone "EST" (($-) 05 00) False -- Eastern Standard Time+    <|> zone "EETDST" (($+) 03 00) True -- Eastern Europe Daylight-Saving Time+    <|> zone "EET" (($+) 02 00) False -- Eastern European Time, Russia zone 1+    <|> zone "EDT" (($-) 04 00) True -- Eastern Daylight-Saving Time+    <|> zone "EAT" (($+) 03 00) False -- Antananarivo, Comoro Time+    <|> zone "EAST" (($+) 10 00) False -- East Australian Standard Time+    <|> zone "EAST" (($+) 04 00) False -- Antananarivo Summer Time+    <|> zone "DNT" (($+) 01 00) False -- Dansk Normal Tid+    <|> zone "CXT" (($+) 07 00) False -- Christmas (Island) Time+    <|> zone "CST" (($-) 06 00) False -- Central Standard Time+    <|> zone "CETDST" (($+) 02 00) True -- Central European Daylight-Saving Time+    <|> zone "CET" (($+) 01 00) False -- Central European Time+    <|> zone "CEST" (($+) 02 00) False -- Central European Summer Time+    <|> zone "CDT" (($-) 05 00) True -- Central Daylight-Saving Time+    <|> zone "CCT" (($+) 08 00) False -- China Coastal Time+    <|> zone "CAT" (($-) 10 00) False -- Central Alaska Time+    <|> zone "CAST" (($+) 09 30) False -- Central Australia Standard Time+    <|> zone "CADT" (($+) 10 30) True -- Central Australia Daylight-Saving Time+    <|> zone "BT" (($+) 03 00) False -- Baghdad Time+    <|> zone "BST" (($+) 01 00) False -- British Summer Time+    <|> zone "BRT" (($-) 03 00) False -- Brasilia Time+    <|> zone "BRST" (($-) 02 00) False -- Brasilia Summer Time+    <|> zone "BDST" (($+) 02 00) False -- British Double Summer Time+    <|> zone "AWT" (($-) 03 00) False -- (unknown)+    <|> zone "AWST" (($+) 08 00) False -- Australia Western Standard Time+    <|> zone "AWSST" (($+) 09 00) False -- Australia Western Summer Standard Time+    <|> zone "AST" (($-) 04 00) False -- Atlantic Standard Time (Canada)+    <|> zone "ALMT" (($+) 06 00) False -- Almaty Time+    <|> zone "ALMST" (($+) 07 00) False -- Almaty Summer Time+    <|> zone "AKST" (($-) 09 00) False -- Alaska Standard Time+    <|> zone "AKDT" (($-) 08 00) True -- Alaska Daylight-Saving Time+    <|> zone "AHST" (($-) 10 00) False -- Alaska/Hawaii Standard Time+    <|> zone "AFT" (($+) 04 30) False -- Afghanistan Time+    <|> zone "AEST" (($+) 10 00) False -- Australia Eastern Standard Time+    <|> zone "AESST" (($+) 11 00) False -- Australia Eastern Summer Standard Time+    <|> zone "ADT" (($-) 03 00) True -- Atlantic Daylight-Saving Time+    <|> zone "ACT" (($-) 05 00) False -- Atlantic/Porto Acre Standard Time+    <|> zone "ACST" (($-) 04 00) False -- Atlantic/Porto Acre Summer Time+    <|> zone "ACSST" (($+) 10 30) False -- Central Australia Summer Standard Time+  where+    zone name offset dst = TimeZone offset dst name <$ P.string (S.pack name)+    ($+) h m = h * 60 + m+    ($-) h m = negate (h * 60 + m)++-- -------------------------------------------------------------------------- --+-- Orphan Read Instances++instance Read UTCTime where+    readsPrec _ = readParen False $+        readsTime "%Y-%m-%d %H:%M:%S%Q %Z"+    {-# INLINEABLE readsPrec #-}++-- -------------------------------------------------------------------------- --+-- Orphan Show Instances++instance Show UTCTime where+    showsPrec _ = formatTimeS "%Y-%m-%d %H:%M:%S%Q %Z"++instance Show NominalDiffTime where+    showsPrec p (NominalDiffTime a) rest = showsPrec p a ('s' : rest)++-- -------------------------------------------------------------------------- --+-- Orphan Aeson instances++instance ToJSON UTCTime where+    toJSON t = String $ T.pack $ formatTime "%FT%T%QZ" t+    {-# INLINE toJSON #-}++instance FromJSON UTCTime where+    parseJSON = withText "UTCTime" $ \t ->+        case parseTime "%FT%T%QZ" (T.unpack t) of+          Just d -> pure d+          _      -> fail "could not parse ISO-8601 date"+    {-# INLINE parseJSON #-}++-- -------------------------------------------------------------------------- --+-- TimeParse Lenses++tpCentury :: Lens' TimeParse Int+tpCentury = lens _tpCentury (\a b -> a { _tpCentury = b })+{-# INLINE tpCentury #-}++tpCenturyYear :: Lens' TimeParse Int+tpCenturyYear = lens _tpCenturyYear (\a b -> a { _tpCenturyYear = b })+{-# INLINE tpCenturyYear #-}++tpMonth :: Lens' TimeParse Int+tpMonth = lens _tpMonth (\a b -> a { _tpMonth = b })+{-# INLINE tpMonth #-}++tpWeekOfYear :: Lens' TimeParse Int+tpWeekOfYear = lens _tpWeekOfYear (\a b -> a { _tpWeekOfYear = b })+{-# INLINE tpWeekOfYear #-}++tpDayOfMonth :: Lens' TimeParse Int+tpDayOfMonth = lens _tpDayOfMonth (\a b -> a { _tpDayOfMonth = b })+{-# INLINE tpDayOfMonth #-}++tpDayOfYear :: Lens' TimeParse Int+tpDayOfYear = lens _tpDayOfYear (\a b -> a { _tpDayOfYear = b })+{-# INLINE tpDayOfYear #-}++tpDayOfWeek :: Lens' TimeParse Int+tpDayOfWeek = lens _tpDayOfWeek (\a b -> a { _tpDayOfWeek = b })+{-# INLINE tpDayOfWeek #-}++tpFlags :: Lens' TimeParse Int+tpFlags = lens _tpFlags (\a b -> a { _tpFlags = b })+{-# INLINE tpFlags #-}++tpHour :: Lens' TimeParse Int+tpHour = lens _tpHour (\a b -> a { _tpHour = b })+{-# INLINE tpHour #-}++tpMinute :: Lens' TimeParse Int+tpMinute = lens _tpMinute (\a b -> a { _tpMinute = b })+{-# INLINE tpMinute #-}++tpSecond :: Lens' TimeParse Int+tpSecond = lens _tpSecond (\a b -> a { _tpSecond = b })+{-# INLINE tpSecond #-}++tpSecFrac :: Lens' TimeParse NominalDiffTime+tpSecFrac = lens _tpSecFrac (\a b -> a { _tpSecFrac = b })+{-# INLINE tpSecFrac #-}++tpPOSIXTime :: Lens' TimeParse NominalDiffTime+tpPOSIXTime = lens _tpPOSIXTime (\a b -> a { _tpPOSIXTime = b })+{-# INLINE tpPOSIXTime #-}++tpTimeZone :: Lens' TimeParse TimeZone+tpTimeZone = lens _tpTimeZone (\a b -> a { _tpTimeZone = b })+{-# INLINE tpTimeZone #-}+

@@ -0,0 +1,97 @@+{-# LANGUAGE Safe #-}+-- |+-- Module: Pact.Time.Format.Locale+-- Description : Short description+-- Copyright   : (c) Kadena LLC, 2021+--                   Ashley Yakeley and contributors, 2004-2021+--                   The University of Glasgow 2001+-- License     : MIT+-- Maintainer  : Lars Kuhtz <lars@kadena.io>+-- Stability   : experimental+--+-- The code in this module is derived from time:Data.Time.Format.Locale. The+-- code is included here in order to guarnatee binary stability of formated time+-- values in Pact, even when the upstream code changes.+--+-- The original code has the following Copyright and License:+--+-- @+-- TimeLib is Copyright (c) Ashley Yakeley and contributors, 2004-2021. All rights reserved.+-- Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are met:+--+-- - Redistributions of source code must retain the above copyright notice, this+--   list of conditions and the following disclaimer.+--+-- - Neither name of the copyright holders nor the names of its contributors may+--   be used to endorse or promote products derived from this software without+--   specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+-- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+-- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.+-- @+--+module Pact.Time.Format.Locale+( TimeLocale(..)+, defaultTimeLocale+) where++data TimeLocale = TimeLocale+    { wDays :: ![(String, String)]+        -- ^ full and abbreviated week days, starting with Sunday+    , months :: ![(String, String)]+        -- ^ full and abbreviated months+    , amPm :: !(String, String)+        -- ^ AM\/PM symbols+    , dateTimeFmt :: !String+    , dateFmt :: !String+    , timeFmt :: !String+    , time12Fmt :: !String+    }+    deriving (Eq, Ord, Show)++-- | Locale representing American usage.+--+defaultTimeLocale :: TimeLocale+defaultTimeLocale = TimeLocale+    { wDays =+          [ ("Sunday", "Sun")+          , ("Monday", "Mon")+          , ("Tuesday", "Tue")+          , ("Wednesday", "Wed")+          , ("Thursday", "Thu")+          , ("Friday", "Fri")+          , ("Saturday", "Sat")+          ]+    , months =+          [ ("January", "Jan")+          , ("February", "Feb")+          , ("March", "Mar")+          , ("April", "Apr")+          , ("May", "May")+          , ("June", "Jun")+          , ("July", "Jul")+          , ("August", "Aug")+          , ("September", "Sep")+          , ("October", "Oct")+          , ("November", "Nov")+          , ("December", "Dec")+          ]+    , amPm = ("AM", "PM")+    , dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y"+    , dateFmt = "%m/%d/%y"+    , timeFmt = "%H:%M:%S"+    , time12Fmt = "%I:%M:%S %p"+    }+

@@ -0,0 +1,316 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module: Pact.Time.Internal+-- Copyright: Copyright © 2021 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- This is an internal module. No guarantee is provided regarding the stability+-- of the functions in this module. Use at your own risk.+--+module Pact.Time.Internal+(+  Micros+, Day++-- * NominalDiffTime+, NominalDiffTime(..)+, toMicroseconds+, fromMicroseconds+, toSeconds+, fromSeconds+, nominalDay++-- * UTCTime+, UTCTime(..)+, getCurrentTime+, day+, dayTime+, fromDayAndDayTime+, toPosixTimestampMicros+, fromPosixTimestampMicros+, mjdEpoch+, posixEpoch++-- * Julian Dates+, ModifiedJulianDay(..)+, ModifiedJulianDate(..)+, toModifiedJulianDate+, fromModifiedJulianDate++-- * Reexports+, AffineSpace(..)+, VectorSpace(..)+) where++import Control.DeepSeq++import Data.AdditiveGroup+import Data.AffineSpace+import Data.Decimal+import Data.Serialize+import Data.VectorSpace++import GHC.Generics hiding (from)+import GHC.Int (Int64)++import Lens.Micro++-- internal modules++import Pact.Time.System++-- -------------------------------------------------------------------------- --+-- Types for internal representations++type Micros = Int64+type Day = Int++-- -------------------------------------------------------------------------- --+-- Nominal Diff Time++-- | A time interval as measured by UTC, that does not take leap-seconds into+-- account.+--+newtype NominalDiffTime = NominalDiffTime { _microseconds :: Micros }+    deriving (Eq, Ord)+    deriving newtype (NFData)++-- | Convert from 'NominalDiffTime' to a 64-bit representation of microseconds.+--+toMicroseconds :: NominalDiffTime -> Micros+toMicroseconds = _microseconds+{-# INLINE toMicroseconds #-}++-- | Convert from a 64-bit representation of microseconds to 'NominalDiffTime'.+--+fromMicroseconds :: Micros -> NominalDiffTime+fromMicroseconds = NominalDiffTime+{-# INLINE fromMicroseconds #-}++instance AdditiveGroup NominalDiffTime where+    zeroV = NominalDiffTime 0+    NominalDiffTime a ^+^ NominalDiffTime b = NominalDiffTime (a + b)+    negateV (NominalDiffTime v) = NominalDiffTime (-v)+    NominalDiffTime a ^-^ NominalDiffTime b = NominalDiffTime (a - b)+    {-# INLINE zeroV #-}+    {-# INLINE (^+^) #-}+    {-# INLINE negateV #-}+    {-# INLINE (^-^) #-}++instance VectorSpace NominalDiffTime where+    type Scalar NominalDiffTime = Rational+    s *^ (NominalDiffTime m) = NominalDiffTime $ round (s * fromIntegral m)+    {-# INLINE (*^) #-}++-- | Serializes 'NominalDiffTime' as 64-bit signed microseconds in little endian+-- encoding.+--+instance Serialize NominalDiffTime where+    put (NominalDiffTime m) = putInt64le m+    get = NominalDiffTime <$> getInt64le+    {-# INLINE put #-}+    {-# INLINE get #-}++-- | Convert from 'NominalDiffTime' to a 'Decimal' representation of seconds.+--+toSeconds :: NominalDiffTime -> Decimal+toSeconds (NominalDiffTime m) = realToFrac m / 1000000+{-# INLINE toSeconds #-}++-- | Convert from 'Decimal' representation of seconds to 'NominalDiffTime'.+--+-- The result is rounded using banker's method, i.e. remainders of 0.5 a rounded+-- to the next even integer.+--+fromSeconds :: Decimal -> NominalDiffTime+fromSeconds d = NominalDiffTime $ round $ d * 1000000+{-# INLINE fromSeconds #-}++-- | The nominal length of a day: precisely 86400 SI seconds.+--+nominalDay :: NominalDiffTime+nominalDay = NominalDiffTime $ 86400 * 1000000+{-# INLINE nominalDay #-}++toPosixTimestampMicros :: UTCTime -> Micros+toPosixTimestampMicros = toTimestampMicros . toPosix+{-# INLINE toPosixTimestampMicros #-}++fromPosixTimestampMicros :: Micros -> UTCTime+fromPosixTimestampMicros = fromPosix . fromTimestampMicros+{-# INLINE fromPosixTimestampMicros #-}++-- -------------------------------------------------------------------------- --+-- UTCTime++-- | UTCTime with microseconds precision. Internally it is represented as 64-bit+-- count nominal microseconds since MJD Epoch.+--+-- This implementation ignores leap seconds. Time differences are  measured as+-- nominal time, with a nominal day having exaxtly @24 * 60 * 60@ SI seconds. As+-- a consequence the difference between two dates as computed by this module is+-- generally equal or smaller than what is actually measured by a clock.+--+newtype UTCTime = UTCTime { _utcTime :: NominalDiffTime }+    deriving (Eq, Ord)+    deriving (Generic)+    deriving newtype (NFData)+    deriving newtype (Serialize)++instance AffineSpace UTCTime where+    type Diff UTCTime = NominalDiffTime+    UTCTime a .-. UTCTime b = a ^-^ b+    UTCTime a .+^ b = UTCTime (a ^+^ b)+    {-# INLINE (.-.) #-}+    {-# INLINE (.+^) #-}++getCurrentTime :: IO UTCTime+getCurrentTime = UTCTime . (^+^ _utcTime posixEpoch) . _posixTime+    <$> getPOSIXTime+{-# INLINE getCurrentTime #-}++-- | The date of a UTCTime value represented as modified Julian 'Day'.+--+day :: Lens' UTCTime ModifiedJulianDay+day = lens+    (_mjdDay . toModifiedJulianDate)+    (\a b -> fromModifiedJulianDate . set mjdDay b $ toModifiedJulianDate a)+{-# INLINE day #-}++-- | The day time of a 'UTCTime' value represented as 'NominalDiffTime' since+-- @00:00:00@ of that respective day.+--+dayTime :: Lens' UTCTime NominalDiffTime+dayTime = lens+    (_mjdTime . toModifiedJulianDate)+    (\a b -> fromModifiedJulianDate . set mjdTime b $ toModifiedJulianDate a)+{-# INLINE dayTime #-}++-- | Create a 'UTCTime' from a date and a daytime. The date is represented+-- as modified Julian 'Day' and the day time is represented as+-- 'NominalDiffTime' since '00:00:00' of the respective day.+--+-- Note that this implementation does not support representation of leap+-- seconds.+--+fromDayAndDayTime :: ModifiedJulianDay -> NominalDiffTime -> UTCTime+fromDayAndDayTime d t = fromModifiedJulianDate $ ModifiedJulianDate d t+{-# INLINE fromDayAndDayTime #-}++-- | The POSIX Epoch represented as UTCTime.+--+posixEpoch :: UTCTime+posixEpoch = UTCTime (fromIntegral d *^ nominalDay)+  where+    ModifiedJulianDay d = posixEpochDay+{-# INLINE posixEpoch #-}++-- | The Epoch of the modified Julian day represented as 'UTCTime'.+--+mjdEpoch :: UTCTime+mjdEpoch = UTCTime zeroV+{-# INLINE mjdEpoch #-}++-- -------------------------------------------------------------------------- --+-- POSIX Timestamps++-- | POSIX time is the nominal time since 1970-01-01 00:00 UTC. It is+-- represented as 64-bit count of microseconds.+--+-- Users who only need POSIX timestamps can ignore this type and just use+-- 'UTCTime' with 'toPosxiTimestampMicros' and 'fromPosixTimestampMicros'.+--+newtype POSIXTime = POSIXTime { _posixTime :: NominalDiffTime }+    deriving (Eq, Ord)+    deriving newtype (NFData)++-- | Represent POSIXTime as 64-bit value of microseconds since 'posixEpoch'.+--+toTimestampMicros :: POSIXTime -> Micros+toTimestampMicros = _microseconds . _posixTime+{-# INLINE toTimestampMicros #-}++-- | Create POSIXTime from 64-bit value of microseconds since 'posixEpoch'.+--+fromTimestampMicros :: Micros -> POSIXTime+fromTimestampMicros = POSIXTime . fromMicroseconds+{-# INLINE fromTimestampMicros #-}++-- | The day of the epoch of 'SystemTime', 1970-01-01+--+posixEpochDay :: ModifiedJulianDay+posixEpochDay = ModifiedJulianDay 40587+{-# INLINE posixEpochDay #-}++-- | Get current POSIX time+--+getPOSIXTime :: IO POSIXTime+getPOSIXTime = POSIXTime . NominalDiffTime . fromIntegral <$> getSystemTimeMicros+{-# INLINE getPOSIXTime #-}++-- The following conversions between POSIXTime and UTCTime are efficient because+-- all constants are inlined.++-- | Convert from UTCTime to POSIXTime+--+toPosix :: UTCTime -> POSIXTime+toPosix t = POSIXTime $ _utcTime t ^-^ _utcTime posixEpoch+{-# INLINE toPosix #-}++-- | Convert from POSIXTime to UTCTime+--+fromPosix :: POSIXTime -> UTCTime+fromPosix p = UTCTime $ _posixTime p ^+^ _utcTime posixEpoch+{-# INLINE fromPosix #-}++-- -------------------------------------------------------------------------- --+-- Modified Julian Day Representation of UTC++newtype ModifiedJulianDay = ModifiedJulianDay Day+    deriving newtype (Eq, Ord, NFData)++-- | Modified Julian Day Representation of UTC+--+data ModifiedJulianDate = ModifiedJulianDate+    { _mjdDay :: !ModifiedJulianDay+    , _mjdTime :: !NominalDiffTime+    }+    deriving (Eq, Ord, Generic)+    deriving anyclass (NFData)++mjdDay :: Lens' ModifiedJulianDate ModifiedJulianDay+mjdDay = lens _mjdDay $ \a b -> a { _mjdDay = b }+{-# INLINE mjdDay #-}++mjdTime :: Lens' ModifiedJulianDate NominalDiffTime+mjdTime = lens _mjdTime $ \a b -> a { _mjdTime = b }+{-# INLINE mjdTime #-}++-- | Convert from 'UTCTime' to modified 'Julian' Day time.+--+toModifiedJulianDate :: UTCTime -> ModifiedJulianDate+toModifiedJulianDate (UTCTime (NominalDiffTime m)) = ModifiedJulianDate+    (ModifiedJulianDay (fromIntegral d))+    (NominalDiffTime t)+  where+    (d, t) = divMod m n+    NominalDiffTime n = nominalDay+{-# INLINE toModifiedJulianDate #-}++-- | Convert from modified 'Julian' Day time to 'UTCTime'.+--+fromModifiedJulianDate :: ModifiedJulianDate -> UTCTime+fromModifiedJulianDate (ModifiedJulianDate (ModifiedJulianDay d) t)+    = UTCTime $ (fromIntegral d *^ nominalDay) ^+^ t+{-# INLINE fromModifiedJulianDate #-}+

@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}++-- |+-- Module: Pact.Time.System+-- Copyright: Copyright © 2021 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- Returns the time of the system clock as 64-bit value that counts microseconds+-- since the POSIX epoch.+--+module Pact.Time.System+( getSystemTimeMicros+) where++import Data.Int (Int64)++#if WITH_TIME+import qualified Data.Time.Clock.POSIX (getPOSIXTime)+#else+import System.Clock (getTime, TimeSpec(..), Clock(Realtime))+#endif++getSystemTimeMicros :: IO Int64+getSystemTimeMicros = do++#if WITH_TIME+    s <- Data.Time.Clock.POSIX.getPOSIXTime+    return $ round $ s * 1000000+#else+    TimeSpec s ns <- getTime Realtime+    return $ (s * 1000000) + (ns `quot` 1000)+#endif++{-# INLINE getSystemTimeMicros #-}+

@@ -19,9 +19,9 @@  -- internal modules -import qualified Test.Data.Time.Format (tests)+import qualified Test.Pact.Time.Format (tests)  main :: IO () main = defaultMain $ testGroup "tests"-    [ Test.Data.Time.Format.tests+    [ Test.Pact.Time.Format.tests     ]

@@ -1,221 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}---- |--- Module: Test.Data.Time.Format--- Copyright: Copyright © 2021 Kadena LLC.--- License: MIT--- Maintainer: Lars Kuhtz <lars@kadena.io>--- Stability: experimental------ TODO----module Test.Data.Time.Format-( tests-, formats-) where--import Test.Tasty-import Test.Tasty.HUnit---- internal modules--import Data.Time---- -------------------------------------------------------------------------- ----- TODO: Test instances:---- This may be different when the time package is used:--- f = "%Y-%m-%dT%H:%M:%S%v%Z"--- formatTime_ f t -> OK--- parseTime_ f (formatTime_ f t) -> error---- f = "%Y-%m-%dT%H:%M:%S.%v%Z"--- formatTime_ f t -> OK--- parseTime_ f (formatTime_ f t) -> OK---- f = "%Y-%m-%dT%H:%M:%S%Q%Z"--- formatTime_ f t -> OK--- parseTime_ f (formatTime_ f t) -> OK---- -------------------------------------------------------------------------- ----- Tests--tests :: TestTree-tests = testGroup "Test.Data.Time.Format"-    [ testFormats posixEpochFormats-    , testFormats mjdEpochFormats-    , checkCase posixEpoch q-    ]--testFormats :: Cases -> TestTree-testFormats c = testGroup (formatTime "%c" (_casesTime c)) $-    checkCase (_casesTime c) <$> _casesExpectations c--checkCase :: UTCTime -> (String, String, String) -> TestTree-checkCase t (e, f, m) = testCase m $ e @=? formatTime f t--data Cases = Cases-    { _casesTime :: !UTCTime-    , _casesExpectations :: ![(String, String, String)]-    }---- -------------------------------------------------------------------------- ----- Test Cases---- TODO----q :: (String, String, String)--- q = ("%q", "%q", "\"%q\" is not supported by Pact")-q = ("000000000000", "%q", "\"%q\" is not supported by Pact")---- | 1970-01-01T00:00:00.000000Z----posixEpochFormats :: Cases-posixEpochFormats = Cases posixEpoch-    [ ("%", "%%", "literal \"%\"")-    , ("+0000", "%z", "RFC 822/ISO 8601:1988 style numeric time zone (e.g., \"-0600\" or \"+0100\")")-    , ("+00:00", "%N", "ISO 8601 style numeric time zone (e.g., \"-06:00\" or \"+01:00\") /EXTENSION/")-    , ("UTC", "%Z", "timezone name")-    , ("Thu Jan  1 00:00:00 UTC 1970", "%c", "same as \"%a %b %e %H:%M:%S %Z %Y\"")-    , ("00:00", "%R", "same as \"%H:%M\"")-    , ("00:00:00", "%T", "same as \"%H:%M:%S\"")-    , ("00:00:00", "%X", "same as \"%H:%M:%S\"")-    , ("12:00:00 AM", "%r", "same as \"%I:%M:%S %p\" (time12Fmt)")-    , ("am", "%P", "lowercase day-half of day (\"am\", or \"pm\")")-    , ("AM", "%p", "uppercase day-half of day (\"AM\", \"PM\")")-    , ("00", "%H", "hour of day (24-hour), 0-padded to two chars, \"00\"–\"23\"")-    , (" 0", "%k", "hour of day (24-hour), space-padded to two chars, \" 0\"–\"23\"")-    , ("12", "%I", "hour of day-half (12-hour), 0-padded to two chars, \"01\"–\"12\"")-    , ("12", "%l", "hour of day-half (12-hour), space-padded to two chars, \" 1\"–\"12\"")-    , ("00", "%M", "minute of hour, 0-padded to two chars, \"00\"–\"59\"")-    , ("00", "%S", "second of minute (without decimal part), 0-padded to two chars, \"00\"–\"60\"")-    , ("000000", "%v", "microsecond of second, 0-padded to six chars, \"000000\"–\"999999\". /EXTENSION/")-    , ("", "%Q", "decimal point and fraction of second, up to 6 second decimals, without trailing zeros. For a whole number of seconds, %Q produces the empty string. /EXTENSION/")-    , ("0", "%s", "number of whole seconds since the Unix epoch. For times before the Unix epoch, this is a negative number. Note that in %s.%q and %s%Q the decimals are positive, not negative. For example, 0.9 seconds before the Unix epoch is formatted as \"-1.1\" with %s%Q.")-    , ("01/01/70", "%D", "same as \"%m/%d/%y\"")-    , ("1970-01-01", "%F", "same as \"%Y-%m-%d\"")-    , ("01/01/70", "%x", "same as \"%m/%d/%y\" (dateFmt)")-    , ("1970", "%Y", "year, no padding.")-    , ("70", "%y", "year of century, 0-padded to two chars, \"00\"–\"99\"")-    , ("19", "%C", "century, no padding.")-    , ("January", "%B", "month name, long form (\"January\"–\"December\")")-    , ("Jan", "%b", "month name, short form (\"Jan\"–\"Dec\")")-    , ("Jan", "%h", "month name, short form (\"Jan\"–\"Dec\")")-    , ("01", "%m", "month of year, 0-padded to two chars, \"01\"–\"12\"")-    , ("01", "%d", "day of month, 0-padded to two chars, \"01\"–\"31\"")-    , (" 1", "%e", "day of month, space-padded to two chars, \" 1\"–\"31\"")-    , ("001", "%j", "day of year, 0-padded to three chars, \"001\"–\"366\"")-    , ("1970", "%G", "year for Week Date format, no padding.")-    , ("70", "%g", "year of century for Week Date format, 0-padded to two chars, \"00\"–\"99\"")-    , ("19", "%f", "century for Week Date format, no padding. /EXTENSION/")-    , ("01", "%V", "week of year for Week Date format, 0-padded to two chars, \"01\"–\"53\"")-    , ("4", "%u", "day of week for Week Date format, \"1\"–\"7\"")-    , ("Thu", "%a", "day of week, short form (\"Sun\"–\"Sat\")")-    , ("Thursday", "%A", "day of week, long form (\"Sunday\"–\"Saturday\")")-    , ("00", "%U", "week of year where weeks start on Sunday, 0-padded to two chars, \"00\"–\"53\"")-    , ("4", "%w", "day of week number, \"0\" (= Sunday) – \"6\" (= Saturday)")-    , ("00", "%W", "week of year where weeks start on Monday, 0-padded to two chars, \"00\"–\"53\"")-    ]---- | 1858-11-17T00:00:00.000000Z----mjdEpochFormats :: Cases-mjdEpochFormats = Cases mjdEpoch-    [ ("%", "%%", "literal \"%\"")-    , ("+0000", "%z", "RFC 822/ISO 8601:1988 style numeric time zone (e.g., \"-0600\" or \"+0100\")")-    , ("+00:00", "%N", "ISO 8601 style numeric time zone (e.g., \"-06:00\" or \"+01:00\") /EXTENSION/")-    , ("UTC", "%Z", "timezone name")-    , ("Wed Nov 17 00:00:00 UTC 1858", "%c", "same as \"%a %b %e %H:%M:%S %Z %Y\"")-    , ("00:00", "%R", "same as \"%H:%M\"")-    , ("00:00:00", "%T", "same as \"%H:%M:%S\"")-    , ("00:00:00", "%X", "same as \"%H:%M:%S\"")-    , ("12:00:00 AM", "%r", "same as \"%I:%M:%S %p\" (time12Fmt)")-    , ("am", "%P", "lowercase day-half of day (\"am\", or \"pm\")")-    , ("AM", "%p", "uppercase day-half of day (\"AM\", \"PM\")")-    , ("00", "%H", "hour of day (24-hour), 0-padded to two chars, \"00\"–\"23\"")-    , (" 0", "%k", "hour of day (24-hour), space-padded to two chars, \" 0\"–\"23\"")-    , ("12", "%I", "hour of day-half (12-hour), 0-padded to two chars, \"01\"–\"12\"")-    , ("12", "%l", "hour of day-half (12-hour), space-padded to two chars, \" 1\"–\"12\"")-    , ("00", "%M", "minute of hour, 0-padded to two chars, \"00\"–\"59\"")-    , ("00", "%S", "second of minute (without decimal part), 0-padded to two chars, \"00\"–\"60\"")-    , ("000000", "%v", "microsecond of second, 0-padded to six chars, \"000000\"–\"999999\". /EXTENSION/")-    , ("", "%Q", "decimal point and fraction of second, up to 6 second decimals, without trailing zeros. For a whole number of seconds, %Q produces the empty string. /EXTENSION/")-    , ("-3506716800", "%s", "number of whole seconds since the Unix epoch. For times before the Unix epoch, this is a negative number. Note that in %s.%q and %s%Q the decimals are positive, not negative. For example, 0.9 seconds before the Unix epoch is formatted as \"-1.1\" with %s%Q.")-    , ("11/17/58", "%D", "same as \"%m/%d/%y\"")-    , ("1858-11-17", "%F", "same as \"%Y-%m-%d\"")-    , ("11/17/58", "%x", "same as \"%m/%d/%y\" (dateFmt)")-    , ("1858", "%Y", "year, no padding.")-    , ("58", "%y", "year of century, 0-padded to two chars, \"00\"–\"99\"")-    , ("18", "%C", "century, no padding.")-    , ("November", "%B", "month name, long form (\"January\"–\"December\")")-    , ("Nov", "%b", "month name, short form (\"Jan\"–\"Dec\")")-    , ("Nov", "%h", "month name, short form (\"Jan\"–\"Dec\")")-    , ("11", "%m", "month of year, 0-padded to two chars, \"01\"–\"12\"")-    , ("17", "%d", "day of month, 0-padded to two chars, \"01\"–\"31\"")-    , ("17", "%e", "day of month, space-padded to two chars, \" 1\"–\"31\"")-    , ("321", "%j", "day of year, 0-padded to three chars, \"001\"–\"366\"")-    , ("1858", "%G", "year for Week Date format, no padding.")-    , ("58", "%g", "year of century for Week Date format, 0-padded to two chars, \"00\"–\"99\"")-    , ("18", "%f", "century for Week Date format, no padding. /EXTENSION/")-    , ("46", "%V", "week of year for Week Date format, 0-padded to two chars, \"01\"–\"53\"")-    , ("3", "%u", "day of week for Week Date format, \"1\"–\"7\"")-    , ("Wed", "%a", "day of week, short form (\"Sun\"–\"Sat\")")-    , ("Wednesday", "%A", "day of week, long form (\"Sunday\"–\"Saturday\")")-    , ("46", "%U", "week of year where weeks start on Sunday, 0-padded to two chars, \"00\"–\"53\"")-    , ("3", "%w", "day of week number, \"0\" (= Sunday) – \"6\" (= Saturday)")-    , ("46", "%W", "week of year where weeks start on Monday, 0-padded to two chars, \"00\"–\"53\"")-    ]---- | https://pact-language.readthedocs.io/en/stable/pact-reference.html#time-formats------ Can be used as a tempalte to define new test cases----formats :: [(String, String)]-formats =-    [ ("%%", "literal \"%\"")-    , ("%z", "RFC 822/ISO 8601:1988 style numeric time zone (e.g., \"-0600\" or \"+0100\")")-    , ("%N", "ISO 8601 style numeric time zone (e.g., \"-06:00\" or \"+01:00\") /EXTENSION/")-    , ("%Z", "timezone name")-    , ("%c", "same as \"%a %b %e %H:%M:%S %Z %Y\"")-    , ("%R", "same as \"%H:%M\"")-    , ("%T", "same as \"%H:%M:%S\"")-    , ("%X", "same as \"%H:%M:%S\"")-    , ("%r", "same as \"%I:%M:%S %p\" (time12Fmt)")-    , ("%P", "lowercase day-half of day (\"am\", or \"pm\")")-    , ("%p", "uppercase day-half of day (\"AM\", \"PM\")")-    , ("%H", "hour of day (24-hour), 0-padded to two chars, \"00\"–\"23\"")-    , ("%k", "hour of day (24-hour), space-padded to two chars, \" 0\"–\"23\"")-    , ("%I", "hour of day-half (12-hour), 0-padded to two chars, \"01\"–\"12\"")-    , ("%l", "hour of day-half (12-hour), space-padded to two chars, \" 1\"–\"12\"")-    , ("%M", "minute of hour, 0-padded to two chars, \"00\"–\"59\"")-    , ("%S", "second of minute (without decimal part), 0-padded to two chars, \"00\"–\"60\"")-    , ("%v", "microsecond of second, 0-padded to six chars, \"000000\"–\"999999\". /EXTENSION/")-    , ("%Q", "decimal point and fraction of second, up to 6 second decimals, without trailing zeros. For a whole number of seconds, %Q produces the empty string. /EXTENSION/")-    , ("%s", "number of whole seconds since the Unix epoch. For times before the Unix epoch, this is a negative number. Note that in %s.%q and %s%Q the decimals are positive, not negative. For example, 0.9 seconds before the Unix epoch is formatted as \"-1.1\" with %s%Q.")-    , ("%D", "same as \"%m/%d/%y\"")-    , ("%F", "same as \"%Y-%m-%d\"")-    , ("%x", "same as \"%m/%d/%y\" (dateFmt)")-    , ("%Y", "year, no padding.")-    , ("%y", "year of century, 0-padded to two chars, \"00\"–\"99\"")-    , ("%C", "century, no padding.")-    , ("%B", "month name, long form (\"January\"–\"December\")")-    , ("%b", "month name, short form (\"Jan\"–\"Dec\")")-    , ("%h", "month name, short form (\"Jan\"–\"Dec\")")-    , ("%m", "month of year, 0-padded to two chars, \"01\"–\"12\"")-    , ("%d", "day of month, 0-padded to two chars, \"01\"–\"31\"")-    , ("%e", "day of month, space-padded to two chars, \" 1\"–\"31\"")-    , ("%j", "day of year, 0-padded to three chars, \"001\"–\"366\"")-    , ("%G", "year for Week Date format, no padding.")-    , ("%g", "year of century for Week Date format, 0-padded to two chars, \"00\"–\"99\"")-    , ("%f", "century for Week Date format, no padding. /EXTENSION/")-    , ("%V", "week of year for Week Date format, 0-padded to two chars, \"01\"–\"53\"")-    , ("%u", "day of week for Week Date format, \"1\"–\"7\"")-    , ("%a", "day of week, short form (\"Sun\"–\"Sat\")")-    , ("%A", "day of week, long form (\"Sunday\"–\"Saturday\")")-    , ("%U", "week of year where weeks start on Sunday, 0-padded to two chars, \"00\"–\"53\"")-    , ("%w", "day of week number, \"0\" (= Sunday) – \"6\" (= Saturday)")-    , ("%W", "week of year where weeks start on Monday, 0-padded to two chars, \"00\"–\"53\"")-    -- , "%q" -- (picoseconds, zero-padded) does not work properly so not documented here.-    ]

@@ -0,0 +1,221 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Test.Pact.Time.Format+-- Copyright: Copyright © 2021 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- TODO+--+module Test.Pact.Time.Format+( tests+, formats+) where++import Test.Tasty+import Test.Tasty.HUnit++-- internal modules++import Pact.Time++-- -------------------------------------------------------------------------- --+-- TODO: Test instances:++-- This may be different when the time package is used:+-- f = "%Y-%m-%dT%H:%M:%S%v%Z"+-- formatTime_ f t -> OK+-- parseTime_ f (formatTime_ f t) -> error++-- f = "%Y-%m-%dT%H:%M:%S.%v%Z"+-- formatTime_ f t -> OK+-- parseTime_ f (formatTime_ f t) -> OK++-- f = "%Y-%m-%dT%H:%M:%S%Q%Z"+-- formatTime_ f t -> OK+-- parseTime_ f (formatTime_ f t) -> OK++-- -------------------------------------------------------------------------- --+-- Tests++tests :: TestTree+tests = testGroup "Test.Pact.Time.Format"+    [ testFormats posixEpochFormats+    , testFormats mjdEpochFormats+    , checkCase posixEpoch q+    ]++testFormats :: Cases -> TestTree+testFormats c = testGroup (formatTime "%c" (_casesTime c)) $+    checkCase (_casesTime c) <$> _casesExpectations c++checkCase :: UTCTime -> (String, String, String) -> TestTree+checkCase t (e, f, m) = testCase m $ e @=? formatTime f t++data Cases = Cases+    { _casesTime :: !UTCTime+    , _casesExpectations :: ![(String, String, String)]+    }++-- -------------------------------------------------------------------------- --+-- Test Cases++-- TODO+--+q :: (String, String, String)+-- q = ("%q", "%q", "\"%q\" is not supported by Pact")+q = ("000000000000", "%q", "\"%q\" is not supported by Pact")++-- | 1970-01-01T00:00:00.000000Z+--+posixEpochFormats :: Cases+posixEpochFormats = Cases posixEpoch+    [ ("%", "%%", "literal \"%\"")+    , ("+0000", "%z", "RFC 822/ISO 8601:1988 style numeric time zone (e.g., \"-0600\" or \"+0100\")")+    , ("+00:00", "%N", "ISO 8601 style numeric time zone (e.g., \"-06:00\" or \"+01:00\") /EXTENSION/")+    , ("UTC", "%Z", "timezone name")+    , ("Thu Jan  1 00:00:00 UTC 1970", "%c", "same as \"%a %b %e %H:%M:%S %Z %Y\"")+    , ("00:00", "%R", "same as \"%H:%M\"")+    , ("00:00:00", "%T", "same as \"%H:%M:%S\"")+    , ("00:00:00", "%X", "same as \"%H:%M:%S\"")+    , ("12:00:00 AM", "%r", "same as \"%I:%M:%S %p\" (time12Fmt)")+    , ("am", "%P", "lowercase day-half of day (\"am\", or \"pm\")")+    , ("AM", "%p", "uppercase day-half of day (\"AM\", \"PM\")")+    , ("00", "%H", "hour of day (24-hour), 0-padded to two chars, \"00\"–\"23\"")+    , (" 0", "%k", "hour of day (24-hour), space-padded to two chars, \" 0\"–\"23\"")+    , ("12", "%I", "hour of day-half (12-hour), 0-padded to two chars, \"01\"–\"12\"")+    , ("12", "%l", "hour of day-half (12-hour), space-padded to two chars, \" 1\"–\"12\"")+    , ("00", "%M", "minute of hour, 0-padded to two chars, \"00\"–\"59\"")+    , ("00", "%S", "second of minute (without decimal part), 0-padded to two chars, \"00\"–\"60\"")+    , ("000000", "%v", "microsecond of second, 0-padded to six chars, \"000000\"–\"999999\". /EXTENSION/")+    , ("", "%Q", "decimal point and fraction of second, up to 6 second decimals, without trailing zeros. For a whole number of seconds, %Q produces the empty string. /EXTENSION/")+    , ("0", "%s", "number of whole seconds since the Unix epoch. For times before the Unix epoch, this is a negative number. Note that in %s.%q and %s%Q the decimals are positive, not negative. For example, 0.9 seconds before the Unix epoch is formatted as \"-1.1\" with %s%Q.")+    , ("01/01/70", "%D", "same as \"%m/%d/%y\"")+    , ("1970-01-01", "%F", "same as \"%Y-%m-%d\"")+    , ("01/01/70", "%x", "same as \"%m/%d/%y\" (dateFmt)")+    , ("1970", "%Y", "year, no padding.")+    , ("70", "%y", "year of century, 0-padded to two chars, \"00\"–\"99\"")+    , ("19", "%C", "century, no padding.")+    , ("January", "%B", "month name, long form (\"January\"–\"December\")")+    , ("Jan", "%b", "month name, short form (\"Jan\"–\"Dec\")")+    , ("Jan", "%h", "month name, short form (\"Jan\"–\"Dec\")")+    , ("01", "%m", "month of year, 0-padded to two chars, \"01\"–\"12\"")+    , ("01", "%d", "day of month, 0-padded to two chars, \"01\"–\"31\"")+    , (" 1", "%e", "day of month, space-padded to two chars, \" 1\"–\"31\"")+    , ("001", "%j", "day of year, 0-padded to three chars, \"001\"–\"366\"")+    , ("1970", "%G", "year for Week Date format, no padding.")+    , ("70", "%g", "year of century for Week Date format, 0-padded to two chars, \"00\"–\"99\"")+    , ("19", "%f", "century for Week Date format, no padding. /EXTENSION/")+    , ("01", "%V", "week of year for Week Date format, 0-padded to two chars, \"01\"–\"53\"")+    , ("4", "%u", "day of week for Week Date format, \"1\"–\"7\"")+    , ("Thu", "%a", "day of week, short form (\"Sun\"–\"Sat\")")+    , ("Thursday", "%A", "day of week, long form (\"Sunday\"–\"Saturday\")")+    , ("00", "%U", "week of year where weeks start on Sunday, 0-padded to two chars, \"00\"–\"53\"")+    , ("4", "%w", "day of week number, \"0\" (= Sunday) – \"6\" (= Saturday)")+    , ("00", "%W", "week of year where weeks start on Monday, 0-padded to two chars, \"00\"–\"53\"")+    ]++-- | 1858-11-17T00:00:00.000000Z+--+mjdEpochFormats :: Cases+mjdEpochFormats = Cases mjdEpoch+    [ ("%", "%%", "literal \"%\"")+    , ("+0000", "%z", "RFC 822/ISO 8601:1988 style numeric time zone (e.g., \"-0600\" or \"+0100\")")+    , ("+00:00", "%N", "ISO 8601 style numeric time zone (e.g., \"-06:00\" or \"+01:00\") /EXTENSION/")+    , ("UTC", "%Z", "timezone name")+    , ("Wed Nov 17 00:00:00 UTC 1858", "%c", "same as \"%a %b %e %H:%M:%S %Z %Y\"")+    , ("00:00", "%R", "same as \"%H:%M\"")+    , ("00:00:00", "%T", "same as \"%H:%M:%S\"")+    , ("00:00:00", "%X", "same as \"%H:%M:%S\"")+    , ("12:00:00 AM", "%r", "same as \"%I:%M:%S %p\" (time12Fmt)")+    , ("am", "%P", "lowercase day-half of day (\"am\", or \"pm\")")+    , ("AM", "%p", "uppercase day-half of day (\"AM\", \"PM\")")+    , ("00", "%H", "hour of day (24-hour), 0-padded to two chars, \"00\"–\"23\"")+    , (" 0", "%k", "hour of day (24-hour), space-padded to two chars, \" 0\"–\"23\"")+    , ("12", "%I", "hour of day-half (12-hour), 0-padded to two chars, \"01\"–\"12\"")+    , ("12", "%l", "hour of day-half (12-hour), space-padded to two chars, \" 1\"–\"12\"")+    , ("00", "%M", "minute of hour, 0-padded to two chars, \"00\"–\"59\"")+    , ("00", "%S", "second of minute (without decimal part), 0-padded to two chars, \"00\"–\"60\"")+    , ("000000", "%v", "microsecond of second, 0-padded to six chars, \"000000\"–\"999999\". /EXTENSION/")+    , ("", "%Q", "decimal point and fraction of second, up to 6 second decimals, without trailing zeros. For a whole number of seconds, %Q produces the empty string. /EXTENSION/")+    , ("-3506716800", "%s", "number of whole seconds since the Unix epoch. For times before the Unix epoch, this is a negative number. Note that in %s.%q and %s%Q the decimals are positive, not negative. For example, 0.9 seconds before the Unix epoch is formatted as \"-1.1\" with %s%Q.")+    , ("11/17/58", "%D", "same as \"%m/%d/%y\"")+    , ("1858-11-17", "%F", "same as \"%Y-%m-%d\"")+    , ("11/17/58", "%x", "same as \"%m/%d/%y\" (dateFmt)")+    , ("1858", "%Y", "year, no padding.")+    , ("58", "%y", "year of century, 0-padded to two chars, \"00\"–\"99\"")+    , ("18", "%C", "century, no padding.")+    , ("November", "%B", "month name, long form (\"January\"–\"December\")")+    , ("Nov", "%b", "month name, short form (\"Jan\"–\"Dec\")")+    , ("Nov", "%h", "month name, short form (\"Jan\"–\"Dec\")")+    , ("11", "%m", "month of year, 0-padded to two chars, \"01\"–\"12\"")+    , ("17", "%d", "day of month, 0-padded to two chars, \"01\"–\"31\"")+    , ("17", "%e", "day of month, space-padded to two chars, \" 1\"–\"31\"")+    , ("321", "%j", "day of year, 0-padded to three chars, \"001\"–\"366\"")+    , ("1858", "%G", "year for Week Date format, no padding.")+    , ("58", "%g", "year of century for Week Date format, 0-padded to two chars, \"00\"–\"99\"")+    , ("18", "%f", "century for Week Date format, no padding. /EXTENSION/")+    , ("46", "%V", "week of year for Week Date format, 0-padded to two chars, \"01\"–\"53\"")+    , ("3", "%u", "day of week for Week Date format, \"1\"–\"7\"")+    , ("Wed", "%a", "day of week, short form (\"Sun\"–\"Sat\")")+    , ("Wednesday", "%A", "day of week, long form (\"Sunday\"–\"Saturday\")")+    , ("46", "%U", "week of year where weeks start on Sunday, 0-padded to two chars, \"00\"–\"53\"")+    , ("3", "%w", "day of week number, \"0\" (= Sunday) – \"6\" (= Saturday)")+    , ("46", "%W", "week of year where weeks start on Monday, 0-padded to two chars, \"00\"–\"53\"")+    ]++-- | https://pact-language.readthedocs.io/en/stable/pact-reference.html#time-formats+--+-- Can be used as a tempalte to define new test cases+--+formats :: [(String, String)]+formats =+    [ ("%%", "literal \"%\"")+    , ("%z", "RFC 822/ISO 8601:1988 style numeric time zone (e.g., \"-0600\" or \"+0100\")")+    , ("%N", "ISO 8601 style numeric time zone (e.g., \"-06:00\" or \"+01:00\") /EXTENSION/")+    , ("%Z", "timezone name")+    , ("%c", "same as \"%a %b %e %H:%M:%S %Z %Y\"")+    , ("%R", "same as \"%H:%M\"")+    , ("%T", "same as \"%H:%M:%S\"")+    , ("%X", "same as \"%H:%M:%S\"")+    , ("%r", "same as \"%I:%M:%S %p\" (time12Fmt)")+    , ("%P", "lowercase day-half of day (\"am\", or \"pm\")")+    , ("%p", "uppercase day-half of day (\"AM\", \"PM\")")+    , ("%H", "hour of day (24-hour), 0-padded to two chars, \"00\"–\"23\"")+    , ("%k", "hour of day (24-hour), space-padded to two chars, \" 0\"–\"23\"")+    , ("%I", "hour of day-half (12-hour), 0-padded to two chars, \"01\"–\"12\"")+    , ("%l", "hour of day-half (12-hour), space-padded to two chars, \" 1\"–\"12\"")+    , ("%M", "minute of hour, 0-padded to two chars, \"00\"–\"59\"")+    , ("%S", "second of minute (without decimal part), 0-padded to two chars, \"00\"–\"60\"")+    , ("%v", "microsecond of second, 0-padded to six chars, \"000000\"–\"999999\". /EXTENSION/")+    , ("%Q", "decimal point and fraction of second, up to 6 second decimals, without trailing zeros. For a whole number of seconds, %Q produces the empty string. /EXTENSION/")+    , ("%s", "number of whole seconds since the Unix epoch. For times before the Unix epoch, this is a negative number. Note that in %s.%q and %s%Q the decimals are positive, not negative. For example, 0.9 seconds before the Unix epoch is formatted as \"-1.1\" with %s%Q.")+    , ("%D", "same as \"%m/%d/%y\"")+    , ("%F", "same as \"%Y-%m-%d\"")+    , ("%x", "same as \"%m/%d/%y\" (dateFmt)")+    , ("%Y", "year, no padding.")+    , ("%y", "year of century, 0-padded to two chars, \"00\"–\"99\"")+    , ("%C", "century, no padding.")+    , ("%B", "month name, long form (\"January\"–\"December\")")+    , ("%b", "month name, short form (\"Jan\"–\"Dec\")")+    , ("%h", "month name, short form (\"Jan\"–\"Dec\")")+    , ("%m", "month of year, 0-padded to two chars, \"01\"–\"12\"")+    , ("%d", "day of month, 0-padded to two chars, \"01\"–\"31\"")+    , ("%e", "day of month, space-padded to two chars, \" 1\"–\"31\"")+    , ("%j", "day of year, 0-padded to three chars, \"001\"–\"366\"")+    , ("%G", "year for Week Date format, no padding.")+    , ("%g", "year of century for Week Date format, 0-padded to two chars, \"00\"–\"99\"")+    , ("%f", "century for Week Date format, no padding. /EXTENSION/")+    , ("%V", "week of year for Week Date format, 0-padded to two chars, \"01\"–\"53\"")+    , ("%u", "day of week for Week Date format, \"1\"–\"7\"")+    , ("%a", "day of week, short form (\"Sun\"–\"Sat\")")+    , ("%A", "day of week, long form (\"Sunday\"–\"Saturday\")")+    , ("%U", "week of year where weeks start on Sunday, 0-padded to two chars, \"00\"–\"53\"")+    , ("%w", "day of week number, \"0\" (= Sunday) – \"6\" (= Saturday)")+    , ("%W", "week of year where weeks start on Monday, 0-padded to two chars, \"00\"–\"53\"")+    -- , "%q" -- (picoseconds, zero-padded) does not work properly so not documented here.+    ]