chronos 1.1.2 → 1.1.3

raw patch · 4 files changed

+384/−177 lines, 4 filesdep +bytebuilddep +byteslicedep +bytesmithdep −clockdep ~aesondep ~attoparsecdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: bytebuild, byteslice, bytesmith, natural-arithmetic, text-short

Dependencies removed: clock

Dependency ranges changed: aeson, attoparsec, base

API changes (from Hackage documentation)

Files

• bench/Bench.hs +86/−45
• chronos.cabal +37/−60
• src/Chronos.hs +230/−67
• test/Spec.hs +31/−5

@@ -7,81 +7,53 @@  module Main where -import qualified Data.Vector.Unboxed as UVector+import Control.Applicative import Criterion.Main import Data.Int-import Data.Maybe (fromMaybe)+import Data.Word+ import Control.DeepSeq (($!!), NFData(..), deepseq)-import qualified Data.ByteString.Char8 as BS8-import Test.QuickCheck (arbitrary, generate)+import Control.Monad (when) import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, char)-import qualified Data.Attoparsec.Zepto as Z import Data.Foldable (traverse_)-import Data.Word-import Control.Monad (when)-import Control.Applicative+import Data.Maybe (fromMaybe) import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Short (ShortText)+import Test.QuickCheck (arbitrary, generate) -import qualified Data.Time as Time+import qualified Chronos+import qualified Data.Attoparsec.Zepto as Z+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Short as TS import qualified Data.Thyme as Thyme+import qualified Data.Time as Time+import qualified Data.Vector.Unboxed as UVector import qualified System.Locale as Thyme-import qualified Chronos  main :: IO () main = do   utcthyme <- generate arbitrary :: IO Thyme.UTCTime   let-    isoFormatString = "%Y-%m-%dT%H:%M:%S"     renderIsoTime = Thyme.formatTime Thyme.defaultTimeLocale isoFormatString-    timeParser :: String -> Time.UTCTime-    timeParser =-      fromMaybe (error "Failed to parse in timeParser")-      . Time.parseTimeM True Time.defaultTimeLocale isoFormatString-    thymeParser :: String -> Thyme.UTCTime-    thymeParser =-      fromMaybe (error "Failed to parse in thymeParser")-      . Thyme.parseTime Thyme.defaultTimeLocale isoFormatString-    thymeAttoparsec :: BS8.ByteString -> Thyme.UTCTime-    thymeAttoparsec =-      Thyme.buildTime @Thyme.UTCTime-      . either error id-      . parseOnly (Thyme.timeParser Thyme.defaultTimeLocale isoFormatString)     -- With chronos, we explicitly convert the ymdhms time to the     -- nanoseconds since the epoch. This is done to make the benchmark     -- compare apples to apples. Both thyme and time are computing epoch     -- times, so we want chronos to do the same.-    chronosAttoparsec :: BS8.ByteString -> Chronos.Time-    chronosAttoparsec =-      either error Chronos.datetimeToTime-      . parseOnly (Chronos.parserUtf8_YmdHMS Chronos.w3c)-    chronosZepto :: BS8.ByteString -> Chronos.Time-    chronosZepto =-      either error Chronos.datetimeToTime-      . Z.parse (Chronos.zeptoUtf8_YmdHMS Chronos.w3c)      dmy              = "%d:%m:%y."-    hms              = "%%H:%M:%S."+    hms              = "%H:%M:%S."     dmyhms           = isoFormatString     timePretty       = Time.formatTime Time.defaultTimeLocale     thymePretty      = Thyme.formatTime Thyme.defaultTimeLocale-    chronosPrettyDmy = toLazyText-      . Chronos.builder_Dmy (Just ':')-      . Chronos.datetimeDate-      . Chronos.timeToDatetime-    chronosPrettyHMS = toLazyText-      . Chronos.builder_HMS Chronos.SubsecondPrecisionAuto (Just ':')-      . Chronos.datetimeTime-      . Chronos.timeToDatetime-    chronosPrettyYmdHMS = toLazyText-      . Chronos.builder_YmdHMS Chronos.SubsecondPrecisionAuto Chronos.w3c-      . Chronos.timeToDatetime    timeTime  <- Time.getCurrentTime   thymeTime <- Thyme.getCurrentTime   chronosTime <- Chronos.now    string <- return $!! renderIsoTime utcthyme-  bytestring <- return $!! BS8.pack (renderIsoTime utcthyme)+  bytestring <- return $!! BS8.pack string+  shortText <- return $!! TS.pack string    defaultMain     [ bgroup "parsing"@@ -90,6 +62,7 @@       , bench "Thyme.timeParser"          $ nf thymeAttoparsec   bytestring       , bench "Chronos.parserUtf8_YmdHMS" $ nf chronosAttoparsec bytestring       , bench "Chronos.zeptoUtf8_YmdHMS"  $ nf chronosZepto      bytestring+      , bench "Chronos.decodeShortTextIso8601" $ nf chronosIso8601 shortText       ]      , bgroup "prettyPrint"@@ -108,5 +81,73 @@         , bench "Thyme.formatTime"       $ nf (thymePretty dmyhms) thymeTime         , bench "Chronos.builder_YmdHMS" $ nf chronosPrettyYmdHMS  chronosTime         ]+      , bgroup "ISO-8601-Zulu"+        [ bench "Chronos.encodeShortTextIso8601Zulu" $ nf encodeChronosIso8601Zulu chronosTime+        ]       ]     ]++encodeChronosIso8601Zulu :: Chronos.Time -> ShortText+encodeChronosIso8601Zulu !t =+  Chronos.encodeShortTextIso8601Zulu (Chronos.timeToDatetime t)++chronosIso8601 :: ShortText -> Chronos.Time+{-# noinline chronosIso8601 #-}+chronosIso8601 !t = case Chronos.decodeShortTextIso8601Zoneless t of+  Just x -> Chronos.datetimeToTime x+  Nothing -> errorWithoutStackTrace "chronosIso8601: decode failure"++chronosZepto :: BS8.ByteString -> Chronos.Time+{-# noinline chronosZepto #-}+chronosZepto !bs = either error Chronos.datetimeToTime+  (Z.parse (Chronos.zeptoUtf8_YmdHMS Chronos.w3c) bs)+++chronosPrettyYmdHMS :: Chronos.Time -> LT.Text+{-# noinline chronosPrettyYmdHMS #-}+chronosPrettyYmdHMS = toLazyText+  . Chronos.builder_YmdHMS Chronos.SubsecondPrecisionAuto Chronos.w3c+  . Chronos.timeToDatetime++chronosPrettyHMS :: Chronos.Time -> LT.Text+{-# noinline chronosPrettyHMS #-}+chronosPrettyHMS = toLazyText+  . Chronos.builder_HMS Chronos.SubsecondPrecisionAuto (Just ':')+  . Chronos.datetimeTime+  . Chronos.timeToDatetime++chronosPrettyDmy :: Chronos.Time -> LT.Text+{-# noinline chronosPrettyDmy #-}+chronosPrettyDmy = toLazyText+  . Chronos.builder_Dmy (Just ':')+  . Chronos.datetimeDate+  . Chronos.timeToDatetime++chronosAttoparsec :: BS8.ByteString -> Chronos.Time+{-# noinline chronosAttoparsec #-}+chronosAttoparsec =+    either error Chronos.datetimeToTime+  . parseOnly (Chronos.parserUtf8_YmdHMS Chronos.w3c)++timeParser :: String -> Time.UTCTime+{-# noinline timeParser #-}+timeParser =+  fromMaybe (error "Failed to parse in timeParser")+  . Time.parseTimeM True Time.defaultTimeLocale isoFormatString++thymeParser :: String -> Thyme.UTCTime+{-# noinline thymeParser #-}+thymeParser =+  fromMaybe (error "Failed to parse in thymeParser")+  . Thyme.parseTime Thyme.defaultTimeLocale isoFormatString++thymeAttoparsec :: BS8.ByteString -> Thyme.UTCTime+{-# noinline thymeAttoparsec #-}+thymeAttoparsec =+  Thyme.buildTime @Thyme.UTCTime+  . either error id+  . parseOnly (Thyme.timeParser Thyme.defaultTimeLocale isoFormatString)++isoFormatString :: String+{-# noinline isoFormatString #-}+isoFormatString = "%Y-%m-%dT%H:%M:%S"

@@ -1,10 +1,7 @@ cabal-version: 3.0-name:-  chronos-version:-  1.1.2-synopsis:-  A high-performance time library+name: chronos+version: 1.1.3+synopsis: A high-performance time library description:   Chronos is a performance-oriented time library for Haskell, with a   straightforward API. The main differences between this@@ -28,27 +25,19 @@       format strings. The approach taken by Chronos is faster and       catches more mistakes at compile time, at the cost of being       less expressive.-homepage:-  https://github.com/andrewthad/chronos-license:-  BSD-3-Clause-license-file:-  LICENSE-author:-  Andrew Martin+homepage: https://github.com/andrewthad/chronos+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin maintainer:   Andrew Martin <andrew.thaddeus@gmail.com>   chessai <chessai1996@gmail.com>-copyright:-  2016 Andrew Martin-category:-  Data, Time, Parsing, Development-build-type:-  Simple+copyright: 2016 Andrew Martin+category: Data, Time, Parsing, Development+build-type: Simple  library-  hs-source-dirs:-    src+  hs-source-dirs: src   exposed-modules:       Chronos       Chronos.Types@@ -57,9 +46,9 @@     -- it is OPTIONS_HADDOCK-hidden       Chronos.Internal.CTimespec   build-depends:-    , aeson >= 1.1 && < 1.5-    , attoparsec >= 0.13 && < 0.14-    , base >= 4.9 && < 5+    , aeson >= 1.1 && < 1.6+    , attoparsec >= 0.13 && < 0.15+    , base >= 4.12 && < 5     , bytestring >= 0.10 && < 0.11     , deepseq >= 1.4.4.0     , hashable >= 1.2 && < 1.4@@ -68,29 +57,27 @@     , text >= 1.2 && < 1.3     , torsor >= 0.1 && < 0.2     , vector >= 0.11 && < 0.13+    , bytebuild >= 0.3.8 && < 0.4+    , bytesmith >= 0.3.7 && < 0.4+    , byteslice >= 0.2.5.2 && <0.3+    , text-short >= 0.1.3 && <0.2+    , natural-arithmetic >= 0.1.2 && <0.2   if os(windows)     build-depends: Win32 >= 2.2 && < 2.9-  if impl(ghc < 8.4)-    build-depends: clock >= 0.7 && < 0.9-  default-language:-    Haskell2010-  c-sources:-    src/cbits/hs-time.c+  default-language: Haskell2010+  c-sources: src/cbits/hs-time.c   ghc-options:     -Wall     -O2  test-suite chronos-test-  type:-    exitcode-stdio-1.0-  hs-source-dirs:-    test-  main-is:-    Spec.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs   build-depends:     , HUnit     , QuickCheck-    , aeson >= 1.1 && < 1.5+    , aeson >= 1.1 && < 1.6     , attoparsec     , base     , bytestring@@ -104,16 +91,12 @@   ghc-options:     -threaded     -rtsopts -with-rtsopts=-N-  default-language:-    Haskell2010+  default-language: Haskell2010  test-suite doctest-  type:-    exitcode-stdio-1.0-  hs-source-dirs:-    test-  main-is:-    Doctests.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Doctests.hs   build-depends:     , QuickCheck     , base@@ -121,16 +104,12 @@     , deepseq >= 1.4.4.0     , doctest >= 0.10     , torsor >= 0.1 && < 0.2-  default-language:-    Haskell2010+  default-language: Haskell2010  benchmark bench-  type:-    exitcode-stdio-1.0-  hs-source-dirs:-    bench-  main-is:-    Bench.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: bench+  main-is: Bench.hs   build-depends:     , QuickCheck     , attoparsec@@ -142,14 +121,12 @@     , deepseq >= 1.4.4.0     , old-locale     , text+    , text-short     , thyme     , time     , vector-  default-language:-    Haskell2010+  default-language: Haskell2010  source-repository head-  type:-    git-  location:-    https://github.com/andrewthad/chronos+  type: git+  location: https://github.com/andrewthad/chronos

@@ -3,7 +3,9 @@   , CPP   , DeriveGeneric   , GeneralizedNewtypeDeriving+  , LambdaCase   , MultiParamTypeClasses+  , NumericUnderscores   , OverloadedStrings   , RecordWildCards   , ScopedTypeVariables@@ -52,10 +54,6 @@     -- ** Duration   , stopwatch   , stopwatch_-#if !MIN_VERSION_base(4,11,0)-  , stopwatchWith-  , stopwatchWith_-#endif     -- ** Construction   , datetimeFromYmdhms   , timeFromYmdhms@@ -199,6 +197,13 @@   , parserUtf8_YmdHMS   , parserUtf8_YmdHMS_opt_S   , zeptoUtf8_YmdHMS+    -- *** UTF-8 Bytes+  , boundedBuilderUtf8BytesIso8601Zoneless+  , decodeUtf8BytesIso8601Zoneless+    -- *** Short Text+  , decodeShortTextIso8601Zoneless+  , encodeShortTextIso8601Zulu+  , encodeShortTextIso8601Zoneless     -- ** Offset Datetime     -- *** Text   , encode_YmdHMSz@@ -215,6 +220,13 @@   , parserUtf8_YmdHMSz   , builderUtf8_YmdIMS_p_z   , builderUtf8W3Cz+    -- *** UTF-8 Bytes+  , parserUtf8BytesIso8601+  , boundedBuilderUtf8BytesIso8601+  , decodeUtf8BytesIso8601+    -- *** ShortText+  , decodeShortTextIso8601+  , encodeShortTextIso8601     -- ** Offset     -- *** Text   , encodeOffset@@ -277,6 +289,8 @@ import Control.Monad import Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey) import Data.Attoparsec.Text (Parser)+import Data.Bool (bool)+import Data.Bytes (Bytes) import Data.ByteString (ByteString) import Data.Char (isDigit) import Data.Foldable@@ -284,36 +298,42 @@ import Data.Int (Int64) import Data.Primitive import Data.Text (Text)+import Data.Text.Short (ShortText) import Data.Vector (Vector) import Data.Word (Word64, Word8) import Foreign.Storable+import GHC.Clock (getMonotonicTimeNSec) import GHC.Generics (Generic) import Torsor+import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat import qualified Data.Aeson as AE import qualified Data.Aeson.Encoding as AEE import qualified Data.Aeson.Types as AET import qualified Data.Attoparsec.ByteString.Char8 as AB import qualified Data.Attoparsec.Text as AT import qualified Data.Attoparsec.Zepto as Z+import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Builder.Bounded as Bounded+import qualified Data.Bytes.Parser as BVP+import qualified Data.Bytes.Parser.Latin as Latin import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Short.Internal as SBS import qualified Data.Semigroup as SG import qualified Data.Text as Text import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Lazy.Builder.Int as TB import qualified Data.Text.Read as Text+import qualified Data.Text.Short as TS+import qualified Data.Text.Short.Unsafe as TS import qualified Data.Vector as Vector import qualified Data.Vector.Generic as GVector import qualified Data.Vector.Generic.Mutable as MGVector import qualified Data.Vector.Primitive as PVector import qualified Data.Vector.Unboxed as UVector-#if MIN_VERSION_base(4,11,0)-import GHC.Clock (getMonotonicTimeNSec)-#else-import qualified System.Clock as CLK-#endif  #ifdef mingw32_HOST_OS import System.Win32.Time (SYSTEMTIME(..))@@ -322,10 +342,6 @@ import Chronos.Internal.CTimespec (getPosixNanoseconds) #endif -#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup (Semigroup, (<>))-#endif- -- $setup -- >>> import Test.QuickCheck hiding (within) -- >>> import Test.QuickCheck.Gen@@ -552,7 +568,6 @@ epoch :: Time epoch = Time 0 -#if MIN_VERSION_base(4,11,0) -- | Measures the time it takes to run an action and evaluate --   its result to WHNF. This measurement uses a monotonic clock --   instead of the standard system clock.@@ -572,44 +587,7 @@   _ <- action   end <- getMonotonicTimeNSec   pure (Timespan (fromIntegral (end - start)))-#else --- | Measures the time it takes to run an action and evaluate---   its result to WHNF. This measurement uses a monotonic clock---   instead of the standard system clock.-stopwatch :: IO a -> IO (Timespan, a)-stopwatch = stopwatchWith CLK.Monotonic---- | Measures the time it takes to run an action. The result---   is discarded. This measurement uses a monotonic clock---   instead of the standard system clock.-stopwatch_ :: IO a -> IO Timespan-stopwatch_ = stopwatchWith_ CLK.Monotonic---- | Variant of 'stopwatch' that accepts a clock type. Users---   need to import @System.Clock@ from the @clock@ package---   in order to provide the clock type.-stopwatchWith :: CLK.Clock -> IO a -> IO (Timespan, a)-stopwatchWith c action = do-  start <- CLK.getTime c-  a <- action >>= evaluate-  end <- CLK.getTime c-  pure (timeSpecToTimespan (CLK.diffTimeSpec end start),a)-{-# DEPRECATED stopwatchWith "stopwatchWith will be removed in a future majour version" #-}---- | Variant of 'stopwatch_' that accepts a clock type.-stopwatchWith_ :: CLK.Clock -> IO a -> IO Timespan-stopwatchWith_ c action = do-  start <- CLK.getTime c-  _ <- action-  end <- CLK.getTime c-  pure (timeSpecToTimespan (CLK.diffTimeSpec end start))-{-# DEPRECATED stopwatchWith_ "stopwatchWith_ will be removed in a future majour version" #-}--timeSpecToTimespan :: CLK.TimeSpec -> Timespan-timeSpecToTimespan (CLK.TimeSpec s ns) = Timespan (s * 1000000000 + ns)-#endif- -- UtcTime. Used internally only. data UtcTime = UtcTime   {-# UNPACK #-} !Day -- day@@ -1238,14 +1216,17 @@   nanoseconds <-     ( do _ <- AT.char '.'          numberOfZeroes <- countZeroes-         x <- AT.decimal-         let totalDigits = countDigits x + numberOfZeroes-             result = if totalDigits == 9-               then x-               else if totalDigits < 9-                 then x * raiseTenTo (9 - totalDigits)-                 else quot x (raiseTenTo (totalDigits - 9))-         pure (fromIntegral result)+         AT.peekChar >>= \case+           Just c | c >= '0' && c <= '9' -> do+             x <- AT.decimal+             let totalDigits = countDigits x + numberOfZeroes+                 result = if totalDigits == 9+                   then x+                   else if totalDigits < 9+                     then x * raiseTenTo (9 - totalDigits)+                     else quot x (raiseTenTo (totalDigits - 9))+             pure (fromIntegral result)+           _ -> pure 0     ) <|> pure 0   pure (s * 1000000000 + nanoseconds) @@ -1844,18 +1825,22 @@ parseSecondsAndNanosecondsUtf8 = do   s' <- parseFixedDigitsIntBS 2   let !s = fromIntegral s' :: Int64+  -- TODO: whoops, this should probably be gt 59, not 60   when (s > 60) (fail "seconds must be between 0 and 60")   nanoseconds <-     ( do _ <- AB.char '.'          numberOfZeroes <- countZeroesUtf8-         x <- AB.decimal-         let totalDigits = countDigits x + numberOfZeroes-             result = if totalDigits == 9-               then x-               else if totalDigits < 9-                 then x * raiseTenTo (9 - totalDigits)-                 else quot x (raiseTenTo (totalDigits - 9))-         pure (fromIntegral result)+         AB.peekChar >>= \case+           Just c | c >= '0' && c <= '9' -> do+             x <- AB.decimal+             let totalDigits = countDigits x + numberOfZeroes+                 result = if totalDigits == 9+                   then x+                   else if totalDigits < 9+                     then x * raiseTenTo (9 - totalDigits)+                     else quot x (raiseTenTo (totalDigits - 9))+             pure (fromIntegral result)+           _ -> pure 0     ) <|> pure 0   pure (s * 1000000000 + nanoseconds) @@ -3185,3 +3170,181 @@     , timePartsSubsecond = fromIntegral subsecond     , timePartsOffset = getOffset o     }++-- | Decode an ISO-8601-encode datetime. The encoded time must not by suffixed+-- by an offset. Any offset (e.g. @-05:00@, @+00:00@, @Z@) will cause a decode+-- failure.+decodeShortTextIso8601Zoneless :: ShortText -> Maybe Chronos.Datetime+decodeShortTextIso8601Zoneless !t = decodeUtf8BytesIso8601Zoneless+  (Bytes.fromShortByteString (TS.toShortByteString t))++-- | Decode an ISO-8601-encode datetime. The encoded time must include an offset+-- (e.g. @-05:00@, @+00:00@, @Z@).+decodeShortTextIso8601 :: ShortText -> Maybe Chronos.OffsetDatetime+decodeShortTextIso8601 !t = decodeUtf8BytesIso8601+  (Bytes.fromShortByteString (TS.toShortByteString t))++decodeUtf8BytesIso8601Zoneless :: Bytes -> Maybe Chronos.Datetime+decodeUtf8BytesIso8601Zoneless !b =+  BVP.parseBytesMaybe (parserUtf8BytesIso8601Zoneless <* BVP.endOfInput ()) b++decodeUtf8BytesIso8601 :: Bytes -> Maybe Chronos.OffsetDatetime+decodeUtf8BytesIso8601 !b =+  BVP.parseBytesMaybe (parserUtf8BytesIso8601 <* BVP.endOfInput ()) b++parserUtf8BytesIso8601Zoneless :: BVP.Parser () s Chronos.Datetime+{-# noinline parserUtf8BytesIso8601Zoneless #-}+parserUtf8BytesIso8601Zoneless = do+  year <- Latin.decWord ()+  Latin.char () '-'+  month' <- Latin.decWord ()+  let !month = month' - 1+  when (month >= 12) (BVP.fail ())+  Latin.char () '-'+  dayWord <- Latin.decWord ()+  when (dayWord > 31) (BVP.fail ())+  let !date = Chronos.Date+        (Chronos.Year (fromIntegral year))+        (Chronos.Month (fromIntegral month))+        (Chronos.DayOfMonth (fromIntegral dayWord))+  Latin.char () 'T'+  hourWord <- Latin.decWord8 ()+  when (hourWord > 23) (BVP.fail ())+  Latin.char () ':'+  minuteWord <- Latin.decWord8 ()+  when (minuteWord > 59) (BVP.fail ())+  Latin.char () ':'+  sec <- Latin.decWord8 ()+  when (sec > 59) (BVP.fail ())+  !nanos <- Latin.trySatisfy (=='.') >>= \case+    True -> do+      (n,w) <- BVP.measure (Latin.decWord64 ())+      when (n > 9) (BVP.fail ())+      let go !acc !b = case b of+            0 -> acc+            _ -> go (acc * 10) (b - 1)+          !ns = go w (9 - n)+      pure ns+    False -> pure 0+  let !td = Chronos.TimeOfDay+        (fromIntegral hourWord)+        (fromIntegral minuteWord)+        (fromIntegral @Word64 @Int64 (fromIntegral sec * 1000000000 + nanos))+  pure $! Chronos.Datetime date td++-- | Consume an ISO-8601-encoded datetime with offset. This will consume any of+-- the following:+--+-- > 2021-12-05T23:01:09Z+-- > 2021-12-05T23:01:09.000Z+-- > 2021-12-05T23:01:09.123456789Z+-- > 2021-12-05T23:01:09+05:00+-- > 2021-12-05T23:01:09.357-11:00+parserUtf8BytesIso8601 :: BVP.Parser () s Chronos.OffsetDatetime+{-# noinline parserUtf8BytesIso8601 #-}+parserUtf8BytesIso8601 = do+  dt <- parserUtf8BytesIso8601Zoneless+  off <- Latin.any () >>= \case+    'Z' -> pure 0+    '+' -> parserBytesOffset+    '-' -> do+      !off <- parserBytesOffset+      pure (negate off)+    _ -> BVP.fail ()+  pure $! Chronos.OffsetDatetime dt (Chronos.Offset off)++-- Should consume exactly five characters: HH:MM. However, the implementation+-- is more generous.+parserBytesOffset :: BVP.Parser () s Int+parserBytesOffset = do+  h <- Latin.decWord8 ()+  Latin.char () ':'+  m <- Latin.decWord8 ()+  let !r = ((fromIntegral @Word8 @Int h) * 60) + fromIntegral @Word8 @Int m+  pure r++encodeShortTextIso8601Zulu :: Datetime -> ShortText+{-# noinline encodeShortTextIso8601Zulu #-}+encodeShortTextIso8601Zulu !dt =+  let !(ByteArray x) = Bounded.run Nat.constant+        ( boundedBuilderUtf8BytesIso8601Zoneless dt+        `Bounded.append`+        Bounded.ascii 'Z'+        )+   in TS.fromShortByteStringUnsafe (SBS.SBS x)++encodeShortTextIso8601Zoneless :: Datetime -> ShortText+{-# noinline encodeShortTextIso8601Zoneless #-}+encodeShortTextIso8601Zoneless !dt =+  let !(ByteArray x) = Bounded.run Nat.constant+        (boundedBuilderUtf8BytesIso8601Zoneless dt)+   in TS.fromShortByteStringUnsafe (SBS.SBS x)++encodeShortTextIso8601 :: OffsetDatetime -> ShortText+{-# noinline encodeShortTextIso8601 #-}+encodeShortTextIso8601 offdt =+  let !(ByteArray x) = Bounded.run Nat.constant+        (boundedBuilderUtf8BytesIso8601 offdt)+   in TS.fromShortByteStringUnsafe (SBS.SBS x)++boundedBuilderUtf8BytesIso8601 :: OffsetDatetime -> Bounded.Builder 50+boundedBuilderUtf8BytesIso8601 (OffsetDatetime dt off) =+  ( boundedBuilderUtf8BytesIso8601Zoneless dt+    `Bounded.append`+    boundedBuilderOffset off+  )++-- | Encode a datetime with ISO-8601. The result does not include any+-- indication of a time zone. If the subsecond part is zero, it is suppressed.+-- Examples of output:+--+-- > 2021-01-05T23:00:51+-- > 2021-01-05T23:00:52.123000000+-- > 2021-01-05T23:00:53.674094347+boundedBuilderUtf8BytesIso8601Zoneless :: Datetime -> Bounded.Builder 44+boundedBuilderUtf8BytesIso8601Zoneless (Datetime (Date (Year y) (Month mth) (DayOfMonth d)) (TimeOfDay h mt sns)) = +    let (s,ns) = quotRem sns 1_000_000_000 in+    Bounded.wordDec (fromIntegral y)+    `Bounded.append`+    Bounded.ascii '-'+    `Bounded.append`+    Bounded.wordPaddedDec2 (fromIntegral (mth + 1))+    `Bounded.append`+    Bounded.ascii '-'+    `Bounded.append`+    Bounded.wordPaddedDec2 (fromIntegral d)+    `Bounded.append`+    Bounded.ascii 'T'+    `Bounded.append`+    Bounded.wordPaddedDec2 (fromIntegral h)+    `Bounded.append`+    Bounded.ascii ':'+    `Bounded.append`+    Bounded.wordPaddedDec2 (fromIntegral mt)+    `Bounded.append`+    Bounded.ascii ':'+    `Bounded.append`+    Bounded.wordPaddedDec2 (fromIntegral s)+    `Bounded.append`+    (case ns of+      0 -> Bounded.weaken @0 @10 Lte.constant Bounded.empty+      _ ->+        Bounded.ascii '.'+        `Bounded.append`+        Bounded.wordPaddedDec9 (fromIntegral ns)+    )++boundedBuilderOffset :: Offset -> Bounded.Builder 6+boundedBuilderOffset (Offset mins) = case mins of+  0 -> Bounded.weaken @1 @6 Lte.constant (Bounded.ascii 'Z')+  _ -> +    let !absMins = fromIntegral @Int @Word (abs mins)+        !absHrs = quot absMins 60+        !absMinutes = rem absMins 60+     in Bounded.ascii (bool '-' '+' (mins > 0))+        `Bounded.append`+        Bounded.wordPaddedDec2 absHrs+        `Bounded.append`+        Bounded.ascii ':'+        `Bounded.append`+        Bounded.wordPaddedDec2 absMinutes

@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}  module Main (main) where@@ -15,7 +17,8 @@ import Test.Framework (defaultMain,defaultMainWithOpts,testGroup,Test) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit (Assertion,(@?=),assertBool)-import Test.QuickCheck (Gen, Arbitrary(..),discard,choose,arbitraryBoundedEnum,genericShrink,elements, suchThat)+import Test.QuickCheck (Gen,Arbitrary(..),discard,genericShrink,elements,suchThat)+import Test.QuickCheck (choose,chooseInt,arbitraryBoundedEnum) import Test.QuickCheck.Property (failed,succeeded,Result(..)) import qualified Chronos as C import qualified Data.Attoparsec.ByteString as AttoBS@@ -405,6 +408,12 @@             either (const Nothing) Just $ flip Atto.parseOnly input $               C.parser_YmdHMSz offsetFormat datetimeFormat         )+    , testProperty "ISO-8601 Roundtrip" $ propEncodeDecodeIso+        C.encodeShortTextIso8601Zulu+        (\input -> case C.decodeShortTextIso8601 input of+          Just (OffsetDatetime dt (Offset 0)) -> Just dt+          _ -> Nothing+        )     ]   , testGroup "Posix Time"     [ PH.testCase "Get now" $ do@@ -637,7 +646,21 @@     <$> choose (0,23)     <*> choose (0,59)     -- never use leap seconds for property-based tests-    <*> choose (0,60000000000 - 1)+    <*> ( do subsecPrecision <- chooseInt (0,9)+             secs <- chooseInt (0,59)+             case subsecPrecision of+               0 -> pure (fromIntegral @Int @Int64 secs * 1_000_000_000)+               _ -> do+                 subsecs <- chooseInt (0,((10 :: Int) ^ subsecPrecision) - 1)+                 let subsecs' = subsecs * ((10 :: Int) ^ (9 - subsecPrecision))+                 if subsecs' < 0 || subsecs' >= 1_000_000_000+                   then error "Mistake in Arbitrary instance for TimeOfDay"+                   else pure+                     ( (fromIntegral @Int @Int64 secs * 1_000_000_000)+                       ++                       (fromIntegral @Int @Int64 subsecs)+                     )+        )  instance Arbitrary Date where   arbitrary = Date@@ -660,9 +683,12 @@  instance Arbitrary DatetimeFormat where   arbitrary = DatetimeFormat-    <$> arbitrary-    <*> elements [Nothing, Just '/', Just ':', Just '-']-    <*> arbitrary+    <$> elements [Nothing, Just '/', Just ':', Just '-', Just '.']+    <*> elements [Nothing, Just '/', Just ':', Just '-', Just 'T']+    <*> elements [Nothing, Just ':', Just '-']+  shrink (DatetimeFormat a b c)+    | a == Just '-', b == Just 'T', c == Just ':' = []+    | otherwise = [DatetimeFormat (Just '-') (Just 'T') (Just ':')]  instance Arbitrary OffsetFormat where   arbitrary = arbitraryBoundedEnum