pact-time (empty) → 0.1.0.0
raw patch · 13 files changed
+2321/−0 lines, 13 filesdep +Decimaldep +aesondep +attoparsec
Dependencies added: Decimal, aeson, attoparsec, base, bytestring, cereal, clock, deepseq, microlens, mtl, pact-time, tasty, tasty-hunit, text, time, vector, vector-space
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +17/−0
- pact-time.cabal +101/−0
- src/Data/Time.hs +57/−0
- src/Data/Time/Format.hs +24/−0
- src/Data/Time/Format/External.hs +149/−0
- src/Data/Time/Format/Internal.hs +1240/−0
- src/Data/Time/Format/Locale.hs +97/−0
- src/Data/Time/Internal.hs +316/−0
- src/Data/Time/System.hs +37/−0
- test/Main.hs +27/−0
- test/Test/Data/Time/Format.hs +221/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for pact-time++## 0.1.0.0 -- 2021-05-06++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2021, Kadena LLC.++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.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Lars Kuhtz nor the names of other+ 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.
+ README.md view
@@ -0,0 +1,17 @@+# Pact-Time Library++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 a 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).+
+ pact-time.cabal view
@@ -0,0 +1,101 @@+cabal-version: 2.4+name: pact-time+version: 0.1.0.0+synopsis: Time Library for Pact+Description:+ 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).++homepage: https://github.com/kadena-io/pact-time+bug-reports: https://github.com/kadena-io/pact-time/issues+license: BSD-3-Clause+license-file: LICENSE+author: Lars Kuhtz+maintainer: lakuhtz@gmail.com+copyright: Copyright (c) 2021 Kadena LLC.+category: Data, System+tested-with:+ GHC==9.0.1+ GHC==8.10.4+ GHC==8.8.4+ GHC==8.6.5+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/kadena-io/pact-time.git++flag with-time+ description: Use the time package for parsing and formatting+ manual: True+ default: False++library+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options:+ -Wall+ exposed-modules:+ Data.Time+ Data.Time.Internal+ Data.Time.Format+ Data.Time.System+ build-depends:+ -- external+ , Decimal >=0.4+ , aeson >=0.11+ , attoparsec >= 0.13+ , base >=4.11 && <4.16+ , bytestring >=0.10+ , cereal >=0.5+ , deepseq >=1.4+ , microlens >=0.4+ , text >=1.2+ , vector >=0.12+ , vector-space >=0.10++ if flag(with-time)+ cpp-options: -DWITH_TIME=1+ other-modules: Data.Time.Format.External+ build-depends: time >= 1.8+ else+ cpp-options: -DWITH_TIME=0+ other-modules:+ Data.Time.Format.Internal+ Data.Time.Format.Locale+ build-depends:+ , clock >= 0.7.2+ , mtl >=2.2++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options:+ -Wall+ -rtsopts+ -threaded+ -with-rtsopts=-N+ main-is: Main.hs+ other-modules:+ Test.Data.Time.Format+ build-depends:+ pact-time++ , base >=4.11 && <4.16+ , tasty >=1.4+ , tasty-hunit >=0.10
+ src/Data/Time.hs view
@@ -0,0 +1,57 @@+{-# 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+
+ src/Data/Time/Format.hs view
@@ -0,0 +1,24 @@+{-# 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+
+ src/Data/Time/Format/External.hs view
@@ -0,0 +1,149 @@+{-# 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+
+ src/Data/Time/Format/Internal.hs view
@@ -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: 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 #-}+
+ src/Data/Time/Format/Locale.hs view
@@ -0,0 +1,97 @@+{-# 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"+ }+
+ src/Data/Time/Internal.hs view
@@ -0,0 +1,316 @@+{-# 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 #-}+
+ src/Data/Time/System.hs view
@@ -0,0 +1,37 @@+{-# 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 #-}+
+ test/Main.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Main+-- Copyright: Copyright © 2021 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- TODO+--+module Main+( main+) where++import Test.Tasty++-- internal modules++import qualified Test.Data.Time.Format (tests)++main :: IO ()+main = defaultMain $ testGroup "tests"+ [ Test.Data.Time.Format.tests+ ]
+ test/Test/Data/Time/Format.hs view
@@ -0,0 +1,221 @@+{-# 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.+ ]