chronos 1.0.9 → 1.1.7.0
raw patch · 11 files changed
Files
- CHANGELOG.md +104/−0
- README.md +68/−0
- Setup.hs +0/−2
- bench/Bench.hs +124/−80
- chronos.cabal +80/−108
- src/Chronos.hs +4012/−2695
- src/Chronos/Internal/CTimespec.hs +8/−1
- src/Chronos/Locale/English.hs +52/−30
- src/Chronos/Types.hs +25/−27
- test/Doctests.hs +0/−8
- test/Spec.hs +923/−395
+ CHANGELOG.md view
@@ -0,0 +1,104 @@+# Revision history for chronos++## 1.1.7.0 -- 2025.07.15++* Add `decodeIso8601Zulu` for going straight from `Text` to a `Datetime`.+* Require a newer version of the `text` library so that UTF-8 encoding is used.++## 1.1.6.2 -- 2024-12-11++* Support GHC 9.10++## 1.1.6.1 -- 2024-02-15++* Update package metadata.++## 1.1.6.0 -- 2024-01-29++* Add `sinceEpoch` and `asSeconds` functions.+* Make `boundedBuilderUtf8BytesIso8601Zoneless` suppress trailing zeros+ when a timestamp has no submillisecond part. For example, this function+ prints 2021-01-05T23:00:52.123 where it previously+ printed 2021-01-05T23:00:52.123000000.++## 1.1.5.1 -- 2023-08-24++* Allow newer `natural-arithmetic`, `primitive`, and `vector`.+* Allow base 4.18.+* Add units to offset docs.++## 1.1.5 -- 2022-11-03++* Add `decodeShortTextIso8601Zulu`.+* Add `decodeUtf8BytesIso8601ZonelessSpaced`.++## 1.1.4 -- 2022-02-21++* Fix February length in `normalYearMonthLength`. Fixes GitHub issue #67.+* Support aeson-2.x, with backward compatibility for aeson-1.x.+* Add helper `dateToDayOfWeek`+* Add helpers `encode_Ymd` and `encode_Dmy` to more easily pretty-print dates+* Add various lenses for core data type fields and isos+* Drop support for GHC 8.8 and earlier.++## 1.1.3 -- 2021-09-07++* Dropped support for GHC < 8.6.+* Integrated with `byteverse` libraries and `text-short`, adding efficient+ builders and parsers targeting UT8-encoded unpinned byte arrays. The new+ functions are: `boundedBuilderUtf8BytesIso8601Zoneless`,+ `encodeShortTextIso8601Zulu`, `encodeShortTextIso8601Zoneless`,+ `parserUtf8BytesIso8601`, `boundedBuilderUtf8BytesIso8601`,+ `decodeUtf8BytesIso8601`, `decodeShortTextIso8601`,+ `decodeShortTextIso8601Zoneless`, `decodeUtf8BytesIso8601Zoneless`,+ `encodeShortTextIso8601`.+* Corrected an implementation mistake that had caused many parsers to+ incorrectly identifier a subseconds part of 0 (i.e. `23:59:17.000`).+* Improved layout of cabal file.++## 1.1.2 -- 2021-02-08++* Adds `NFData` typeclass instances for all data types.+* Add `encodeIso8601` and `builderIso8601`.+* Soft deprecate `builderW3C` in favor of `builderIso8601`.+* Fix formatting in cabal file.++## 1.1.1 -- 2020-04-17++* Add `timeToDayOfWeek`, `datetimeToDayOfWeek`, `todayDayOfWeek`,+ `yesterdayDayOfWeek`, and `tomorrowDayOfWeek`.+* Remove `stopwatchWith(_)` on GHC 8.6+.+* Fix build on 32-bit POSIX systems.++## 1.1 -- 2019-11-28++* Drop dependency of `clock` on GHC 8.6+.+* Remove `stopwatchWith(_)` on GHC 8.6+.+* Deprecate `stopwatchWith(_)` on GHC <8.6.+* Fix build on Windows. Thanks @SpaceKitteh for reporting this.++## 1.0.9 -- 2019-11-09++* Add `TimeParts` for custom formatting.++## 1.0.8 -- 2019-11-07++* Allow newer semigroups.++## 1.0.7 -- 2019-08-16++* Fix build on windows. Chronos now builds on windows, macos, and linux. Thanks+ to @nprindle for the fix/testing and @ShrykerWindgrace for reporting it!++## 1.0.6 -- 2019-07-19++* Add 'TimeInterval' type and related functions.++## 1.0.5 -- 2019-05-01++* Allow newer version of `clock` (==0.7.* ===> >=0.7 && < 0.9)+* Build with -Wall+* Build with -O2++## 1.0.4 -- 2018-08-14+* Initial version, w.r.t. CHANGELOG (i.e. there was no changelog before).
+ README.md view
@@ -0,0 +1,68 @@+# Chronos++Chronos is a performance-oriented time library for Haskell, with a+straightforward API. The main differences between this+and the [time](http://hackage.haskell.org/package/time) library+are:+ * Chronos uses machine integers where possible. This means+ that time-related arithmetic should be faster, with the+ drawback that the types are incapable of representing times+ that are very far in the future or the past (because Chronos+ provides nanosecond, rather than picosecond, resolution).+ For most users, this is not a hindrance and the tradeoff is+ worthwhile.+ * Chronos provides 'ToJSON'/'FromJSON' instances for serialisation.+ * Chronos provides 'Unbox' instances for working with unboxed vectors.+ * Chronos provides 'Prim' instances for working with byte arrays/primitive arrays.+ * Chronos uses normal non-overloaded haskell functions for+ encoding and decoding time. It provides [attoparsec](http://hackage.haskell.org/package/attoparsec) parsers for both 'Text' and+ 'ByteString'. Additionally, Chronos provides functions for+ encoding time to 'Text' or 'ByteString'. The [time](http://hackage.haskell.org/package/time) library accomplishes these with the+ [Data.Time.Format](http://hackage.haskell.org/package/time-1.9.3/docs/Data-Time-Format.html) module, which uses UNIX-style datetime+ format strings. The approach taken by Chronos is faster and+ catches more mistakes at compile time, at the cost of being+ less expressive.++Jacob Stanley has written+[a blog post comparing the features and performance](https://jacobstanley.io/3-packages-you-need-to-know-about-before-processing-timestamps-in-haskell/)+of `time`, `thyme`, and `chronos`. It has a good bulleted breakdown of why+you may want to use each library along with some benchmarks.++## Benchmarks++Benchmarks of `chronos` against `time` and `thyme`.++### Parsing++| Benchmark name | Time |+|---------------------------|----------|+| Time.parseTimeM | 9.679 μs |+| Thyme.parseTime | 1.743 μs |+| Thyme.timeParser | 1.113 μs |+| Chronos.parserUtf8_YmdHMS | 301.4 ns |+| Chronos.zeptoUtf8_YmdHMS | 173.6 ns |++### Pretty-printing++| Benchmark name | Time |+|-------------------------|----------|+| dmy/Time.formatTime | 4.404 μs |+| dmy/Thyme.formatTime | 663.0 ns |+| dmy/Chronos.builder_Dmy | 340.9 ns |+| HMS/Time.formatTime | 1.987 μs |+| HMS/Thyme.formatTime | 879.1 ns |+| HMS/Chronos.builder_HMS | 481.3 ns |++## Doctest++Doctest used to be provided as a test suite, but `doctest-0.20` and higher+do not require this to be run. To run the doctests, make sure you have+`doctest` on your path (i.e. run `cabal install doctest`), and then run:++ cabal build+ cabal repl --build-depends=QuickCheck --with-ghc=doctest --repl-options='-fno-warn-orphans'++This runs incredibly slowly, but it works for now. Doctest is not run by CI,+so if you make a change that adds more doctests, it needs to be run by hand+by someone. (The maintainer is happy to do this if you're on a platform+where doctest is finicky.)
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
bench/Bench.hs view
@@ -1,113 +1,157 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE BangPatterns #-} module Main where -import qualified Data.Vector.Unboxed as UVector import Criterion.Main-import Data.Int++import Control.DeepSeq (($!!))+import Data.Attoparsec.ByteString.Char8 (parseOnly) import Data.Maybe (fromMaybe)-import Control.DeepSeq (($!!), NFData(..), deepseq)-import qualified Data.ByteString.Char8 as BS8-import Test.QuickCheck (arbitrary, generate)-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.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 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)- chronosAttoparsec :: BS8.ByteString -> Chronos.Datetime- chronosAttoparsec =- either error id- . parseOnly (Chronos.parserUtf8_YmdHMS Chronos.w3c)- chronosZepto :: BS8.ByteString -> Chronos.Datetime- chronosZepto =- either error id- . Z.parse (Chronos.zeptoUtf8_YmdHMS Chronos.w3c)+ -- 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. - dmy = "%d:%m:%y."- hms = "%%H:%M:%S."- 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+ dmy = "%d:%m:%y."+ hms = "%H:%M:%S."+ dmyhms = isoFormatString+ timePretty = Time.formatTime Time.defaultTimeLocale+ thymePretty = Thyme.formatTime Thyme.defaultTimeLocale - timeTime <- Time.getCurrentTime+ 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"- [ bench "Time.parseTimeM" $ nf timeParser string- , bench "Thyme.parseTime" $ nf thymeParser string- , bench "Thyme.timeParser" $ nf thymeAttoparsec bytestring- , bench "Chronos.parserUtf8_YmdHMS" $ nf chronosAttoparsec bytestring- , bench "Chronos.zeptoUtf8_YmdHMS" $ nf chronosZepto bytestring- ]-- , bgroup "prettyPrint"- [ bgroup "dmy"- [ bench "Time.formatTime" $ nf (timePretty dmy) timeTime- , bench "Thyme.formatTime" $ nf (thymePretty dmy) thymeTime- , bench "Chronos.builder_Dmy" $ nf chronosPrettyDmy chronosTime+ [ bgroup+ "parsing"+ [ bench "Time.parseTimeM" $ nf timeParser string+ , bench "Thyme.parseTime" $ nf thymeParser string+ , 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 "HMS"- [ bench "Time.formatTime" $ nf (timePretty hms) timeTime- , bench "Thyme.formatTime" $ nf (thymePretty hms) thymeTime- , bench "Chronos.builder_HMS" $ nf chronosPrettyHMS chronosTime+ , bgroup+ "prettyPrint"+ [ bgroup+ "dmy"+ [ bench "Time.formatTime" $ nf (timePretty dmy) timeTime+ , bench "Thyme.formatTime" $ nf (thymePretty dmy) thymeTime+ , bench "Chronos.builder_Dmy" $ nf chronosPrettyDmy chronosTime+ ]+ , bgroup+ "HMS"+ [ bench "Time.formatTime" $ nf (timePretty hms) timeTime+ , bench "Thyme.formatTime" $ nf (thymePretty hms) thymeTime+ , bench "Chronos.builder_HMS" $ nf chronosPrettyHMS chronosTime+ ]+ , bgroup+ "YmdHMS"+ [ bench "Time.formatTime" $ nf (timePretty dmyhms) timeTime+ , bench "Thyme.formatTime" $ nf (thymePretty dmyhms) thymeTime+ , bench "Chronos.builder_YmdHMS" $ nf chronosPrettyYmdHMS chronosTime+ ]+ , bgroup+ "ISO-8601-Zulu"+ [ bench "Chronos.encodeShortTextIso8601Zulu" $ nf encodeChronosIso8601Zulu chronosTime+ ] ]- ] ] -instance NFData Chronos.Datetime where- rnf (Chronos.Datetime a b) = a `deepseq` b `deepseq` ()+encodeChronosIso8601Zulu :: Chronos.Time -> ShortText+encodeChronosIso8601Zulu !t =+ Chronos.encodeShortTextIso8601Zulu (Chronos.timeToDatetime t) -instance NFData Chronos.Date where- rnf (Chronos.Date y m d) = y `deepseq` m `deepseq` d `deepseq` ()+chronosIso8601 :: ShortText -> Chronos.Time+{-# NOINLINE chronosIso8601 #-}+chronosIso8601 !t = case Chronos.decodeShortTextIso8601Zoneless t of+ Just x -> Chronos.datetimeToTime x+ Nothing -> errorWithoutStackTrace "chronosIso8601: decode failure" -instance NFData Chronos.TimeOfDay where- rnf (Chronos.TimeOfDay h m s) = h `deepseq` m `deepseq` s `deepseq` ()+chronosZepto :: BS8.ByteString -> Chronos.Time+{-# NOINLINE chronosZepto #-}+chronosZepto !bs =+ either+ error+ Chronos.datetimeToTime+ (Z.parse (Chronos.zeptoUtf8_YmdHMS Chronos.w3c) bs) -deriving instance NFData Chronos.DayOfMonth-deriving instance NFData Chronos.Month-deriving instance NFData Chronos.Year-deriving instance NFData Chronos.Day+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"
chronos.cabal view
@@ -1,91 +1,85 @@-cabal-version: 2.2-name:- chronos-version:- 1.0.9-synopsis:- A performant time library+cabal-version: 3.0+name: chronos+version: 1.1.7.0+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 and the <http://hackage.haskell.org/package/time time> library are:+ * Chronos uses machine integers where possible. This means+ that time-related arithmetic should be faster, with the+ drawback that the types are incapable of representing times+ that are very far in the future or the past (because Chronos+ provides nanosecond, rather than picosecond, resolution).+ For most users, this is not a hindrance.+ * Chronos provides 'ToJSON'/'FromJSON' instances for serialisation.+ * Chronos provides 'Unbox' instances for working with unboxed vectors.+ * Chronos provides 'Prim' instances for working with byte arrays/primitive arrays.+ * Chronos uses normal non-overloaded haskell functions for+ encoding and decoding time. It provides <http://hackage.haskell.org/package/attoparsec attoparsec> parsers for both 'Text' and+ 'ByteString'. Additionally, Chronos provides functions for+ encoding time to 'Text' or 'ByteString'. The http://hackage.haskell.org/package/time time> library accomplishes these with the+ <http://hackage.haskell.org/package/time-1.9.3/docs/Data-Time-Format.html Data.Time.Format> module, which uses UNIX-style datetime+ format strings. The approach taken by Chronos is faster and+ catches more mistakes at compile time, at the cost of being+ less expressive.+homepage: https://github.com/byteverse/chronos+bug-reports: https://github.com/byteverse/chronos/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: amartin@layer3com.com, chessai1996@gmail.com+copyright: 2016 Andrew Martin+category: Data, Time, Parsing, Development+build-type: Simple+extra-doc-files:+ CHANGELOG.md+ README.md - * Chronos uses machine integers where possible. This means- that time-related arithmetic should be faster, with the- drawback that the types are incapable of representing times- that are very far in the future or the past (because Chronos- provides nanosecond, rather than picosecond, resolution).- For most users, this is not a hindrance.- * Chronos provides 'ToJSON'/'FromJSON' instances for serialisation.- * Chronos provides 'Unbox' instances for working with unboxed vectors.- * Chronos provides 'Prim' instances for working with byte arrays/primitive arrays.- * Chronos uses normal non-overloaded haskell functions for- encoding and decoding time. It provides <http://hackage.haskell.org/package/attoparsec attoparsec> parsers for both 'Text' and- 'ByteString'. Additionally, Chronos provides functions for- encoding time to 'Text' or 'ByteString'. The http://hackage.haskell.org/package/time time> library accomplishes these with the- <http://hackage.haskell.org/package/time-1.9.3/docs/Data-Time-Format.html Data.Time.Format> module, which uses UNIX-style datetime- format strings. The approach taken by Chronos is faster and- catches more mistakes at compile time, at the cost of being- less expressive.-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+tested-with: GHC ==9.6.3 || ==9.8.1 +common build-settings+ default-language: Haskell2010+ ghc-options: -Wall -Wunused-packages+ library- hs-source-dirs:- src+ import: build-settings+ hs-source-dirs: src exposed-modules:- Chronos- Chronos.Types- Chronos.Locale.English- -- only exposed for doctests- -- it is OPTIONS_HADDOCK-hidden- Chronos.Internal.CTimespec+ Chronos+ Chronos.Internal.CTimespec+ Chronos.Locale.English+ Chronos.Types build-depends:- , aeson >= 1.1 && < 1.5- , attoparsec >= 0.13 && < 0.14- , base >= 4.9 && < 5- , bytestring >= 0.10 && < 0.11- , clock >= 0.7 && < 0.9- , hashable >= 1.2 && < 1.4- , primitive >= 0.6.4 && < 0.8- , semigroups >= 0.16 && < 0.20- , text >= 1.2 && < 1.3- , torsor >= 0.1 && < 0.2- , vector >= 0.11 && < 0.13+ , aeson >=2.2 && <2.3+ , attoparsec >=0.13 && <0.15+ , base >=4.14 && <5+ , bytebuild >=0.3.14 && <0.4+ , byteslice >=0.2.5.2 && <0.3+ , bytesmith >=0.3.7 && <0.4+ , bytestring >=0.10 && <0.13+ , deepseq >=1.4.4.0+ , hashable >=1.2 && <1.5+ , natural-arithmetic >=0.1.2 && <0.3+ , primitive >=0.6.4 && <0.10+ , text >=2.1.2 && <2.2+ , text-short >=0.1.5 && <0.2+ , torsor >=0.1 && <0.2+ , vector >=0.11 && <0.14 if os(windows)- build-depends: Win32 >= 2.2 && < 2.9- default-language:- Haskell2010- c-sources:- src/cbits/hs-time.c- ghc-options:- -Wall- -O2+ build-depends: Win32 >=2.2 && <2.14 + c-sources: src/cbits/hs-time.c+ ghc-options: -O2+ test-suite chronos-test- type:- exitcode-stdio-1.0- hs-source-dirs:- test- main-is:- Spec.hs+ import: build-settings+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs build-depends:+ , aeson >=1.1 && <2.3 , HUnit , QuickCheck , attoparsec@@ -97,52 +91,30 @@ , test-framework-quickcheck2 , text , torsor- ghc-options:- -threaded- -rtsopts -with-rtsopts=-N- default-language:- Haskell2010 -test-suite doctest- type:- exitcode-stdio-1.0- hs-source-dirs:- test- main-is:- Doctests.hs- build-depends:- , QuickCheck- , base- , chronos- , doctest >= 0.10- default-language:- Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N benchmark bench- type:- exitcode-stdio-1.0- hs-source-dirs:- bench- main-is:- Bench.hs+ import: build-settings+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Bench.hs build-depends:- , QuickCheck , attoparsec , base , bytestring , chronos , criterion- , deepseq+ , deepseq >=1.4.4.0 , old-locale+ , QuickCheck , text+ , text-short , thyme , time- , vector- default-language:- Haskell2010 + ghc-options: -O2+ source-repository head- type:- git- location:- https://github.com/andrewthad/chronos+ type: git+ location: git://github.com/byteverse/chronos.git
src/Chronos.hs view
@@ -1,2695 +1,4012 @@-{-# language- BangPatterns- , CPP- , DeriveGeneric- , GeneralizedNewtypeDeriving- , MultiParamTypeClasses- , OverloadedStrings- , ScopedTypeVariables- , TypeFamilies- , TypeInType- , UnboxedTuples- #-}--{-| Chronos is a performance-oriented time library for Haskell, with a- straightforward API. The main differences between this- and the <http://hackage.haskell.org/package/time time> library- are:-- * Chronos uses machine integers where possible. This means- that time-related arithmetic should be faster, with the- drawback that the types are incapable of representing times- that are very far in the future or the past (because Chronos- provides nanosecond, rather than picosecond, resolution).- For most users, this is not a hindrance.- * Chronos provides 'ToJSON'/'FromJSON' instances for serialisation.- * Chronos provides 'UVector.Unbox' instances for working with unboxed vectors.- * Chronos provides 'Prim' instances for working with byte arrays/primitive arrays.- * Chronos uses normal non-overloaded haskell functions for- encoding and decoding time. It provides <http://hackage.haskell.org/package/attoparsec attoparsec> parsers for both 'Text' and- 'ByteString'. Additionally, Chronos provides functions for- encoding time to 'Text' or 'ByteString'. The http://hackage.haskell.org/package/time time> library accomplishes these with the- <http://hackage.haskell.org/package/time-1.9.3/docs/Data-Time-Format.html Data.Time.Format> module, which uses UNIX-style datetime- format strings. The approach taken by Chronos is faster and- catches more mistakes at compile time, at the cost of being- less expressive.- -}--module Chronos- ( -- * Functions- -- ** Current- now- , today- , tomorrow- , yesterday- , epoch- -- ** Duration- , stopwatch- , stopwatch_- , stopwatchWith- , stopwatchWith_- -- ** Construction- , datetimeFromYmdhms- , timeFromYmdhms- -- ** Conversion- , timeToDatetime- , datetimeToTime- , timeToOffsetDatetime- , offsetDatetimeToTime- , timeToDayTruncate- , dayToTimeMidnight- , dayToDate- , dateToDay- , dayToOrdinalDate- , ordinalDateToDay- , monthDateToDayOfYear- , dayOfYearToMonthDay- -- ** Build Timespan- , second- , minute- , hour- , day- , week- -- ** Matching- , buildDayOfWeekMatch- , buildMonthMatch- , buildUnboxedMonthMatch- , caseDayOfWeek- , caseMonth- , caseUnboxedMonth- -- ** Format- -- $format- , w3c- , slash- , hyphen- , compact- , timeParts- -- ** Months- , january- , february- , march- , april- , may- , june- , july- , august- , september- , october- , november- , december- -- ** Days of Week- , sunday- , monday- , tuesday- , wednesday- , thursday- , friday- , saturday- -- ** Utility- , daysInMonth- , isLeapYear- , observedOffsets- -- * Textual Conversion- -- ** Date- -- *** Text- , builder_Ymd- , builder_Dmy- , builder_HMS- , parser_Ymd- , parser_Mdy- , parser_Dmy- -- *** UTF-8 ByteString- , builderUtf8_Ymd- , parserUtf8_Ymd- -- ** Time of Day- -- *** Text- , builder_IMS_p- , builder_IMSp- , parser_HMS- , parser_HMS_opt_S- -- *** UTF-8 ByteString- , builderUtf8_HMS- , builderUtf8_IMS_p- , builderUtf8_IMSp- , parserUtf8_HMS- , parserUtf8_HMS_opt_S- , zeptoUtf8_HMS- -- ** Datetime- -- *** Text- , builder_DmyHMS- , builder_DmyIMSp- , builder_DmyIMS_p- , builder_YmdHMS- , builder_YmdIMSp- , builder_YmdIMS_p- , builderW3C- , encode_DmyHMS- , encode_DmyIMS_p- , encode_YmdHMS- , encode_YmdIMS_p- , parser_DmyHMS- , parser_YmdHMS- , parser_YmdHMS_opt_S- , parser_DmyHMS_opt_S- , decode_DmyHMS- , decode_YmdHMS- , decode_YmdHMS_opt_S- , decode_DmyHMS_opt_S- -- *** UTF-8 ByteString- , encodeUtf8_YmdHMS- , encodeUtf8_YmdIMS_p- , builderUtf8_YmdHMS- , builderUtf8_YmdIMSp- , builderUtf8_YmdIMS_p- , builderUtf8W3C- , decodeUtf8_YmdHMS- , decodeUtf8_YmdHMS_opt_S- , parserUtf8_YmdHMS- , parserUtf8_YmdHMS_opt_S- , zeptoUtf8_YmdHMS- -- ** Offset Datetime- -- *** Text- , encode_YmdHMSz- , encode_DmyHMSz- , builder_YmdHMSz- , builder_DmyHMSz- , parser_YmdHMSz- , parser_DmyHMSz- , builder_YmdIMS_p_z- , builder_DmyIMS_p_z- , builderW3Cz- -- *** UTF-8 ByteString- , builderUtf8_YmdHMSz- , parserUtf8_YmdHMSz- , builderUtf8_YmdIMS_p_z- , builderUtf8W3Cz- -- ** Offset- -- *** Text- , encodeOffset- , builderOffset- , decodeOffset- , parserOffset- -- *** UTF-8 ByteString- , encodeOffsetUtf8- , builderOffsetUtf8- , decodeOffsetUtf8- , parserOffsetUtf8- -- ** Timespan- -- *** Text- , encodeTimespan- , builderTimespan- -- *** UTF-8 ByteString- , encodeTimespanUtf8- , builderTimespanUtf8- -- ** TimeInterval- , within- , timeIntervalToTimespan- , whole- , singleton- , lowerBound- , upperBound- , width- , timeIntervalBuilder- , (...)- -- * Types- , Day(..)- , DayOfWeek(..)- , DayOfMonth(..)- , DayOfYear(..)- , Month(..)- , Year(..)- , Offset(..)- , Time(..)- , DayOfWeekMatch(..)- , MonthMatch(..)- , UnboxedMonthMatch(..)- , Timespan(..)- , SubsecondPrecision(..)- , Date(..)- , OrdinalDate(..)- , MonthDate(..)- , Datetime(..)- , OffsetDatetime(..)- , TimeOfDay(..)- , DatetimeFormat(..)- , OffsetFormat(..)- , DatetimeLocale(..)- , MeridiemLocale(..)- , TimeInterval(..)- , TimeParts(..)- ) where--import Control.Applicative-import Control.Exception (evaluate)-import Control.Monad-import Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)-import Data.Attoparsec.Text (Parser)-import Data.ByteString (ByteString)-import Data.Char (isDigit)-import Data.Foldable-import Data.Hashable (Hashable)-import Data.Int (Int64)-import Data.Primitive-import Data.Text (Text)-import Data.Vector (Vector)-import Data.Word (Word64, Word8)-import Foreign.Storable-import GHC.Generics (Generic)-import Torsor-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.ByteString.Builder as BB-import qualified Data.ByteString.Char8 as BC-import qualified Data.ByteString.Lazy as LB-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.Vector as Vector-import qualified Data.Vector.Generic as GVector-import qualified Data.Vector.Generic.Mutable as MGVector-import qualified Data.Vector.Primitive as PVector-import qualified Data.Vector.Unboxed as UVector-import qualified System.Clock as CLK--#ifdef mingw32_HOST_OS-import System.Win32.Time (SYSTEMTIME(..))-import qualified System.Win32.Time as W32-#else-import Chronos.Internal.CTimespec (getPosixNanoseconds)-#endif--#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup (Semigroup, (<>))-#endif---- $setup--- >>> import Test.QuickCheck hiding (within)--- >>> import Test.QuickCheck.Gen--- >>> import Data.Maybe (isJust)--- >>> :set -XStandaloneDeriving--- >>> :set -XGeneralizedNewtypeDeriving--- >>> :set -XScopedTypeVariables------ >>> deriving instance Arbitrary Time--- >>> :{--- instance Arbitrary TimeInterval where--- arbitrary = do--- t0 <- arbitrary--- t1 <- suchThat arbitrary (>= t0)--- pure (TimeInterval t0 t1)--- instance Arbitrary TimeOfDay where--- arbitrary = TimeOfDay--- <$> choose (0,23)--- <*> choose (0,59)--- <*> choose (0, 60000000000 - 1)--- instance Arbitrary Date where--- arbitrary = Date--- <$> fmap Year (choose (1800,2100))--- <*> fmap Month (choose (0,11))--- <*> fmap DayOfMonth (choose (1,28))--- instance Arbitrary Datetime where--- arbitrary = Datetime <$> arbitrary <*> arbitrary--- instance Arbitrary OffsetDatetime where--- arbitrary = OffsetDatetime <$> arbitrary <*> arbitrary--- instance Arbitrary DatetimeFormat where--- arbitrary = DatetimeFormat--- <$> arbitrary--- <*> elements [ Nothing, Just '/', Just ':', Just '-']--- <*> arbitrary--- instance Arbitrary OffsetFormat where--- arbitrary = arbitraryBoundedEnum--- shrink = genericShrink--- instance Arbitrary Offset where--- arbitrary = fmap Offset (choose ((-24) * 60, 24 * 60))--- instance Arbitrary SubsecondPrecision where--- arbitrary = frequency--- [ (1, pure SubsecondPrecisionAuto)--- , (1, SubsecondPrecisionFixed <$> choose (0,9))--- ]--- instance Arbitrary Day where--- arbitrary = fmap Day (choose (0,50000))--- :}------- | A 'Timespan' representing a single second.-second :: Timespan-second = Timespan 1000000000---- | A 'Timespan' representing a single minute.-minute :: Timespan-minute = Timespan 60000000000---- | A 'Timespan' representing a single hour.-hour :: Timespan-hour = Timespan 3600000000000---- | A 'Timespan' representing a single day.-day :: Timespan-day = Timespan 86400000000000---- | A 'Timespan' representing a single week.-week :: Timespan-week = Timespan 604800000000000---- | Convert 'Time' to 'Datetime'.------ prop> \(t :: Time) -> (datetimeToTime (timeToDatetime t)) == t-timeToDatetime :: Time -> Datetime-timeToDatetime = utcTimeToDatetime . toUtc---- | Convert 'Datetime' to 'Time'.------ prop> \(d :: Datetime) -> timeToDatetime (datetimeToTime d) == d-datetimeToTime :: Datetime -> Time-datetimeToTime = fromUtc . datetimeToUtcTime---- | Convert 'Time' to 'OffsetDatetime' by providing an 'Offset'.-timeToOffsetDatetime :: Offset -> Time -> OffsetDatetime-timeToOffsetDatetime offset = utcTimeToOffsetDatetime offset . toUtc---- | Convert 'OffsetDatetime' to 'Time'.-offsetDatetimeToTime :: OffsetDatetime -> Time-offsetDatetimeToTime = fromUtc . offsetDatetimeToUtcTime---- | Convert 'Time' to 'Day'. This function is lossy; consequently, it--- does not roundtrip with 'dayToTimeMidnight'.-timeToDayTruncate :: Time -> Day-timeToDayTruncate (Time i) = Day (fromIntegral (div i 86400000000000) + 40587)---- | Convert midnight of the given 'Day' to 'Time'.-dayToTimeMidnight :: Day -> Time-dayToTimeMidnight (Day d) = Time (fromIntegral (d - 40587) * 86400000000000)---- | Convert 'Day' to a 'Date'.------ prop> \(d :: Day) -> dateToDay (dayToDate d) == d-dayToDate :: Day -> Date-dayToDate theDay = Date year month dayOfMonth- where- OrdinalDate year yd = dayToOrdinalDate theDay- MonthDate month dayOfMonth = dayOfYearToMonthDay (isLeapYear year) yd---- | Convert a 'Date' to a 'Day'.------ prop> \(d :: Date) -> dayToDate (dateToDay d) == d-dateToDay :: Date -> Day-dateToDay (Date y m d) = ordinalDateToDay $ OrdinalDate y- (monthDateToDayOfYear (isLeapYear y) (MonthDate m d))---- | Construct a 'Datetime' from year, month, day, hour, minute, second:------ >>> datetimeFromYmdhms 2014 2 26 17 58 52--- Datetime {datetimeDate = Date {dateYear = Year {getYear = 2014}, dateMonth = Month {getMonth = 1}, dateDay = DayOfMonth {getDayOfMonth = 26}}, datetimeTime = TimeOfDay {timeOfDayHour = 17, timeOfDayMinute = 58, timeOfDayNanoseconds = 52000000000}}-datetimeFromYmdhms ::- Int -- ^ Year- -> Int -- ^ Month- -> Int -- ^ Day- -> Int -- ^ Hour- -> Int -- ^ Minute- -> Int -- ^ Second- -> Datetime-datetimeFromYmdhms y m d h m' s = Datetime- (Date- (Year $ fromIntegral y)- (Month mx)- (DayOfMonth $ fromIntegral d)- )- (TimeOfDay- (fromIntegral h)- (fromIntegral m')- (fromIntegral s * 1000000000)- )- where- mx = if m >= 1 && m <= 12- then fromIntegral (m - 1)- else 1---- | Construct a 'Time' from year, month, day, hour, minute, second:------ >>> timeFromYmdhms 2014 2 26 17 58 52--- Time {getTime = 1393437532000000000}-timeFromYmdhms ::- Int -- ^ Year- -> Int -- ^ Month- -> Int -- ^ Day- -> Int -- ^ Hour- -> Int -- ^ Minute- -> Int -- ^ Second- -> Time-timeFromYmdhms y m d h m' s = datetimeToTime (datetimeFromYmdhms y m d h m' s)---- | Gets the current 'Day'. This does not take the user\'s--- time zone into account.-today :: IO Day-today = fmap timeToDayTruncate now---- | Gets the 'Day' of tomorrow.-tomorrow :: IO Day-tomorrow = fmap (add 1 . timeToDayTruncate) now---- | Gets the 'Day' of yesterday.-yesterday :: IO Day-yesterday = fmap (add (-1) . timeToDayTruncate) now---- | Get the current time from the system clock.-now :: IO Time-#ifdef mingw32_HOST_OS-now = do- SYSTEMTIME{..} <- W32.getSystemTime- let date = Date- { dateYear = Year (fromIntegral wYear)- , dateMonth = Month (fromIntegral wMonth)- , dateDay = DayOfMonth (fromIntegral wDay)- }- let secNano = (fromIntegral wSecond :: Int64) * 1000000000- msNano = (fromIntegral wMilliseconds :: Int64) * 1000000- nano = secNano + msNano- let time = TimeOfDay- { timeOfDayHour = fromIntegral wHour- , timeOfDayMinute = fromIntegral wMinute- , timeOfDayNanoseconds = fromIntegral nano- }- let dt = Datetime date time- pure $ datetimeToTime dt-#else-now = fmap Time getPosixNanoseconds-#endif---- | The Unix epoch, that is 1970-01-01 00:00:00.-epoch :: Time-epoch = Time 0---- | Measures the time it takes to run an action and evaluate--- its result to WHNF. This measurement uses a monotonic clock--- instead of the standard system clock.-stopwatch :: IO a -> IO (Timespan, a)-stopwatch = 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)---- | 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))--timeSpecToTimespan :: CLK.TimeSpec -> Timespan-timeSpecToTimespan (CLK.TimeSpec s ns) = Timespan (s * 1000000000 + ns)---- UtcTime. Used internally only.-data UtcTime = UtcTime- {-# UNPACK #-} !Day -- day- {-# UNPACK #-} !Int64 -- nanoseconds--toUtc :: Time -> UtcTime-toUtc (Time i) = let (d,t) = divMod i (getTimespan day)- in UtcTime (add (fromIntegral d) epochDay) (fromIntegral t)--fromUtc :: UtcTime -> Time-fromUtc (UtcTime d ns') = Time $ getTimespan $ plus- (scale (intToInt64 (difference d epochDay)) day)- (if ns > day then day else ns)- where ns = Timespan ns'--intToInt64 :: Int -> Int64-intToInt64 = fromIntegral--epochDay :: Day-epochDay = Day 40587--dayLengthInt64 :: Int64-dayLengthInt64 = getTimespan day--nanosecondsInMinute :: Int64-nanosecondsInMinute = 60000000000---- | All UTC time offsets. See <https://en.wikipedia.org/wiki/List_of_UTC_time_offsets List of UTC time offsets>.-observedOffsets :: Vector Offset-observedOffsets = Vector.fromList $ map Offset- [ -1200- , -1100- , -1000- , -930- , -900- , -800- , -700- , -600- , -500- , -400- , -330- , -300- , -230- , -200- , -100- , 0- , 100- , 200- , 300- , 330- , 400- , 430- , 500- , 530- , 545- , 600- , 630- , 700- , 800- , 845- , 900- , 930- , 1000- , 1030- , 1100- , 1200- , 1245- , 1300- , 1345- , 1400- ]---- | The first argument in the resulting tuple in a day--- adjustment. It should be either -1, 0, or 1, as no--- offset should ever exceed 24 hours.-offsetTimeOfDay :: Offset -> TimeOfDay -> (Int, TimeOfDay)-offsetTimeOfDay (Offset offset) (TimeOfDay h m s) =- (dayAdjustment,TimeOfDay h'' m'' s)- where- (!dayAdjustment, !h'') = divMod h' 24- (!hourAdjustment, !m'') = divMod m' 60- m' = m + offset- h' = h + hourAdjustment--nanosecondsSinceMidnightToTimeOfDay :: Int64 -> TimeOfDay-nanosecondsSinceMidnightToTimeOfDay ns =- if ns >= dayLengthInt64- then TimeOfDay 23 59 (nanosecondsInMinute + (ns - dayLengthInt64))- else TimeOfDay h' m' ns'- where- (!mInt64,!ns') = quotRem ns nanosecondsInMinute- !m = fromIntegral mInt64- (!h',!m') = quotRem m 60--timeOfDayToNanosecondsSinceMidnight :: TimeOfDay -> Int64-timeOfDayToNanosecondsSinceMidnight (TimeOfDay h m ns) =- fromIntegral h * 3600000000000 + fromIntegral m * 60000000000 + ns---- datetimeToOffsetDatetime :: Offset -> Datetime -> OffsetDatetime--- datetimeToOffsetDatetime offset--utcTimeToOffsetDatetime :: Offset -> UtcTime -> OffsetDatetime-utcTimeToOffsetDatetime offset (UtcTime (Day d) nanoseconds) =- let (!dayAdjustment,!tod) = offsetTimeOfDay offset (nanosecondsSinceMidnightToTimeOfDay nanoseconds)- !date = dayToDate (Day (d + dayAdjustment))- in OffsetDatetime (Datetime date tod) offset--utcTimeToDatetime :: UtcTime -> Datetime-utcTimeToDatetime (UtcTime d nanoseconds) =- let !tod = nanosecondsSinceMidnightToTimeOfDay nanoseconds- !date = dayToDate d- in Datetime date tod--datetimeToUtcTime :: Datetime -> UtcTime-datetimeToUtcTime (Datetime date timeOfDay) =- UtcTime (dateToDay date) (timeOfDayToNanosecondsSinceMidnight timeOfDay)--offsetDatetimeToUtcTime :: OffsetDatetime -> UtcTime-offsetDatetimeToUtcTime (OffsetDatetime (Datetime date timeOfDay) (Offset off)) =- let (!dayAdjustment,!tod) = offsetTimeOfDay (Offset $ negate off) timeOfDay- !(Day !theDay) = dateToDay date- in UtcTime- (Day (theDay + dayAdjustment))- (timeOfDayToNanosecondsSinceMidnight tod)---- | Convert a 'MonthDate' to a 'DayOfYear'.-monthDateToDayOfYear ::- Bool -- ^ Is it a leap year?- -> MonthDate- -> DayOfYear-monthDateToDayOfYear isLeap (MonthDate month@(Month m) (DayOfMonth dayOfMonth)) =- DayOfYear ((div (367 * (fromIntegral m + 1) - 362) 12) + k + day')- where- day' = fromIntegral $ clip 1 (daysInMonth isLeap month) dayOfMonth- k = if month < Month 2 then 0 else if isLeap then -1 else -2---- | Convert an 'OrdinalDate' to a 'Day'.-ordinalDateToDay :: OrdinalDate -> Day-ordinalDateToDay (OrdinalDate year@(Year y') theDay) = Day mjd where- y = y' - 1- mjd = (fromIntegral . getDayOfYear $- (clip (DayOfYear 1) (if isLeapYear year then DayOfYear 366 else DayOfYear 365) theDay)- )- + (365 * y)- + (div y 4) - (div y 100)- + (div y 400) - 678576---- | Is the 'Year' a leap year?------ >>> isLeapYear (Year 1996)--- True------ >>> isLeapYear (Year 2019)--- False-isLeapYear :: Year -> Bool-isLeapYear (Year year) = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0))---- | Convert a 'DayOfYear' to a 'MonthDate'.-dayOfYearToMonthDay ::- Bool -- ^ Is it a leap year?- -> DayOfYear- -> MonthDate-dayOfYearToMonthDay isLeap dayOfYear =- let (!doyUpperBound,!monthTable,!dayTable) =- if isLeap- then (DayOfYear 366, leapYearDayOfYearMonthTable, leapYearDayOfYearDayOfMonthTable)- else (DayOfYear 365, normalYearDayOfYearMonthTable, normalYearDayOfYearDayOfMonthTable)- DayOfYear clippedDay = clip (DayOfYear 1) doyUpperBound dayOfYear- clippedDayInt = fromIntegral clippedDay :: Int- month = UVector.unsafeIndex monthTable clippedDayInt- theDay = UVector.unsafeIndex dayTable clippedDayInt- in MonthDate month theDay---- | Convert a 'Day' to an 'OrdinalDate'.-dayToOrdinalDate :: Day -> OrdinalDate-dayToOrdinalDate (Day mjd) = OrdinalDate (Year $ fromIntegral year) (DayOfYear $ fromIntegral yd) where- a = (fromIntegral mjd :: Int64) + 678575- quadcent = div a 146097- b = mod a 146097- cent = min (div b 36524) 3- c = b - (cent * 36524)- quad = div c 1461- d = mod c 1461- y = min (div d 365) 3- yd = (d - (y * 365) + 1)- year = quadcent * 400 + cent * 100 + quad * 4 + y + 1--{- $format--The formats provided is this module are language-agnostic.-To find meridiem formats and month formats, look in a-language-specific module.---}---- | The W3C 'DatetimeFormat'.------ >>> encode_YmdHMS SubsecondPrecisionAuto w3c (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))--- "2014-02-26T17:58:52"------ prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS w3c (encode_YmdHMS s w3c dt))-w3c :: DatetimeFormat-w3c = DatetimeFormat (Just '-') (Just 'T') (Just ':')---- | A 'DatetimeFormat' that separates the members of--- the 'Date' by slashes.------ >>> encode_YmdHMS SubsecondPrecisionAuto slash (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))--- "2014/02/26 17:58:52"------ prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS slash (encode_YmdHMS s slash dt))-slash :: DatetimeFormat-slash = DatetimeFormat (Just '/') (Just ' ') (Just ':')---- | A 'DatetimeFormat' that separates the members of--- the 'Date' by hyphens.------ >>> encode_YmdHMS SubsecondPrecisionAuto hyphen (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))--- "2014-02-26 17:58:52"------ prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS hyphen (encode_YmdHMS s hyphen dt))-hyphen :: DatetimeFormat-hyphen = DatetimeFormat (Just '-') (Just ' ') (Just ':')---- | A 'DatetimeFormat' with no separators, except for a--- `T` between the 'Date' and 'Time'.------ >>> encode_YmdHMS SubsecondPrecisionAuto compact (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))--- "20140226T175852"------ prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS compact (encode_YmdHMS s compact dt))-compact :: DatetimeFormat-compact = DatetimeFormat Nothing (Just 'T') Nothing---- | Return the number of days in a given month.-daysInMonth ::- Bool -- ^ Is this a leap year?- -> Month -- ^ Month of year- -> Int-daysInMonth isLeap m = if isLeap- then caseMonth leapYearMonthLength m- else caseMonth normalYearMonthLength m--leapYearMonthLength :: MonthMatch Int-leapYearMonthLength = buildMonthMatch 31 29 31 30 31 30 31 31 30 31 30 31--normalYearMonthLength :: MonthMatch Int-normalYearMonthLength = buildMonthMatch 31 30 31 30 31 30 31 31 30 31 30 31--leapYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth-leapYearDayOfYearDayOfMonthTable = UVector.fromList $ (DayOfMonth 1:) $ concat- [ enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 29)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 30)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 30)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 30)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 30)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- ]-{-# NOINLINE leapYearDayOfYearDayOfMonthTable #-}--normalYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth-normalYearDayOfYearDayOfMonthTable = UVector.fromList $ (DayOfMonth 1:) $concat- [ enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 28)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 30)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 30)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 30)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- , enumFromTo (DayOfMonth 1) (DayOfMonth 30)- , enumFromTo (DayOfMonth 1) (DayOfMonth 31)- ]-{-# NOINLINE normalYearDayOfYearDayOfMonthTable #-}--leapYearDayOfYearMonthTable :: UVector.Vector Month-leapYearDayOfYearMonthTable = UVector.fromList $ (Month 0:) $ concat- [ replicate 31 (Month 0)- , replicate 29 (Month 1)- , replicate 31 (Month 2)- , replicate 30 (Month 3)- , replicate 31 (Month 4)- , replicate 30 (Month 5)- , replicate 31 (Month 6)- , replicate 31 (Month 7)- , replicate 30 (Month 8)- , replicate 31 (Month 9)- , replicate 30 (Month 10)- , replicate 31 (Month 11)- ]-{-# NOINLINE leapYearDayOfYearMonthTable #-}--normalYearDayOfYearMonthTable :: UVector.Vector Month-normalYearDayOfYearMonthTable = UVector.fromList $ (Month 0:) $ concat- [ replicate 31 (Month 0)- , replicate 28 (Month 1)- , replicate 31 (Month 2)- , replicate 30 (Month 3)- , replicate 31 (Month 4)- , replicate 30 (Month 5)- , replicate 31 (Month 6)- , replicate 31 (Month 7)- , replicate 30 (Month 8)- , replicate 31 (Month 9)- , replicate 30 (Month 10)- , replicate 31 (Month 11)- ]-{-# NOINLINE normalYearDayOfYearMonthTable #-}---- | Build a 'MonthMatch' from twelve (12) values.-buildMonthMatch :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> MonthMatch a-buildMonthMatch a b c d e f g h i j k l =- MonthMatch (Vector.fromListN 12 [a,b,c,d,e,f,g,h,i,j,k,l])---- | Match a 'Month' against a 'MonthMatch'.-caseMonth :: MonthMatch a -> Month -> a-caseMonth (MonthMatch v) (Month ix) = Vector.unsafeIndex v ix---- | Build an 'UnboxedMonthMatch' from twelve (12) values.-buildUnboxedMonthMatch :: UVector.Unbox a => a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> UnboxedMonthMatch a-buildUnboxedMonthMatch a b c d e f g h i j k l =- UnboxedMonthMatch (UVector.fromListN 12 [a,b,c,d,e,f,g,h,i,j,k,l])---- | Match a 'Month' against an 'UnboxedMonthMatch'.-caseUnboxedMonth :: UVector.Unbox a => UnboxedMonthMatch a -> Month -> a-caseUnboxedMonth (UnboxedMonthMatch v) (Month ix) = UVector.unsafeIndex v ix---- | Build a 'DayOfWeekMatch' from seven (7) values.-buildDayOfWeekMatch :: a -> a -> a -> a -> a -> a -> a -> DayOfWeekMatch a-buildDayOfWeekMatch a b c d e f g =- DayOfWeekMatch (Vector.fromListN 7 [a,b,c,d,e,f,g])---- | Match a 'DayOfWeek' against a 'DayOfWeekMatch'.-caseDayOfWeek :: DayOfWeekMatch a -> DayOfWeek -> a-caseDayOfWeek (DayOfWeekMatch v) (DayOfWeek ix) = Vector.unsafeIndex v ix--- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder'--- corresponding to Year\/Month\/Day encoding.-builder_Ymd :: Maybe Char -> Date -> TB.Builder-builder_Ymd msep (Date (Year y) m d) = case msep of- Nothing ->- TB.decimal y- <> monthToZeroPaddedDigit m- <> zeroPadDayOfMonth d- Just sep -> let sepBuilder = TB.singleton sep in- TB.decimal y- <> sepBuilder- <> monthToZeroPaddedDigit m- <> sepBuilder- <> zeroPadDayOfMonth d---- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder'--- corresponding to a Day\/Month\/Year encoding.-builder_Dmy :: Maybe Char -> Date -> TB.Builder-builder_Dmy msep (Date (Year y) m d) = case msep of- Nothing ->- zeroPadDayOfMonth d- <> monthToZeroPaddedDigit m- <> TB.decimal y- Just sep -> let sepBuilder = TB.singleton sep in- zeroPadDayOfMonth d- <> sepBuilder- <> monthToZeroPaddedDigit m- <> sepBuilder- <> TB.decimal y---- | Parse a Year\/Month\/Day-encoded 'Date' that uses the--- given separator.-parser_Ymd :: Maybe Char -> Parser Date-parser_Ymd msep = do- y <- parseFixedDigits 4- traverse_ AT.char msep- m <- parseFixedDigits 2- when (m < 1 || m > 12) (fail "month must be between 1 and 12")- traverse_ AT.char msep- d <- parseFixedDigits 2- when (d < 1 || d > 31) (fail "day must be between 1 and 31")- pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))---- | Parse a Month\/Day\/Year-encoded 'Date' that uses the--- given separator.-parser_Mdy :: Maybe Char -> Parser Date-parser_Mdy msep = do- m <- parseFixedDigits 2- when (m < 1 || m > 12) (fail "month must be between 1 and 12")- traverse_ AT.char msep- d <- parseFixedDigits 2- when (d < 1 || d > 31) (fail "day must be between 1 and 31")- traverse_ AT.char msep- y <- parseFixedDigits 4- pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))---- | Parse a Day\/Month\/Year-encoded 'Date' that uses the--- given separator.-parser_Dmy :: Maybe Char -> Parser Date-parser_Dmy msep = do- d <- parseFixedDigits 2- when (d < 1 || d > 31) (fail "day must be between 1 and 31")- traverse_ AT.char msep- m <- parseFixedDigits 2- when (m < 1 || m > 12) (fail "month must be between 1 and 12")- traverse_ AT.char msep- y <- parseFixedDigits 4- pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))---- | Given a 'Date' and a separator, construct a 'ByteString' 'BB.Builder'--- corresponding to a Day\/Month\/Year encoding.-builderUtf8_Ymd :: Maybe Char -> Date -> BB.Builder-builderUtf8_Ymd msep (Date (Year y) m d) = case msep of- Nothing ->- BB.intDec y- <> monthToZeroPaddedDigitBS m- <> zeroPadDayOfMonthBS d- Just sep -> let sepBuilder = BB.char7 sep in- BB.intDec y- <> sepBuilder- <> monthToZeroPaddedDigitBS m- <> sepBuilder- <> zeroPadDayOfMonthBS d---- | Parse a Year\/Month\/Day-encoded 'Date' that uses the--- given separator.-parserUtf8_Ymd :: Maybe Char -> AB.Parser Date-parserUtf8_Ymd msep = do- y <- parseFixedDigitsIntBS 4- traverse_ AB.char msep- m <- parseFixedDigitsIntBS 2- when (m < 1 || m > 12) (fail "month must be between 1 and 12")- traverse_ AB.char msep- d <- parseFixedDigitsIntBS 2- when (d < 1 || d > 31) (fail "day must be between 1 and 31")- pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))---- | Given a 'SubsecondPrecision' and a separator, construct a--- 'Text' 'TB.Builder' corresponding to an Hour\/Minute\/Second--- encoding.-builder_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder-builder_HMS sp msep (TimeOfDay h m ns) =- indexTwoDigitTextBuilder h- <> internalBuilder_NS sp msep m ns---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator,--- construct a 'Text' 'TB.Builder' according to an IMS encoding.------ This differs from 'builder_IMSp' in that their is a space--- between the seconds and locale.-builder_IMS_p :: MeridiemLocale Text -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder-builder_IMS_p meridiemLocale sp msep (TimeOfDay h m ns) =- internalBuilder_I h- <> internalBuilder_NS sp msep m ns- <> " "- <> internalBuilder_p meridiemLocale h---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator,--- construct a 'Text' 'TB.Builder' according to an IMS encoding.-builder_IMSp :: MeridiemLocale Text -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder-builder_IMSp meridiemLocale sp msep (TimeOfDay h m ns) =- internalBuilder_I h- <> internalBuilder_NS sp msep m ns- <> internalBuilder_p meridiemLocale h--internalBuilder_I :: Int -> TB.Builder-internalBuilder_I h =- indexTwoDigitTextBuilder $ if h > 12- then h - 12- else if h == 0- then 12- else h--internalBuilder_p :: MeridiemLocale Text -> Int -> TB.Builder-internalBuilder_p (MeridiemLocale am pm) h = if h > 11- then TB.fromText pm- else TB.fromText am---- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that uses--- the given separator.-parser_HMS :: Maybe Char -> Parser TimeOfDay-parser_HMS msep = do- h <- parseFixedDigits 2- when (h > 23) (fail "hour must be between 0 and 23")- traverse_ AT.char msep- m <- parseFixedDigits 2- when (m > 59) (fail "minute must be between 0 and 59")- traverse_ AT.char msep- ns <- parseSecondsAndNanoseconds- pure (TimeOfDay h m ns)---- | Parses text that is formatted as either of the following:------ * @%H:%M@--- * @%H:%M:%S@------ That is, the seconds and subseconds part is optional. If it is--- not provided, it is assumed to be zero. This format shows up--- in Google Chrome\'s @datetime-local@ inputs.-parser_HMS_opt_S :: Maybe Char -> Parser TimeOfDay-parser_HMS_opt_S msep = do- h <- parseFixedDigits 2- when (h > 23) (fail "hour must be between 0 and 23")- traverse_ AT.char msep- m <- parseFixedDigits 2- when (m > 59) (fail "minute must be between 0 and 59")- mc <- AT.peekChar- case mc of- Nothing -> pure (TimeOfDay h m 0)- Just c -> case msep of- Just sep -> if c == sep- then do- _ <- AT.anyChar -- should be the separator- ns <- parseSecondsAndNanoseconds- pure (TimeOfDay h m ns)- else pure (TimeOfDay h m 0)- -- if there is no separator, we will try to parse the- -- remaining part as seconds. We commit to trying to- -- parse as seconds if we see any number as the next- -- character.- Nothing -> if isDigit c- then do- ns <- parseSecondsAndNanoseconds- pure (TimeOfDay h m ns)- else pure (TimeOfDay h m 0)--parseSecondsAndNanoseconds :: Parser Int64-parseSecondsAndNanoseconds = do- s' <- parseFixedDigits 2- let s = fromIntegral s' :: Int64- when (s > 60) (fail "seconds must be between 0 and 60")- 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)- ) <|> pure 0- pure (s * 1000000000 + nanoseconds)--countZeroes :: AT.Parser Int-countZeroes = go 0 where- go !i = do- m <- AT.peekChar- case m of- Nothing -> pure i- Just c -> if c == '0'- then AT.anyChar *> go (i + 1)- else pure i--nanosecondsBuilder :: Int64 -> TB.Builder-nanosecondsBuilder w- | w == 0 = mempty- | w > 99999999 = "." <> TB.decimal w- | w > 9999999 = ".0" <> TB.decimal w- | w > 999999 = ".00" <> TB.decimal w- | w > 99999 = ".000" <> TB.decimal w- | w > 9999 = ".0000" <> TB.decimal w- | w > 999 = ".00000" <> TB.decimal w- | w > 99 = ".000000" <> TB.decimal w- | w > 9 = ".0000000" <> TB.decimal w- | otherwise = ".00000000" <> TB.decimal w--microsecondsBuilder :: Int64 -> TB.Builder-microsecondsBuilder w- | w == 0 = mempty- | w > 99999 = "." <> TB.decimal w- | w > 9999 = ".0" <> TB.decimal w- | w > 999 = ".00" <> TB.decimal w- | w > 99 = ".000" <> TB.decimal w- | w > 9 = ".0000" <> TB.decimal w- | otherwise = ".00000" <> TB.decimal w--millisecondsBuilder :: Int64 -> TB.Builder-millisecondsBuilder w- | w == 0 = mempty- | w > 99 = "." <> TB.decimal w- | w > 9 = ".0" <> TB.decimal w- | otherwise = ".00" <> TB.decimal w--prettyNanosecondsBuilder :: SubsecondPrecision -> Int64 -> TB.Builder-prettyNanosecondsBuilder sp nano = case sp of- SubsecondPrecisionAuto- | milliRem == 0 -> millisecondsBuilder milli- | microRem == 0 -> microsecondsBuilder micro- | otherwise -> nanosecondsBuilder nano- SubsecondPrecisionFixed d -> if d == 0- then mempty- else- let newSubsecondPart = quot nano (raiseTenTo (9 - d))- in "."- <> TB.fromText (Text.replicate (d - countDigits newSubsecondPart) "0")- <> TB.decimal newSubsecondPart- where- (milli,milliRem) = quotRem nano 1000000- (micro,microRem) = quotRem nano 1000---- | Encode a 'Timespan' as 'Text' using the given 'SubsecondPrecision'.-encodeTimespan :: SubsecondPrecision -> Timespan -> Text-encodeTimespan sp =- LT.toStrict . TB.toLazyText . builderTimespan sp---- | Construct a 'Text' 'TB.Builder' corresponding to an encoding--- of the given 'Timespan' using the given 'SubsecondPrecision'.-builderTimespan :: SubsecondPrecision -> Timespan -> TB.Builder-builderTimespan sp (Timespan ns) =- TB.decimal sInt64 <> prettyNanosecondsBuilder sp nsRemainder- where- (!sInt64,!nsRemainder) = quotRem ns 1000000000--internalBuilder_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> TB.Builder-internalBuilder_NS sp msep m ns = case msep of- Nothing -> indexTwoDigitTextBuilder m- <> indexTwoDigitTextBuilder s- <> prettyNanosecondsBuilder sp nsRemainder- Just sep -> let sepBuilder = TB.singleton sep in- sepBuilder- <> indexTwoDigitTextBuilder m- <> sepBuilder- <> indexTwoDigitTextBuilder s- <> prettyNanosecondsBuilder sp nsRemainder- where- (!sInt64,!nsRemainder) = quotRem ns 1000000000- !s = fromIntegral sInt64---- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct a--- 'Text' 'TB.Builder' corresponding to a--- Day\/Month\/Year,Hour\/Minute\/Second encoding of the given 'Datetime'.-builder_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder-builder_DmyHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- case msep of- Nothing -> builder_Dmy mdateSep date- <> builder_HMS sp mtimeSep time- Just sep -> builder_Dmy mdateSep date- <> TB.singleton sep- <> builder_HMS sp mtimeSep time---- | Given a 'MeridiemLocale', a 'SubsecondPrecision',--- and a 'DatetimeFormat', construct a 'Text' 'TB.Builder'--- corresponding to a Day\/Month\/Year,IMS encoding of the given--- 'Datetime'. This differs from 'builder_DmyIMSp' in that--- it adds a space between the locale and seconds.-builder_DmyIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder-builder_DmyIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- builder_Dmy mdateSep date- <> maybe mempty TB.singleton msep- <> builder_IMS_p locale sp mtimeSep time---- | Given a 'MeridiemLocale', a 'SubsecondPrecision',--- and a 'DatetimeFormat', construct a 'Text' 'TB.Builder'--- corresponding to a Day\/Month\/Year,IMS encoding of the given--- 'Datetime'.-builder_DmyIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder-builder_DmyIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- builder_Dmy mdateSep date- <> maybe mempty TB.singleton msep- <> builder_IMS_p locale sp mtimeSep time---- | Given a 'SubsecondPrecision' and 'DatetimeFormat', construct--- 'Text' that corresponds to a Day\/Month\/Year,Hour\/Minute\/Second--- encoding of the given 'Datetime'.-encode_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text-encode_DmyHMS sp format =- LT.toStrict . TB.toLazyText . builder_DmyHMS sp format---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a--- 'DatetimeFormat', construct 'Text' that corresponds to a--- Day\/Month\/Year,IMS encoding of the given 'Datetime'. This--- inserts a space between the locale and seconds.-encode_DmyIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text-encode_DmyIMS_p a sp b = LT.toStrict . TB.toLazyText . builder_DmyIMS_p a sp b---- | Given a 'SubsecondPrecision' and 'DatetimeFormat', construct--- 'Text' that corresponds to a Year\/Month\/Day,Hour\/Minute\/Second--- encoding of the given 'Datetime'.-encode_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text-encode_YmdHMS sp format =- LT.toStrict . TB.toLazyText . builder_YmdHMS sp format---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a--- 'DatetimeFormat', construct 'Text' that corresponds to a--- Year\/Month\/Day,IMS encoding of the given 'Datetime'. This--- inserts a space between the locale and seconds.-encode_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text-encode_YmdIMS_p a sp b = LT.toStrict . TB.toLazyText . builder_YmdIMS_p a sp b---- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct--- a 'Text' 'TB.Builder' corresponding to a--- Year\/Month\/Day,Hour\/Minute\/Second encoding of the given 'Datetime'.-builder_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder-builder_YmdHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- case msep of- Nothing -> builder_Ymd mdateSep date- <> builder_HMS sp mtimeSep time- Just sep -> builder_Ymd mdateSep date- <> TB.singleton sep- <> builder_HMS sp mtimeSep time---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a--- 'DatetimeFormat', construct a 'Text' 'TB.Builder' that--- corresponds to a Year\/Month\/Day,IMS encoding of the--- given 'Datetime'. This inserts a space between the locale--- and seconds.-builder_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder-builder_YmdIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- builder_Ymd mdateSep date- <> maybe mempty TB.singleton msep- <> builder_IMS_p locale sp mtimeSep time---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a--- 'DatetimeFormat', construct a 'Text' 'TB.Builder' that--- corresponds to a Year\/Month\/Day,IMS encoding of the--- given 'Datetime'.-builder_YmdIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder-builder_YmdIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- builder_Ymd mdateSep date- <> maybe mempty TB.singleton msep- <> builder_IMS_p locale sp mtimeSep time---- | Construct a 'Text' 'TB.Builder' corresponding to the W3C--- encoding of the given 'Datetime'.-builderW3C :: Datetime -> TB.Builder-builderW3C = builder_YmdHMS SubsecondPrecisionAuto w3c---- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime'--- from 'Text' that was encoded with the given 'DatetimeFormat'.-decode_YmdHMS :: DatetimeFormat -> Text -> Maybe Datetime-decode_YmdHMS format =- either (const Nothing) Just . AT.parseOnly (parser_YmdHMS format)---- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime'--- that was encoded with the given 'DatetimeFormat'.-parser_DmyHMS :: DatetimeFormat -> Parser Datetime-parser_DmyHMS (DatetimeFormat mdateSep msep mtimeSep) = do- date <- parser_Dmy mdateSep- traverse_ AT.char msep- time <- parser_HMS mtimeSep- pure (Datetime date time)---- | Parses text that is formatted as either of the following:------ * @%H:%M@--- * @%H:%M:%S@------ That is, the seconds and subseconds part is optional. If it is--- not provided, it is assumed to be zero. This format shows up--- in Google Chrome\'s @datetime-local@ inputs.-parser_DmyHMS_opt_S :: DatetimeFormat -> Parser Datetime-parser_DmyHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do- date <- parser_Dmy mdateSep- traverse_ AT.char msep- time <- parser_HMS_opt_S mtimeSep- pure (Datetime date time)---- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime'--- from 'Text' that was encoded with the given 'DatetimeFormat'.-decode_DmyHMS :: DatetimeFormat -> Text -> Maybe Datetime-decode_DmyHMS format =- either (const Nothing) Just . AT.parseOnly (parser_DmyHMS format)---- | Parses text that is formatted as either of the following:------ * @%H:%M@--- * @%H:%M:%S@------ That is, the seconds and subseconds part is optional. If it is--- not provided, it is assumed to be zero. This format shows up--- in Google Chrome\'s @datetime-local@ inputs.-decode_DmyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime-decode_DmyHMS_opt_S format =- either (const Nothing) Just . AT.parseOnly (parser_DmyHMS_opt_S format)--- | Parses a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime'--- that was encoded using the given 'DatetimeFormat'.-parser_YmdHMS :: DatetimeFormat -> Parser Datetime-parser_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do- date <- parser_Ymd mdateSep- traverse_ AT.char msep- time <- parser_HMS mtimeSep- pure (Datetime date time)---- | Parses text that is formatted as either of the following:------ * @%H:%M@--- * @%H:%M:%S@------ That is, the seconds and subseconds part is optional. If it is--- not provided, it is assumed to be zero. This format shows up--- in Google Chrome\'s @datetime-local@ inputs.-parser_YmdHMS_opt_S :: DatetimeFormat -> Parser Datetime-parser_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do- date <- parser_Ymd mdateSep- traverse_ AT.char msep- time <- parser_HMS_opt_S mtimeSep- pure (Datetime date time)---- | Parses text that is formatted as either of the following:------ * @%H:%M@--- * @%H:%M:%S@------ That is, the seconds and subseconds part is optional. If it is--- not provided, it is assumed to be zero. This format shows up--- in Google Chrome\'s @datetime-local@ inputs.-decode_YmdHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime-decode_YmdHMS_opt_S format =- either (const Nothing) Just . AT.parseOnly (parser_YmdHMS_opt_S format)------------------- ByteString stuff-------------------- | Given a 'SubsecondPrecision' and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an Hour\/Month\/Second encoding of the given 'TimeOfDay'.-builderUtf8_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder-builderUtf8_HMS sp msep (TimeOfDay h m ns) =- indexTwoDigitByteStringBuilder h- <> internalBuilderUtf8_NS sp msep m ns---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an IMS encoding of the given 'TimeOfDay'. This differs from 'builderUtf8_IMSp' in that--- there is a space between the seconds and locale.-builderUtf8_IMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder-builderUtf8_IMS_p meridiemLocale sp msep (TimeOfDay h m ns) =- internalBuilderUtf8_I h- <> internalBuilderUtf8_NS sp msep m ns- <> " "- <> internalBuilderUtf8_p meridiemLocale h--internalBuilderUtf8_I :: Int -> BB.Builder-internalBuilderUtf8_I h =- indexTwoDigitByteStringBuilder $ if h > 12- then h - 12- else if h == 0- then 12- else h--internalBuilderUtf8_p :: MeridiemLocale ByteString -> Int -> BB.Builder-internalBuilderUtf8_p (MeridiemLocale am pm) h = if h > 11- then BB.byteString pm- else BB.byteString am---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an IMS encoding of the given 'TimeOfDay'.-builderUtf8_IMSp :: MeridiemLocale ByteString -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder-builderUtf8_IMSp meridiemLocale sp msep (TimeOfDay h m ns) =- internalBuilderUtf8_I h- <> internalBuilderUtf8_NS sp msep m ns- <> internalBuilderUtf8_p meridiemLocale h---- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that uses--- the given separator.-parserUtf8_HMS :: Maybe Char -> AB.Parser TimeOfDay-parserUtf8_HMS msep = do- h <- parseFixedDigitsIntBS 2- when (h > 23) (fail "hour must be between 0 and 23")- traverse_ AB.char msep- m <- parseFixedDigitsIntBS 2- when (m > 59) (fail "minute must be between 0 and 59")- traverse_ AB.char msep- ns <- parseSecondsAndNanosecondsUtf8- pure (TimeOfDay h m ns)---- | Parses text that is formatted as either of the following:------ * @%H:%M@--- * @%H:%M:%S@------ That is, the seconds and subseconds part is optional. If it is--- not provided, it is assumed to be zero. This format shows up--- in Google Chrome\'s @datetime-local@ inputs.-parserUtf8_HMS_opt_S :: Maybe Char -> AB.Parser TimeOfDay-parserUtf8_HMS_opt_S msep = do- h <- parseFixedDigitsIntBS 2- when (h > 23) (fail "hour must be between 0 and 23")- traverse_ AB.char msep- m <- parseFixedDigitsIntBS 2- when (m > 59) (fail "minute must be between 0 and 59")- mc <- AB.peekChar- case mc of- Nothing -> pure (TimeOfDay h m 0)- Just c -> case msep of- Just sep -> if c == sep- then do- _ <- AB.anyChar -- should be the separator- ns <- parseSecondsAndNanosecondsUtf8- pure (TimeOfDay h m ns)- else pure (TimeOfDay h m 0)- -- if there is no separator, we will try to parse the- -- remaining part as seconds. We commit to trying to- -- parse as seconds if we see any number as the next- -- character.- Nothing -> if isDigit c- then do- ns <- parseSecondsAndNanosecondsUtf8- pure (TimeOfDay h m ns)- else pure (TimeOfDay h m 0)--parseSecondsAndNanosecondsUtf8 :: AB.Parser Int64-parseSecondsAndNanosecondsUtf8 = do- s' <- parseFixedDigitsIntBS 2- let !s = fromIntegral s' :: Int64- 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)- ) <|> pure 0- pure (s * 1000000000 + nanoseconds)--countZeroesUtf8 :: AB.Parser Int-countZeroesUtf8 = go 0 where- go !i = do- m <- AB.peekChar- case m of- Nothing -> pure i- Just c -> if c == '0'- then AB.anyChar *> go (i + 1)- else pure i--nanosecondsBuilderUtf8 :: Int64 -> BB.Builder-nanosecondsBuilderUtf8 w- | w == 0 = mempty- | w > 99999999 = "." <> int64Builder w- | w > 9999999 = ".0" <> int64Builder w- | w > 999999 = ".00" <> int64Builder w- | w > 99999 = ".000" <> int64Builder w- | w > 9999 = ".0000" <> int64Builder w- | w > 999 = ".00000" <> int64Builder w- | w > 99 = ".000000" <> int64Builder w- | w > 9 = ".0000000" <> int64Builder w- | otherwise = ".00000000" <> int64Builder w--microsecondsBuilderUtf8 :: Int64 -> BB.Builder-microsecondsBuilderUtf8 w- | w == 0 = mempty- | w > 99999 = "." <> int64Builder w- | w > 9999 = ".0" <> int64Builder w- | w > 999 = ".00" <> int64Builder w- | w > 99 = ".000" <> int64Builder w- | w > 9 = ".0000" <> int64Builder w- | otherwise = ".00000" <> int64Builder w--millisecondsBuilderUtf8 :: Int64 -> BB.Builder-millisecondsBuilderUtf8 w- | w == 0 = mempty- | w > 99 = "." <> int64Builder w- | w > 9 = ".0" <> int64Builder w- | otherwise = ".00" <> int64Builder w--prettyNanosecondsBuilderUtf8 :: SubsecondPrecision -> Int64 -> BB.Builder-prettyNanosecondsBuilderUtf8 sp nano = case sp of- SubsecondPrecisionAuto- | milliRem == 0 -> millisecondsBuilderUtf8 milli- | microRem == 0 -> microsecondsBuilderUtf8 micro- | otherwise -> nanosecondsBuilderUtf8 nano- SubsecondPrecisionFixed d -> if d == 0- then mempty- else- let newSubsecondPart = quot nano (raiseTenTo (9 - d))- in BB.char7 '.'- <> BB.byteString (BC.replicate (d - countDigits newSubsecondPart) '0')- <> int64Builder newSubsecondPart- where- (milli,milliRem) = quotRem nano 1000000- (micro,microRem) = quotRem nano 1000---- | Given a 'SubsecondPrecision', construct a 'ByteString' corresponding--- to an encoding of the given 'Timespan'.-encodeTimespanUtf8 :: SubsecondPrecision -> Timespan -> ByteString-encodeTimespanUtf8 sp =- LB.toStrict . BB.toLazyByteString . builderTimespanUtf8 sp---- | Given a 'SubsecondPrecision', construct a 'ByteString' 'BB.Builder'--- corresponding to an encoding of the given 'Timespan'.-builderTimespanUtf8 :: SubsecondPrecision -> Timespan -> BB.Builder-builderTimespanUtf8 sp (Timespan ns) =- int64Builder sInt64 <> prettyNanosecondsBuilderUtf8 sp nsRemainder- where- (!sInt64,!nsRemainder) = quotRem ns 1000000000--int64Builder :: Int64 -> BB.Builder-int64Builder = BB.integerDec . fromIntegral--internalBuilderUtf8_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> BB.Builder-internalBuilderUtf8_NS sp msep m ns = case msep of- Nothing -> indexTwoDigitByteStringBuilder m- <> indexTwoDigitByteStringBuilder s- <> prettyNanosecondsBuilderUtf8 sp nsRemainder- Just sep -> let sepBuilder = BB.char7 sep in- sepBuilder- <> indexTwoDigitByteStringBuilder m- <> sepBuilder- <> indexTwoDigitByteStringBuilder s- <> prettyNanosecondsBuilderUtf8 sp nsRemainder- where- (!sInt64,!nsRemainder) = quotRem ns 1000000000- !s = fromIntegral sInt64---- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct--- a 'ByteString' corresponding to a Year\/Month\/Day,Hour\/Minute\/Second--- encoding of the given 'Datetime'.-encodeUtf8_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString-encodeUtf8_YmdHMS sp format =- LB.toStrict . BB.toLazyByteString . builderUtf8_YmdHMS sp format---- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a 'DatetimeFormat',--- construct a 'ByteString' corresponding to a Year\/Month\/Day,IMS encoding--- of the given 'Datetime'. This inserts a space between the locale and--- seconds.-encodeUtf8_YmdIMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString-encodeUtf8_YmdIMS_p a sp b = LB.toStrict . BB.toLazyByteString . builderUtf8_YmdIMS_p a sp b---- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct--- a 'ByteString' 'BB.Builder' corresponding to a--- Year\/Month\/Day,Hour\/Minute\/Second encoding of the--- given 'Datetime'.-builderUtf8_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder-builderUtf8_YmdHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- case msep of- Nothing -> builderUtf8_Ymd mdateSep date- <> builderUtf8_HMS sp mtimeSep time- Just sep -> builderUtf8_Ymd mdateSep date- <> BB.char7 sep- <> builderUtf8_HMS sp mtimeSep time---- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct--- a 'ByteString' 'BB.Builder' corresponding to a--- Year\/Month\/Day,IMS encoding of the given 'Datetime'. This inserts--- a space between the locale and seconds.-builderUtf8_YmdIMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder-builderUtf8_YmdIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- builderUtf8_Ymd mdateSep date- <> maybe mempty BB.char7 msep- <> builderUtf8_IMS_p locale sp mtimeSep time---- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct--- a 'ByteString' 'BB.Builder' corresponding to a--- Year\/Month\/Day,IMS encoding of the given 'Datetime'.-builderUtf8_YmdIMSp :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder-builderUtf8_YmdIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =- builderUtf8_Ymd mdateSep date- <> maybe mempty BB.char7 msep- <> builderUtf8_IMS_p locale sp mtimeSep time---- | Construct a 'ByteString' 'BB.Builder' corresponding to--- a W3C encoding of the given 'Datetime'.-builderUtf8W3C :: Datetime -> BB.Builder-builderUtf8W3C = builderUtf8_YmdHMS SubsecondPrecisionAuto (DatetimeFormat (Just '-') (Just 'T') (Just ':'))---- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' from--- a 'ByteString'.-decodeUtf8_YmdHMS :: DatetimeFormat -> ByteString -> Maybe Datetime-decodeUtf8_YmdHMS format =- either (const Nothing) Just . AB.parseOnly (parserUtf8_YmdHMS format)---- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' that was--- encoded using the given 'DatetimeFormat'.-parserUtf8_YmdHMS :: DatetimeFormat -> AB.Parser Datetime-parserUtf8_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do- date <- parserUtf8_Ymd mdateSep- traverse_ AB.char msep- time <- parserUtf8_HMS mtimeSep- pure (Datetime date time)---- | Parses text that is formatted as either of the following:------ * @%H:%M@--- * @%H:%M:%S@------ That is, the seconds and subseconds part is optional. If it is--- not provided, it is assumed to be zero. This format shows up--- in Google Chrome\'s @datetime-local@ inputs.-parserUtf8_YmdHMS_opt_S :: DatetimeFormat -> AB.Parser Datetime-parserUtf8_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do- date <- parserUtf8_Ymd mdateSep- traverse_ AB.char msep- time <- parserUtf8_HMS_opt_S mtimeSep- pure (Datetime date time)---- | Parses text that is formatted as either of the following:------ * @%H:%M@--- * @%H:%M:%S@------ That is, the seconds and subseconds part is optional. If it is--- not provided, it is assumed to be zero. This format shows up--- in Google Chrome\'s @datetime-local@ inputs.-decodeUtf8_YmdHMS_opt_S :: DatetimeFormat -> ByteString -> Maybe Datetime-decodeUtf8_YmdHMS_opt_S format =- either (const Nothing) Just . AB.parseOnly (parserUtf8_YmdHMS_opt_S format)---- | Given an 'OffsetFormat', a 'SubsecondPrecision', and--- a 'DatetimeFormat', construct a 'Text' 'TB.Builder'--- corresponding to a Year\/Month\/Day,Hour\/Minute\/Second encoding--- of the given 'OffsetDatetime'.-builder_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder-builder_YmdHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) =- builder_YmdHMS sp datetimeFormat datetime- <> builderOffset offsetFormat offset---- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'OffsetDatetime'--- that was encoded using the given 'OffsetFormat'--- and 'DatetimeFormat'.-parser_YmdHMSz :: OffsetFormat -> DatetimeFormat -> Parser OffsetDatetime-parser_YmdHMSz offsetFormat datetimeFormat = OffsetDatetime- <$> parser_YmdHMS datetimeFormat- <*> parserOffset offsetFormat---- | Given an 'OffsetFormat', a 'MeridiemLocale', a--- 'SubsecondPrecision', and 'DatetimeFormat', construct a--- 'Text' 'TB.Builder' corresponding to a Year\/Month\/Day,IMS-encoding--- of the given 'OffsetDatetime'.-builder_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder-builder_YmdIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) =- builder_YmdIMS_p meridiemLocale sp datetimeFormat datetime- <> " "- <> builderOffset offsetFormat offset---- | Given an 'OffsetFormat', a 'SubsecondPrecision',--- and a 'DatetimeFormat', construct 'Text' corresponding to--- the Year\/Month\/Day,Hour\/Minute\/Second-encoding of--- the given 'OffsetDatetime'.-encode_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Text-encode_YmdHMSz offsetFormat sp datetimeFormat =- LT.toStrict . TB.toLazyText . builder_YmdHMSz offsetFormat sp datetimeFormat---- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a--- 'DatetimeFormat', construct a 'Text' 'TB.Builder' corresponding--- to the Day\/Month\/Year,Hour\/Minute\/Second-encoding of--- the given 'OffsetDatetime'.-builder_DmyHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder-builder_DmyHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) =- builder_DmyHMS sp datetimeFormat datetime- <> builderOffset offsetFormat offset---- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'OffsetDatetime'--- that was encoded using the given 'OffsetFormat'--- and 'DatetimeFormat'.-parser_DmyHMSz :: OffsetFormat -> DatetimeFormat -> AT.Parser OffsetDatetime-parser_DmyHMSz offsetFormat datetimeFormat = OffsetDatetime- <$> parser_DmyHMS datetimeFormat- <*> parserOffset offsetFormat---- | Given an 'OffsetFormat', a 'MeridiemLocale', a--- 'SubsecondPrecision', and a 'DatetimeFormat', construct a 'Text'--- 'TB.Builder' corresponding to the Day\/Month\/Year,IMS encoding--- of the given 'OffsetDatetime'.-builder_DmyIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder-builder_DmyIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) =- builder_DmyIMS_p meridiemLocale sp datetimeFormat datetime- <> " "- <> builderOffset offsetFormat offset---- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a--- 'DatetimeFormat', construct 'Text' corresponding to the--- Day\/Month\/Year,Hour\/Minute\/Second encoding of the given--- 'OffsetDatetime'.-encode_DmyHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Text-encode_DmyHMSz offsetFormat sp datetimeFormat =- LT.toStrict . TB.toLazyText . builder_DmyHMSz offsetFormat sp datetimeFormat---- | Construct a 'Text' 'TB.Builder' corresponding to the w3c-formatting--- of the given 'OffsetDatetime'.-builderW3Cz :: OffsetDatetime -> TB.Builder-builderW3Cz = builder_YmdHMSz- OffsetFormatColonOn- SubsecondPrecisionAuto- (DatetimeFormat (Just '-') (Just 'T') (Just ':'))---- | Encode an 'Offset' to 'Text' using the given 'OffsetFormat'.-encodeOffset :: OffsetFormat -> Offset -> Text-encodeOffset fmt = LT.toStrict . TB.toLazyText . builderOffset fmt---- | Construct a 'TB.Builder' corresponding to the given 'Offset'--- encoded using the given 'OffsetFormat'.-builderOffset :: OffsetFormat -> Offset -> TB.Builder-builderOffset x = case x of- OffsetFormatColonOff -> builderOffset_z- OffsetFormatColonOn -> builderOffset_z1- OffsetFormatSecondsPrecision -> builderOffset_z2- OffsetFormatColonAuto -> builderOffset_z3---- | Decode an 'Offset' from 'Text' that was encoded--- using the given 'OffsetFormat'.-decodeOffset :: OffsetFormat -> Text -> Maybe Offset-decodeOffset fmt =- either (const Nothing) Just . AT.parseOnly (parserOffset fmt <* AT.endOfInput)---- | Parse an 'Offset' that was encoded using the given 'OffsetFormat'.-parserOffset :: OffsetFormat -> Parser Offset-parserOffset x = case x of- OffsetFormatColonOff -> parserOffset_z- OffsetFormatColonOn -> parserOffset_z1- OffsetFormatSecondsPrecision -> parserOffset_z2- OffsetFormatColonAuto -> parserOffset_z3---- | True means positive, false means negative-parseSignedness :: Parser Bool-parseSignedness = do- c <- AT.anyChar- if c == '-'- then pure False- else if c == '+'- then pure True- else fail "while parsing offset, expected [+] or [-]"--parserOffset_z :: Parser Offset-parserOffset_z = do- pos <- parseSignedness- h <- parseFixedDigits 2- m <- parseFixedDigits 2- let !res = h * 60 + m- pure . Offset $ if pos- then res- else negate res--parserOffset_z1 :: Parser Offset-parserOffset_z1 = do- pos <- parseSignedness- h <- parseFixedDigits 2- _ <- AT.char ':'- m <- parseFixedDigits 2- let !res = h * 60 + m- pure . Offset $ if pos- then res- else negate res--parserOffset_z2 :: AT.Parser Offset-parserOffset_z2 = do- pos <- parseSignedness- h <- parseFixedDigits 2- _ <- AT.char ':'- m <- parseFixedDigits 2- _ <- AT.string ":00"- let !res = h * 60 + m- pure . Offset $ if pos- then res- else negate res---- | This is generous in what it accepts. If you give--- something like +04:00 as the offset, it will be--- allowed, even though it could be shorter.-parserOffset_z3 :: AT.Parser Offset-parserOffset_z3 = do- pos <- parseSignedness- h <- parseFixedDigits 2- mc <- AT.peekChar- case mc of- Just ':' -> do- _ <- AT.anyChar -- should be a colon- m <- parseFixedDigits 2- let !res = h * 60 + m- pure . Offset $ if pos- then res- else negate res- _ -> pure . Offset $ if pos- then h * 60- else h * (-60)--builderOffset_z :: Offset -> TB.Builder-builderOffset_z (Offset i) =- let (!a,!b) = divMod (abs i) 60- !prefix = if signum i == (-1) then "-" else "+"- in prefix- <> indexTwoDigitTextBuilder a- <> indexTwoDigitTextBuilder b--builderOffset_z1 :: Offset -> TB.Builder-builderOffset_z1 (Offset i) =- let (!a,!b) = divMod (abs i) 60- !prefix = if signum i == (-1) then "-" else "+"- in prefix- <> indexTwoDigitTextBuilder a- <> ":"- <> indexTwoDigitTextBuilder b--builderOffset_z2 :: Offset -> TB.Builder-builderOffset_z2 (Offset i) =- let (!a,!b) = divMod (abs i) 60- !prefix = if signum i == (-1) then "-" else "+"- in prefix- <> indexTwoDigitTextBuilder a- <> ":"- <> indexTwoDigitTextBuilder b- <> ":00"--builderOffset_z3 :: Offset -> TB.Builder-builderOffset_z3 (Offset i) =- let (!a,!b) = divMod (abs i) 60- !prefix = if signum i == (-1) then "-" else "+"- in if b == 0- then prefix- <> indexTwoDigitTextBuilder a- else prefix- <> indexTwoDigitTextBuilder a- <> ":"- <> indexTwoDigitTextBuilder b---- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a--- 'DatetimeFormat', construct a 'ByteString' 'BB.Builder'--- corresponding to the Year\/Month\/Day,Hour\/Minute\/Second--- encoding of the given 'OffsetDatetime'.-builderUtf8_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> BB.Builder-builderUtf8_YmdHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) =- builderUtf8_YmdHMS sp datetimeFormat datetime- <> builderOffsetUtf8 offsetFormat offset---- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'OffsetDatetime'--- that was encoded using the given 'OffsetFormat' and--- 'DatetimeFormat'.-parserUtf8_YmdHMSz :: OffsetFormat -> DatetimeFormat -> AB.Parser OffsetDatetime-parserUtf8_YmdHMSz offsetFormat datetimeFormat = OffsetDatetime- <$> parserUtf8_YmdHMS datetimeFormat- <*> parserOffsetUtf8 offsetFormat---- | Given an 'OffsetFormat', a 'MeridiemLocale, a 'SubsecondPrecision',--- and a 'DatetimeFormat', construct a 'ByteString' 'BB.Builder'--- corresponding to a Year\/Month\/Day,IMS-encoded 'OffsetDatetime'.-builderUtf8_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> BB.Builder-builderUtf8_YmdIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) =- builderUtf8_YmdIMS_p meridiemLocale sp datetimeFormat datetime- <> " "- <> builderOffsetUtf8 offsetFormat offset---- | Construct a 'ByteString' 'BB.Builder' corresponding to the W3C--- encoding of the given 'Datetime'.-builderUtf8W3Cz :: OffsetDatetime -> BB.Builder-builderUtf8W3Cz = builderUtf8_YmdHMSz- OffsetFormatColonOn- SubsecondPrecisionAuto- (DatetimeFormat (Just '-') (Just 'T') (Just ':'))---- | Encode an 'Offset' as a 'ByteString' using the given 'OffsetFormat'.-encodeOffsetUtf8 :: OffsetFormat -> Offset -> ByteString-encodeOffsetUtf8 fmt = LB.toStrict . BB.toLazyByteString . builderOffsetUtf8 fmt---- | Decode an 'Offset' from a 'ByteString' that was encoded using the given--- 'OffsetFormat'.-decodeOffsetUtf8 :: OffsetFormat -> ByteString -> Maybe Offset-decodeOffsetUtf8 fmt =- either (const Nothing) Just . AB.parseOnly (parserOffsetUtf8 fmt)---- | Construct a 'ByteString' 'BB.Builder' corresponding to the--- encoding of an 'Offset' using the given 'OffsetFormat'.-builderOffsetUtf8 :: OffsetFormat -> Offset -> BB.Builder-builderOffsetUtf8 x = case x of- OffsetFormatColonOff -> builderOffsetUtf8_z- OffsetFormatColonOn -> builderOffsetUtf8_z1- OffsetFormatSecondsPrecision -> builderOffsetUtf8_z2- OffsetFormatColonAuto -> builderOffsetUtf8_z3---- | Parse an 'Offset' that was encoded using the given--- 'OffsetFormat'.-parserOffsetUtf8 :: OffsetFormat -> AB.Parser Offset-parserOffsetUtf8 x = case x of- OffsetFormatColonOff -> parserOffsetUtf8_z- OffsetFormatColonOn -> parserOffsetUtf8_z1- OffsetFormatSecondsPrecision -> parserOffsetUtf8_z2- OffsetFormatColonAuto -> parserOffsetUtf8_z3---- | True means positive, false means negative-parseSignednessUtf8 :: AB.Parser Bool-parseSignednessUtf8 = do- c <- AB.anyChar- if c == '-'- then pure False- else if c == '+'- then pure True- else fail "while parsing offset, expected [+] or [-]"--parserOffsetUtf8_z :: AB.Parser Offset-parserOffsetUtf8_z = do- pos <- parseSignednessUtf8- h <- parseFixedDigitsIntBS 2- m <- parseFixedDigitsIntBS 2- let !res = h * 60 + m- pure . Offset $ if pos- then res- else negate res--parserOffsetUtf8_z1 :: AB.Parser Offset-parserOffsetUtf8_z1 = do- pos <- parseSignednessUtf8- h <- parseFixedDigitsIntBS 2- _ <- AB.char ':'- m <- parseFixedDigitsIntBS 2- let !res = h * 60 + m- pure . Offset $ if pos- then res- else negate res--parserOffsetUtf8_z2 :: AB.Parser Offset-parserOffsetUtf8_z2 = do- pos <- parseSignednessUtf8- h <- parseFixedDigitsIntBS 2- _ <- AB.char ':'- m <- parseFixedDigitsIntBS 2- _ <- AB.string ":00"- let !res = h * 60 + m- pure . Offset $ if pos- then res- else negate res---- | This is generous in what it accepts. If you give--- something like +04:00 as the offset, it will be--- allowed, even though it could be shorter.-parserOffsetUtf8_z3 :: AB.Parser Offset-parserOffsetUtf8_z3 = do- pos <- parseSignednessUtf8- h <- parseFixedDigitsIntBS 2- mc <- AB.peekChar- case mc of- Just ':' -> do- _ <- AB.anyChar -- should be a colon- m <- parseFixedDigitsIntBS 2- let !res = h * 60 + m- pure . Offset $ if pos- then res- else negate res- _ -> pure . Offset $ if pos- then h * 60- else h * (-60)--builderOffsetUtf8_z :: Offset -> BB.Builder-builderOffsetUtf8_z (Offset i) =- let (!a,!b) = divMod (abs i) 60- !prefix = if signum i == (-1) then "-" else "+"- in prefix- <> indexTwoDigitByteStringBuilder a- <> indexTwoDigitByteStringBuilder b--builderOffsetUtf8_z1 :: Offset -> BB.Builder-builderOffsetUtf8_z1 (Offset i) =- let (!a,!b) = divMod (abs i) 60- !prefix = if signum i == (-1) then "-" else "+"- in prefix- <> indexTwoDigitByteStringBuilder a- <> ":"- <> indexTwoDigitByteStringBuilder b--builderOffsetUtf8_z2 :: Offset -> BB.Builder-builderOffsetUtf8_z2 (Offset i) =- let (!a,!b) = divMod (abs i) 60- !prefix = if signum i == (-1) then "-" else "+"- in prefix- <> indexTwoDigitByteStringBuilder a- <> ":"- <> indexTwoDigitByteStringBuilder b- <> ":00"--builderOffsetUtf8_z3 :: Offset -> BB.Builder-builderOffsetUtf8_z3 (Offset i) =- let (!a,!b) = divMod (abs i) 60- !prefix = if signum i == (-1) then "-" else "+"- in if b == 0- then prefix- <> indexTwoDigitByteStringBuilder a- else prefix- <> indexTwoDigitByteStringBuilder a- <> ":"- <> indexTwoDigitByteStringBuilder b---- Zepto parsers---- | Parse a 'Datetime' that was encoded using the--- given 'DatetimeFormat'.-zeptoUtf8_YmdHMS :: DatetimeFormat -> Z.Parser Datetime-zeptoUtf8_YmdHMS (DatetimeFormat mdateSep msep' mtimeSep) = do- date <- zeptoUtf8_Ymd mdateSep- let msep = BC.singleton <$> msep'- traverse_ Z.string msep- time <- zeptoUtf8_HMS mtimeSep- pure (Datetime date time)--zeptoCountZeroes :: Z.Parser Int-zeptoCountZeroes = do- bs <- Z.takeWhile (0x30 ==)- pure $! BC.length bs---- | Parse a 'Date' that was encoded using--- the given separator.-zeptoUtf8_Ymd :: Maybe Char -> Z.Parser Date-zeptoUtf8_Ymd msep' = do- y <- zeptoFixedDigitsIntBS 4- let msep = BC.singleton <$> msep'- traverse_ Z.string msep- m <- zeptoFixedDigitsIntBS 2- when (m < 1 || m > 12) (fail "month must be between 1 and 12")- traverse_ Z.string msep- d <- zeptoFixedDigitsIntBS 2- when (d < 1 || d > 31) (fail "day must be between 1 and 31")- pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))---- | Parse a 'TimeOfDay' that was encoded using--- the given separator.-zeptoUtf8_HMS :: Maybe Char -> Z.Parser TimeOfDay-zeptoUtf8_HMS msep' = do- h <- zeptoFixedDigitsIntBS 2- when (h > 23) (fail "hour must be between 0 and 23")- let msep = BC.singleton <$> msep'- traverse_ Z.string msep- m <- zeptoFixedDigitsIntBS 2- when (m > 59) (fail "minute must be between 0 and 59")- traverse_ Z.string msep- ns <- zeptoSecondsAndNanosecondsUtf8- pure (TimeOfDay h m ns)--zeptoFixedDigitsIntBS :: Int -> Z.Parser Int-zeptoFixedDigitsIntBS n = do- t <- Z.take n- case BC.readInt t of- Nothing -> fail "datetime decoding could not parse integral bytestring (a)"- Just (i,r) -> if BC.null r- then pure i- else fail "datetime decoding could not parse integral bytestring (b)"--zeptoSecondsAndNanosecondsUtf8 :: Z.Parser Int64-zeptoSecondsAndNanosecondsUtf8 = do- s' <- zeptoFixedDigitsIntBS 2- let s = fromIntegral s' :: Int64- when (s > 60) (fail "seconds must be between 0 and 60")- nanoseconds <-- ( do _ <- Z.string "."- numberOfZeroes <- zeptoCountZeroes- x <- zdecimal- 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 (s * 1000000000 + nanoseconds)--zdecimal :: Z.Parser Int64-zdecimal = do- digits <- Z.takeWhile wordIsDigit- case BC.readInt digits of- Nothing -> fail "somehow this didn't work"- Just (i,_) -> pure $! fromIntegral i--wordIsDigit :: Word8 -> Bool-wordIsDigit a = 0x30 <= a && a <= 0x39---- | The 'Month' of January.-january :: Month-january = Month 0---- | The 'Month' of February.-february :: Month-february = Month 1---- | The 'Month' of March.-march :: Month-march = Month 2---- | The 'Month' of April.-april :: Month-april = Month 3---- | The 'Month' of May.-may :: Month-may = Month 4---- | The 'Month' of June.-june :: Month-june = Month 5---- | The 'Month' of July.-july :: Month-july = Month 6---- | The 'Month' of August.-august :: Month-august = Month 7---- | The 'Month' of September.-september :: Month-september = Month 8---- | The 'Month' of October.-october :: Month-october = Month 9---- | The 'Month' of November.-november :: Month-november = Month 10---- | The 'Month' of December.-december :: Month-december = Month 11---- | The 'DayOfWeek' Sunday.-sunday :: DayOfWeek-sunday = DayOfWeek 0---- | The 'DayOfWeek' Monday.-monday :: DayOfWeek-monday = DayOfWeek 1---- | The 'DayOfWeek' Tuesday.-tuesday :: DayOfWeek-tuesday = DayOfWeek 2---- | The 'DayOfWeek' Wednesday.-wednesday :: DayOfWeek-wednesday = DayOfWeek 3---- | The 'DayOfWeek' Thursday.-thursday :: DayOfWeek-thursday = DayOfWeek 4---- | The 'DayOfWeek' Friday.-friday :: DayOfWeek-friday = DayOfWeek 5---- | The 'DayOfWeek' Saturday.-saturday :: DayOfWeek-saturday = DayOfWeek 6--countDigits :: (Integral a) => a -> Int-countDigits v0- | fromIntegral v64 == v0 = go 1 v64- | otherwise = goBig 1 (fromIntegral v0)- where v64 = fromIntegral v0- goBig !k (v :: Integer)- | v > big = goBig (k + 19) (v `quot` big)- | otherwise = go k (fromIntegral v)- big = 10000000000000000000- go !k (v :: Word64)- | v < 10 = k- | v < 100 = k + 1- | v < 1000 = k + 2- | v < 1000000000000 =- k + if v < 100000000- then if v < 1000000- then if v < 10000- then 3- else 4 + fin v 100000- else 6 + fin v 10000000- else if v < 10000000000- then 8 + fin v 1000000000- else 10 + fin v 100000000000- | otherwise = go (k + 12) (v `quot` 1000000000000)- fin v n = if v >= n then 1 else 0--clip :: (Ord t) => t -> t -> t -> t-clip a _ x | x < a = a-clip _ b x | x > b = b-clip _ _ x = x--parseFixedDigits :: Int -> AT.Parser Int-parseFixedDigits n = do- t <- AT.take n- case Text.decimal t of- Left err -> fail err- Right (i,r) -> if Text.null r- then pure i- else fail "datetime decoding could not parse integral text"--parseFixedDigitsIntBS :: Int -> AB.Parser Int-parseFixedDigitsIntBS n = do- t <- AB.take n- case BC.readInt t of- Nothing -> fail "datetime decoding could not parse integral bytestring (a)"- Just (i,r) -> if BC.null r- then pure i- else fail "datetime decoding could not parse integral bytestring (b)"---- Only provide positive numbers to this function.-indexTwoDigitTextBuilder :: Int -> TB.Builder-indexTwoDigitTextBuilder i = if i < 100- then Vector.unsafeIndex twoDigitTextBuilder (fromIntegral i)- else TB.decimal i---- | Only provide positive numbers to this function.-indexTwoDigitByteStringBuilder :: Int -> BB.Builder-indexTwoDigitByteStringBuilder i = if i < 100- then Vector.unsafeIndex twoDigitByteStringBuilder (fromIntegral i)- else BB.intDec i--twoDigitByteStringBuilder :: Vector BB.Builder-twoDigitByteStringBuilder = Vector.fromList- $ map (BB.byteString . BC.pack) twoDigitStrings-{-# NOINLINE twoDigitByteStringBuilder #-}--twoDigitTextBuilder :: Vector TB.Builder-twoDigitTextBuilder = Vector.fromList- $ map (TB.fromText . Text.pack) twoDigitStrings-{-# NOINLINE twoDigitTextBuilder #-}--twoDigitStrings :: [String]-twoDigitStrings =- [ "00","01","02","03","04","05","06","07","08","09"- , "10","11","12","13","14","15","16","17","18","19"- , "20","21","22","23","24","25","26","27","28","29"- , "30","31","32","33","34","35","36","37","38","39"- , "40","41","42","43","44","45","46","47","48","49"- , "50","51","52","53","54","55","56","57","58","59"- , "60","61","62","63","64","65","66","67","68","69"- , "70","71","72","73","74","75","76","77","78","79"- , "80","81","82","83","84","85","86","87","88","89"- , "90","91","92","93","94","95","96","97","98","99"- ]--raiseTenTo :: Int -> Int64-raiseTenTo i = if i > 15- then 10 ^ i- else UVector.unsafeIndex tenRaisedToSmallPowers i--tenRaisedToSmallPowers :: UVector.Vector Int64-tenRaisedToSmallPowers = UVector.fromList $ map (10 ^) [0 :: Int ..15]--monthToZeroPaddedDigit :: Month -> TB.Builder-monthToZeroPaddedDigit (Month x) =- indexTwoDigitTextBuilder (x + 1)--zeroPadDayOfMonth :: DayOfMonth -> TB.Builder-zeroPadDayOfMonth (DayOfMonth d) = indexTwoDigitTextBuilder d--monthToZeroPaddedDigitBS :: Month -> BB.Builder-monthToZeroPaddedDigitBS (Month x) =- indexTwoDigitByteStringBuilder (x + 1)--zeroPadDayOfMonthBS :: DayOfMonth -> BB.Builder-zeroPadDayOfMonthBS (DayOfMonth d) = indexTwoDigitByteStringBuilder d---- | Is the given 'Time' within the 'TimeInterval'?-within :: Time -> TimeInterval -> Bool-t `within` (TimeInterval t0 t1) = t >= t0 && t <= t1---- | Convert a 'TimeInterval' to a 'Timespan'. This is equivalent to 'width'.-timeIntervalToTimespan :: TimeInterval -> Timespan-timeIntervalToTimespan = width---- | The 'TimeInterval' that covers the entire range of 'Time's that Chronos supports.------ prop> \(t :: Time) -> within t whole-whole :: TimeInterval-whole = TimeInterval minBound maxBound---- | The singleton (degenerate) 'TimeInterval'.-singleton :: Time -> TimeInterval-singleton x = TimeInterval x x---- | Get the lower bound of the 'TimeInterval'.-lowerBound :: TimeInterval -> Time-lowerBound (TimeInterval t0 _) = t0---- | Get the upper bound of the 'TimeInterval'.-upperBound :: TimeInterval -> Time-upperBound (TimeInterval _ t1) = t1---- | The width of the 'TimeInterval'. This is equivalent to 'timeIntervalToTimespan'.-width :: TimeInterval -> Timespan-width (TimeInterval x y) = difference y x---- | A smart constructor for 'TimeInterval'. In general, you should prefer using this--- over the 'TimeInterval' constructor, since it maintains the invariant that--- @'lowerBound' interval '<=' 'upperBound' interval@.-timeIntervalBuilder :: Time -> Time -> TimeInterval-timeIntervalBuilder x y = case compare x y of- GT -> TimeInterval y x- _ -> TimeInterval x y--infix 3 ...---- | An infix 'timeIntervalBuilder'.-(...) :: Time -> Time -> TimeInterval-(...) = timeIntervalBuilder---- | A day represented as the modified Julian date, the number of days--- since midnight on November 17, 1858.-newtype Day = Day { getDay :: Int }- deriving (Show,Read,Eq,Ord,Hashable,Enum,ToJSON,FromJSON,Storable,Prim)-instance Torsor Day Int where- add i (Day d) = Day (d + i)- difference (Day a) (Day b) = a - b---- | The day of the week.-newtype DayOfWeek = DayOfWeek { getDayOfWeek :: Int }- deriving (Show,Read,Eq,Ord,Hashable)---- | The day of the month.-newtype DayOfMonth = DayOfMonth { getDayOfMonth :: Int }- deriving (Show,Read,Eq,Ord,Prim,Enum)---- | The day of the year.-newtype DayOfYear = DayOfYear { getDayOfYear :: Int }- deriving (Show,Read,Eq,Ord,Prim)---- | The month of the year.-newtype Month = Month { getMonth :: Int }- deriving (Show,Read,Eq,Ord,Prim)--instance Enum Month where- fromEnum = getMonth- toEnum = Month- succ (Month x) = if x < 11- then Month (x + 1)- else error "Enum.succ{Month}: tried to take succ of December"- pred (Month x) = if x > 0- then Month (x - 1)- else error "Enum.pred{Month}: tried to take pred of January"- enumFrom x = enumFromTo x (Month 11)---- | 'Month' starts at 0 and ends at 11 (January to December)-instance Bounded Month where- minBound = Month 0- maxBound = Month 11---- | The number of years elapsed since the beginning--- of the Common Era.-newtype Year = Year { getYear :: Int }- deriving (Show,Read,Eq,Ord)---- | A <https://en.wikipedia.org/wiki/UTC_offset UTC offset>.-newtype Offset = Offset { getOffset :: Int }- deriving (Show,Read,Eq,Ord,Enum)---- | POSIX time with nanosecond resolution.-newtype Time = Time { getTime :: Int64 }- deriving (FromJSON,ToJSON,Hashable,Eq,Ord,Show,Read,Storable,Prim,Bounded)---- | Match a 'DayOfWeek'. By `match`, we mean that a 'DayOfWeekMatch'--- is a mapping from the integer value of a 'DayOfWeek' to some value--- of type @a@. You should construct a 'DayOfWeekMatch' with--- 'buildDayOfWeekMatch', and match it using 'caseDayOfWeek'.-newtype DayOfWeekMatch a = DayOfWeekMatch { getDayOfWeekMatch :: Vector a }---- | Match a 'Month'. By `match`, we mean that a 'MonthMatch' is--- a mapping from the integer value of a 'Month' to some value of--- type @a@. You should construct a 'MonthMatch' with--- 'buildMonthMatch', and match it using 'caseMonth'.-newtype MonthMatch a = MonthMatch { getMonthMatch :: Vector a }---- | Like 'MonthMatch', but the matched value can have an instance of--- 'UVector.Unbox'.-newtype UnboxedMonthMatch a = UnboxedMonthMatch { getUnboxedMonthMatch :: UVector.Vector a }---- | A timespan. This is represented internally as a number--- of nanoseconds.-newtype Timespan = Timespan { getTimespan :: Int64 }- deriving (Show,Read,Eq,Ord,ToJSON,FromJSON,Additive)--instance Semigroup Timespan where- (Timespan a) <> (Timespan b) = Timespan (a + b)--instance Monoid Timespan where- mempty = Timespan 0- mappend = (SG.<>)--instance Torsor Time Timespan where- add (Timespan ts) (Time t) = Time (t + ts)- difference (Time t) (Time s) = Timespan (t - s)--instance Scaling Timespan Int64 where- scale i (Timespan ts) = Timespan (i * ts)--instance Torsor Offset Int where- add i (Offset x) = Offset (x + i)- difference (Offset x) (Offset y) = x - y---- | The precision used when encoding seconds to a human-readable format.-data SubsecondPrecision- = SubsecondPrecisionAuto -- ^ Rounds to second, millisecond, microsecond, or nanosecond- | SubsecondPrecisionFixed {-# UNPACK #-} !Int -- ^ Specify number of places after decimal- deriving (Eq, Ord, Show, Read)---- | A date as represented by the Gregorian calendar.-data Date = Date- { dateYear :: {-# UNPACK #-} !Year- , dateMonth :: {-# UNPACK #-} !Month- , dateDay :: {-# UNPACK #-} !DayOfMonth- } deriving (Show,Read,Eq,Ord)---- | An 'OrdinalDate' is a 'Year' and the number of days elapsed--- since the 'Year' began.-data OrdinalDate = OrdinalDate- { ordinalDateYear :: {-# UNPACK #-} !Year- , ordinalDateDayOfYear :: {-# UNPACK #-} !DayOfYear- } deriving (Show,Read,Eq,Ord)---- | A month and the day of the month. This does not actually represent--- a specific date, since this recurs every year.-data MonthDate = MonthDate- { monthDateMonth :: {-# UNPACK #-} !Month- , monthDateDay :: {-# UNPACK #-} !DayOfMonth- } deriving (Show,Read,Eq,Ord)---- | A 'Date' as represented by the Gregorian calendar--- and a 'TimeOfDay'.-data Datetime = Datetime- { datetimeDate :: {-# UNPACK #-} !Date- , datetimeTime :: {-# UNPACK #-} !TimeOfDay- } deriving (Show,Read,Eq,Ord)---- | A 'Datetime' with a time zone 'Offset'.-data OffsetDatetime = OffsetDatetime- { offsetDatetimeDatetime :: {-# UNPACK #-} !Datetime- , offsetDatetimeOffset :: {-# UNPACK #-} !Offset- } deriving (Show,Read,Eq,Ord)---- | A time of day with nanosecond resolution.-data TimeOfDay = TimeOfDay- { timeOfDayHour :: {-# UNPACK #-} !Int- , timeOfDayMinute :: {-# UNPACK #-} !Int- , timeOfDayNanoseconds :: {-# UNPACK #-} !Int64- } deriving (Show,Read,Eq,Ord)---- | The format of a 'Datetime'. In particular--- this provides separators for parts of the 'Datetime'--- and nothing else.-data DatetimeFormat = DatetimeFormat- { datetimeFormatDateSeparator :: !(Maybe Char)- -- ^ Separator in the date- , datetimeFormatSeparator :: !(Maybe Char)- -- ^ Separator between date and time- , datetimeFormatTimeSeparator :: !(Maybe Char)- -- ^ Separator in the time- } deriving (Show,Read,Eq,Ord)---- | Formatting settings for a timezone offset.-data OffsetFormat- = OffsetFormatColonOff -- ^ @%z@ (e.g., -0400)- | OffsetFormatColonOn -- ^ @%:z@ (e.g., -04:00)- | OffsetFormatSecondsPrecision -- ^ @%::z@ (e.g., -04:00:00)- | OffsetFormatColonAuto -- ^ @%:::z@ (e.g., -04, +05:30)- deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)---- | Locale-specific formatting for weekdays and months. The--- type variable will likely be instantiated to @Text@--- or @ByteString@.-data DatetimeLocale a = DatetimeLocale- { datetimeLocaleDaysOfWeekFull :: !(DayOfWeekMatch a)- -- ^ full weekdays starting with Sunday, 7 elements- , datetimeLocaleDaysOfWeekAbbreviated :: !(DayOfWeekMatch a)- -- ^ abbreviated weekdays starting with Sunday, 7 elements- , datetimeLocaleMonthsFull :: !(MonthMatch a)- -- ^ full months starting with January, 12 elements- , datetimeLocaleMonthsAbbreviated :: !(MonthMatch a)- -- ^ abbreviated months starting with January, 12 elements- }---- | A TimeInterval represents a start and end time.--- It can sometimes be more ergonomic than the 'Torsor' API when--- you only care about whether or not a 'Time' is within a certain range.------ To construct a 'TimeInterval', it is best to use 'timeIntervalBuilder',--- which maintains the invariant that @'lowerBound' interval '<=' 'upperBound' interval@--- (all functions that act on 'TimeInterval's assume this invariant).-data TimeInterval = TimeInterval {-# UNPACK #-} !Time {-# UNPACK #-} !Time- deriving (Read,Show,Eq,Ord,Bounded)---- | Locale-specific formatting for AM and PM.-data MeridiemLocale a = MeridiemLocale- { meridiemLocaleAm :: !a- , meridiemLocalePm :: !a- } deriving (Read,Show,Eq,Ord)--newtype instance UVector.MVector s Month = MV_Month (PVector.MVector s Month)-newtype instance UVector.Vector Month = V_Month (PVector.Vector Month)--instance UVector.Unbox Month--instance MGVector.MVector UVector.MVector Month where- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicOverlaps #-}- {-# INLINE basicUnsafeNew #-}- {-# INLINE basicInitialize #-}- {-# INLINE basicUnsafeReplicate #-}- {-# INLINE basicUnsafeRead #-}- {-# INLINE basicUnsafeWrite #-}- {-# INLINE basicClear #-}- {-# INLINE basicSet #-}- {-# INLINE basicUnsafeCopy #-}- {-# INLINE basicUnsafeGrow #-}- basicLength (MV_Month v) = MGVector.basicLength v- basicUnsafeSlice i n (MV_Month v) = MV_Month $ MGVector.basicUnsafeSlice i n v- basicOverlaps (MV_Month v1) (MV_Month v2) = MGVector.basicOverlaps v1 v2- basicUnsafeNew n = MV_Month `liftM` MGVector.basicUnsafeNew n- basicInitialize (MV_Month v) = MGVector.basicInitialize v- basicUnsafeReplicate n x = MV_Month `liftM` MGVector.basicUnsafeReplicate n x- basicUnsafeRead (MV_Month v) i = MGVector.basicUnsafeRead v i- basicUnsafeWrite (MV_Month v) i x = MGVector.basicUnsafeWrite v i x- basicClear (MV_Month v) = MGVector.basicClear v- basicSet (MV_Month v) x = MGVector.basicSet v x- basicUnsafeCopy (MV_Month v1) (MV_Month v2) = MGVector.basicUnsafeCopy v1 v2- basicUnsafeMove (MV_Month v1) (MV_Month v2) = MGVector.basicUnsafeMove v1 v2- basicUnsafeGrow (MV_Month v) n = MV_Month `liftM` MGVector.basicUnsafeGrow v n--instance GVector.Vector UVector.Vector Month where- {-# INLINE basicUnsafeFreeze #-}- {-# INLINE basicUnsafeThaw #-}- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicUnsafeIndexM #-}- {-# INLINE elemseq #-}- basicUnsafeFreeze (MV_Month v) = V_Month `liftM` GVector.basicUnsafeFreeze v- basicUnsafeThaw (V_Month v) = MV_Month `liftM` GVector.basicUnsafeThaw v- basicLength (V_Month v) = GVector.basicLength v- basicUnsafeSlice i n (V_Month v) = V_Month $ GVector.basicUnsafeSlice i n v- basicUnsafeIndexM (V_Month v) i = GVector.basicUnsafeIndexM v i- basicUnsafeCopy (MV_Month mv) (V_Month v) = GVector.basicUnsafeCopy mv v- elemseq _ = seq--newtype instance UVector.MVector s DayOfMonth = MV_DayOfMonth (PVector.MVector s DayOfMonth)-newtype instance UVector.Vector DayOfMonth = V_DayOfMonth (PVector.Vector DayOfMonth)--instance UVector.Unbox DayOfMonth--instance MGVector.MVector UVector.MVector DayOfMonth where- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicOverlaps #-}- {-# INLINE basicUnsafeNew #-}- {-# INLINE basicInitialize #-}- {-# INLINE basicUnsafeReplicate #-}- {-# INLINE basicUnsafeRead #-}- {-# INLINE basicUnsafeWrite #-}- {-# INLINE basicClear #-}- {-# INLINE basicSet #-}- {-# INLINE basicUnsafeCopy #-}- {-# INLINE basicUnsafeGrow #-}- basicLength (MV_DayOfMonth v) = MGVector.basicLength v- basicUnsafeSlice i n (MV_DayOfMonth v) = MV_DayOfMonth $ MGVector.basicUnsafeSlice i n v- basicOverlaps (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicOverlaps v1 v2- basicUnsafeNew n = MV_DayOfMonth `liftM` MGVector.basicUnsafeNew n- basicInitialize (MV_DayOfMonth v) = MGVector.basicInitialize v- basicUnsafeReplicate n x = MV_DayOfMonth `liftM` MGVector.basicUnsafeReplicate n x- basicUnsafeRead (MV_DayOfMonth v) i = MGVector.basicUnsafeRead v i- basicUnsafeWrite (MV_DayOfMonth v) i x = MGVector.basicUnsafeWrite v i x- basicClear (MV_DayOfMonth v) = MGVector.basicClear v- basicSet (MV_DayOfMonth v) x = MGVector.basicSet v x- basicUnsafeCopy (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicUnsafeCopy v1 v2- basicUnsafeMove (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicUnsafeMove v1 v2- basicUnsafeGrow (MV_DayOfMonth v) n = MV_DayOfMonth `liftM` MGVector.basicUnsafeGrow v n--instance GVector.Vector UVector.Vector DayOfMonth where- {-# INLINE basicUnsafeFreeze #-}- {-# INLINE basicUnsafeThaw #-}- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicUnsafeIndexM #-}- {-# INLINE elemseq #-}- basicUnsafeFreeze (MV_DayOfMonth v) = V_DayOfMonth `liftM` GVector.basicUnsafeFreeze v- basicUnsafeThaw (V_DayOfMonth v) = MV_DayOfMonth `liftM` GVector.basicUnsafeThaw v- basicLength (V_DayOfMonth v) = GVector.basicLength v- basicUnsafeSlice i n (V_DayOfMonth v) = V_DayOfMonth $ GVector.basicUnsafeSlice i n v- basicUnsafeIndexM (V_DayOfMonth v) i = GVector.basicUnsafeIndexM v i- basicUnsafeCopy (MV_DayOfMonth mv) (V_DayOfMonth v) = GVector.basicUnsafeCopy mv v- elemseq _ = seq----------------------------- The Torsor and Enum instances for Date and OrdinalDate--- are both bad. This only causes problems for dates--- at least a million years in the future. Some of this--- badness is caused by pragmatism, and some of it is caused by--- my own laziness.------ The badness that comes from pragmatism:--- - Int technically is not a good delta for Date. Date--- has too many inhabitants. If we subtract the lowest--- Date from the highest Date, we get something too--- big to fit in a machine integer.--- - There is no good way to write fromEnum or toEnum for--- Date. Again, Date has more inhabitants than Int, so--- it simply cannot be done.--- The badness that comes from laziness:--- - Technically, we should still be able to add deltas to--- Dates that do not fit in machine integers. We should--- also be able to correctly subtract Dates to cannot--- fit in machine integers.--- - For similar reasons, the Enum functions succ, pred,--- enumFromThen, enumFromThenTo, etc. could all have--- better definitions than the default ones currently--- used.--- If, for some reason, anyone ever wants to fix the badness--- that comes from laziness, all--- you really have to do is define a version of dateToDay,--- dayToDate, ordinalDateToDay, and dayToOrdinalDate--- that uses something bigger instead of Day. Maybe something like--- (Int,Word) or (Int,Word,Word). I'm not exactly sure how--- big it would need to be to work correctly. Then you could--- handle deltas of two very far off days correctly, provided--- that the two days weren't also super far from each other.-----------------------------instance Torsor Date Int where- add i d = dayToDate (add i (dateToDay d))- difference a b = difference (dateToDay a) (dateToDay b)--instance Torsor OrdinalDate Int where- add i d = dayToOrdinalDate (add i (ordinalDateToDay d))- difference a b = difference (ordinalDateToDay a) (ordinalDateToDay b)--instance Enum Date where- fromEnum d = fromEnum (dateToDay d)- toEnum i = dayToDate (toEnum i)--instance Enum OrdinalDate where- fromEnum d = fromEnum (ordinalDateToDay d)- toEnum i = dayToOrdinalDate (toEnum i)--instance ToJSON Datetime where- toJSON = AE.String . encode_YmdHMS SubsecondPrecisionAuto hyphen- toEncoding x = AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderUtf8_YmdHMS SubsecondPrecisionAuto hyphen x SG.<> BB.char7 '"')--instance ToJSON Offset where- toJSON = AE.String . encodeOffset OffsetFormatColonOn- toEncoding x = AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderOffsetUtf8 OffsetFormatColonOn x SG.<> BB.char7 '"')--instance FromJSON Offset where- parseJSON = AE.withText "Offset" aesonParserOffset--instance ToJSONKey Offset where- toJSONKey = AE.ToJSONKeyText- (encodeOffset OffsetFormatColonOn)- (\x -> AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderOffsetUtf8 OffsetFormatColonOn x SG.<> BB.char7 '"'))--instance FromJSONKey Offset where- fromJSONKey = AE.FromJSONKeyTextParser aesonParserOffset--aesonParserOffset :: Text -> AET.Parser Offset-aesonParserOffset t = case decodeOffset OffsetFormatColonOn t of- Nothing -> fail "could not parse Offset"- Just x -> pure x---- | Holds all of the parts encoded by a 'Time'.--- Can be used for formatting if what is presently in the API--- does not suffice.-data TimeParts = TimeParts- { timePartsDay :: !Int -- ^ days 0-31- , timePartsMonth :: !Int -- ^ months 0-11- , timePartsYear :: !Int- , timePartsHour :: !Int -- ^ hours 0-23- , timePartsMinute :: !Int -- ^ minutes 0-59- , timePartsSecond :: !Int -- ^ seconds 0-59- , timePartsSubsecond :: !Int -- ^ fraction of a second with nanosecond resolution- , timePartsOffset :: !Int- }- deriving (Eq, Read, Show)---- | Deconstruct a 'Time' into its 'TimeParts'.-timeParts :: Offset -> Time -> TimeParts-timeParts o0 t0 =- let- OffsetDatetime (Datetime dt t) o = timeToOffsetDatetime o0 t0- Date y mo d = dt- TimeOfDay h mi s = t- (wholeSeconds, subsecond) = divMod s 100000000- in TimeParts- { timePartsDay = fromIntegral (getDayOfMonth d)- , timePartsMonth = fromIntegral (getMonth mo)- , timePartsYear = fromIntegral (getYear y)- , timePartsHour = h- , timePartsMinute = mi- , timePartsSecond = fromIntegral wholeSeconds- , timePartsSubsecond = fromIntegral subsecond- , timePartsOffset = getOffset o- }+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}++{- | Chronos is a performance-oriented time library for Haskell, with a+ straightforward API. The main differences between this+ and the <http://hackage.haskell.org/package/time time> library+ are:++ * Chronos uses machine integers where possible. This means+ that time-related arithmetic should be faster, with the+ drawback that the types are incapable of representing times+ that are very far in the future or the past (because Chronos+ provides nanosecond, rather than picosecond, resolution).+ For most users, this is not a hindrance.+ * Chronos provides 'ToJSON'/'FromJSON' instances for serialisation.+ * Chronos provides 'UVector.Unbox' instances for working with unboxed vectors.+ * Chronos provides 'Prim' instances for working with byte arrays/primitive arrays.+ * Chronos uses normal non-overloaded haskell functions for+ encoding and decoding time. It provides <http://hackage.haskell.org/package/attoparsec attoparsec> parsers for both 'Text' and+ 'ByteString'. Additionally, Chronos provides functions for+ encoding time to 'Text' or 'ByteString'. The <http://hackage.haskell.org/package/time time> library accomplishes these with the+ <http://hackage.haskell.org/package/time-1.9.3/docs/Data-Time-Format.html Data.Time.Format> module, which uses UNIX-style datetime+ format strings. The approach taken by Chronos is faster and+ catches more mistakes at compile time, at the cost of being+ less expressive.+-}+module Chronos+ ( -- * Functions++ -- ** Current+ now+ , today+ , tomorrow+ , yesterday+ , todayDayOfWeek+ , yesterdayDayOfWeek+ , tomorrowDayOfWeek+ , timeToDayOfWeek+ , epoch++ -- ** Duration+ , stopwatch+ , stopwatch_++ -- ** Construction+ , datetimeFromYmdhms+ , timeFromYmdhms++ -- ** Conversion+ , timeToDatetime+ , datetimeToTime+ , datetimeToDayOfWeek+ , dateToDayOfWeek+ , timeToOffsetDatetime+ , offsetDatetimeToTime+ , timeToDayTruncate+ , dayToTimeMidnight+ , dayToDate+ , dateToDay+ , dayToOrdinalDate+ , ordinalDateToDay+ , monthDateToDayOfYear+ , dayOfYearToMonthDay++ -- ** Build Timespan+ , second+ , minute+ , hour+ , day+ , week++ -- ** Matching+ , buildDayOfWeekMatch+ , buildMonthMatch+ , buildUnboxedMonthMatch+ , caseDayOfWeek+ , caseMonth+ , caseUnboxedMonth++ -- ** Format+ -- $format+ , w3c+ , slash+ , hyphen+ , compact+ , timeParts++ -- ** Months+ , january+ , february+ , march+ , april+ , may+ , june+ , july+ , august+ , september+ , october+ , november+ , december++ -- ** Days of Week+ , sunday+ , monday+ , tuesday+ , wednesday+ , thursday+ , friday+ , saturday++ -- ** Utility+ , daysInMonth+ , isLeapYear+ , observedOffsets+ , sinceEpoch+ , asSeconds++ -- * Textual Conversion++ -- ** Date++ -- *** Text+ , builder_Ymd+ , builder_Dmy+ , builder_HMS+ , parser_Ymd+ , parser_Ymd_lenient+ , parser_Mdy+ , parser_Mdy_lenient+ , parser_Dmy+ , parser_Dmy_lenient++ -- *** UTF-8 ByteString+ , builderUtf8_Ymd+ , parserUtf8_Ymd++ -- ** Time of Day++ -- *** Text+ , builder_IMS_p+ , builder_IMSp+ , parser_HMS+ , parser_HMS_opt_S++ -- *** UTF-8 ByteString+ , builderUtf8_HMS+ , builderUtf8_IMS_p+ , builderUtf8_IMSp+ , parserUtf8_HMS+ , parserUtf8_HMS_opt_S+ , zeptoUtf8_HMS++ -- ** Datetime++ -- *** Text+ , builder_DmyHMS+ , builder_DmyIMSp+ , builder_DmyIMS_p+ , builder_YmdHMS+ , builder_YmdIMSp+ , builder_YmdIMS_p+ , builderW3C+ , builderIso8601+ , encodeIso8601+ , encode_Ymd+ , encode_Dmy+ , encode_DmyHMS+ , encode_DmyIMS_p+ , encode_YmdHMS+ , encode_YmdIMS_p+ , parser_DmyHMS+ , parser_DmyHMS_lenient+ , parser_YmdHMS+ , parser_YmdHMS_lenient+ , parser_YmdHMS_opt_S+ , parser_YmdHMS_opt_S_lenient+ , parser_DmyHMS_opt_S+ , parser_DmyHMS_opt_S_lenient+ , parser_MdyHMS+ , parser_MdyHMS_lenient+ , parser_MdyHMS_opt_S+ , parser_MdyHMS_opt_S_lenient+ , parser_lenient+ , decode_DmyHMS+ , decode_DmyHMS_lenient+ , decode_MdyHMS+ , decode_MdyHMS_lenient+ , decode_MdyHMS_opt_S+ , decode_MdyHMS_opt_S_lenient+ , decode_YmdHMS+ , decode_YmdHMS_lenient+ , decode_YmdHMS_opt_S+ , decode_YmdHMS_opt_S_lenient+ , decode_DmyHMS_opt_S+ , decode_DmyHMS_opt_S_lenient+ , decode_lenient+ , decodeIso8601Zulu++ -- *** UTF-8 ByteString+ , encodeUtf8_YmdHMS+ , encodeUtf8_YmdIMS_p+ , builderUtf8_YmdHMS+ , builderUtf8_YmdIMSp+ , builderUtf8_YmdIMS_p+ , builderUtf8W3C+ , decodeUtf8_YmdHMS+ , decodeUtf8_YmdHMS_opt_S+ , parserUtf8_YmdHMS+ , parserUtf8_YmdHMS_opt_S+ , zeptoUtf8_YmdHMS++ -- *** UTF-8 Bytes+ , boundedBuilderUtf8BytesIso8601Zoneless+ , decodeUtf8BytesIso8601Zoneless+ , decodeUtf8BytesIso8601ZonelessSpaced++ -- *** Short Text+ , decodeShortTextIso8601Zulu+ , decodeShortTextIso8601Zoneless+ , encodeShortTextIso8601Zulu+ , encodeShortTextIso8601Zoneless++ -- ** Offset Datetime++ -- *** Text+ , encode_YmdHMSz+ , encode_DmyHMSz+ , builder_YmdHMSz+ , builder_DmyHMSz+ , parser_YmdHMSz+ , parser_DmyHMSz+ , builder_YmdIMS_p_z+ , builder_DmyIMS_p_z+ , builderW3Cz++ -- *** UTF-8 ByteString+ , builderUtf8_YmdHMSz+ , parserUtf8_YmdHMSz+ , builderUtf8_YmdIMS_p_z+ , builderUtf8W3Cz++ -- *** UTF-8 Bytes+ , parserUtf8BytesIso8601+ , boundedBuilderUtf8BytesIso8601+ , decodeUtf8BytesIso8601++ -- *** ShortText+ , decodeShortTextIso8601+ , encodeShortTextIso8601++ -- ** Offset++ -- *** Text+ , encodeOffset+ , builderOffset+ , decodeOffset+ , parserOffset++ -- *** UTF-8 ByteString+ , encodeOffsetUtf8+ , builderOffsetUtf8+ , decodeOffsetUtf8+ , parserOffsetUtf8++ -- ** Timespan++ -- *** Text+ , encodeTimespan+ , builderTimespan++ -- *** UTF-8 ByteString+ , encodeTimespanUtf8+ , builderTimespanUtf8++ -- ** TimeInterval+ , within+ , timeIntervalToTimespan+ , whole+ , singleton+ , lowerBound+ , upperBound+ , width+ , timeIntervalBuilder+ , (...)++ -- * Types+ , Day (..)+ , DayOfWeek (..)+ , DayOfMonth (..)+ , DayOfYear (..)+ , Month (..)+ , Year (..)+ , Offset (..)+ , Time (..)+ , DayOfWeekMatch (..)+ , MonthMatch (..)+ , UnboxedMonthMatch (..)+ , Timespan (..)+ , SubsecondPrecision (..)+ , Date (..)+ , OrdinalDate (..)+ , MonthDate (..)+ , Datetime (..)+ , OffsetDatetime (..)+ , TimeOfDay (..)+ , DatetimeFormat (..)+ , OffsetFormat (..)+ , DatetimeLocale (..)+ , MeridiemLocale (..)+ , TimeInterval (..)+ , TimeParts (..)++ -- * Lenses+ , _timeToDatetime+ , _datetimeToTime+ , _dayToDate+ , _dateToDay+ , _getDay+ , _getDayOfWeek+ , _getDayOfMonth+ , _getDayOfYear+ , _getMonth+ , _getOffset+ , _getTime+ , _getTimespan+ , _dateYear+ , _dateMonth+ , _dateDay+ , _ordinalDateYear+ , _ordinalDateDayOfYear+ , _monthDateMonth+ , _monthDateDay+ , _datetimeDate+ , _datetimeTime+ , _offsetDatetimeDatetime+ , _offsetDatetimeOffset+ , _timeOfDayHour+ , _timeOfDayMinute+ , _timeOfDayNanoseconds+ ) where++import Control.Applicative+import Control.DeepSeq (NFData (..), deepseq)+import Control.Exception (evaluate)+import Control.Monad+import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)+import Data.Attoparsec.Text (Parser)+import Data.Bool (bool)+import Data.ByteString (ByteString)+import Data.Bytes (Bytes)+import Data.Char (isDigit)+import Data.Foldable+import Data.Hashable (Hashable)+import Data.Int (Int64)+import Data.Primitive+import Data.Text (Text)+import Data.Text.Short (ShortText)+import Data.Vector (Vector)+import Data.Word (Word64, Word8)+import Foreign.Storable+import GHC.Clock (getMonotonicTimeNSec)+import GHC.Generics (Generic)+import Torsor++import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat+import qualified Data.Aeson as AE+import qualified Data.Aeson.Encoding as AEE+import qualified Data.Aeson.Key as AK+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.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.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.Bytes.Text.Utf8 as Utf8+import qualified Data.Semigroup as SG+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB+import qualified Data.Text.Read as Text+import qualified Data.Text.Short as TS+import qualified Data.Text.Short.Unsafe as TS+import qualified Data.Vector as Vector+import qualified Data.Vector.Generic as GVector+import qualified Data.Vector.Generic.Mutable as MGVector+import qualified Data.Vector.Primitive as PVector+import qualified Data.Vector.Unboxed as UVector++#ifdef mingw32_HOST_OS+import System.Win32.Time (SYSTEMTIME(..))+import qualified System.Win32.Time as W32+#else+import Chronos.Internal.CTimespec (getPosixNanoseconds)+#endif++{- $setup+>>> import Test.QuickCheck hiding (within)+>>> import Test.QuickCheck.Gen+>>> import Data.Maybe (isJust)+>>> :set -XStandaloneDeriving+>>> :set -XGeneralizedNewtypeDeriving+>>> :set -XScopedTypeVariables++>>> deriving instance Arbitrary Time+>>> :{+ instance Arbitrary TimeInterval where+ arbitrary = do+ t0 <- arbitrary+ t1 <- suchThat arbitrary (>= t0)+ pure (TimeInterval t0 t1)+ instance Arbitrary TimeOfDay where+ arbitrary = TimeOfDay+ <$> choose (0,23)+ <*> choose (0,59)+ <*> choose (0, 60000000000 - 1)+ instance Arbitrary Date where+ arbitrary = Date+ <$> fmap Year (choose (1800,2100))+ <*> fmap Month (choose (0,11))+ <*> fmap DayOfMonth (choose (1,28))+ instance Arbitrary Datetime where+ arbitrary = Datetime <$> arbitrary <*> arbitrary+ instance Arbitrary OffsetDatetime where+ arbitrary = OffsetDatetime <$> arbitrary <*> arbitrary+ instance Arbitrary DatetimeFormat where+ arbitrary = DatetimeFormat+ <$> arbitrary+ <*> elements [ Nothing, Just '/', Just ':', Just '-']+ <*> arbitrary+ instance Arbitrary OffsetFormat where+ arbitrary = arbitraryBoundedEnum+ shrink = genericShrink+ instance Arbitrary Offset where+ arbitrary = fmap Offset (choose ((-24) * 60, 24 * 60))+ instance Arbitrary SubsecondPrecision where+ arbitrary = frequency+ [ (1, pure SubsecondPrecisionAuto)+ , (1, SubsecondPrecisionFixed <$> choose (0,9))+ ]+ instance Arbitrary Day where+ arbitrary = fmap Day (choose (0,50000))+:}+-}++-- | A 'Timespan' representing a single second.+second :: Timespan+second = Timespan 1000000000++-- | A 'Timespan' representing a single minute.+minute :: Timespan+minute = Timespan 60000000000++-- | A 'Timespan' representing a single hour.+hour :: Timespan+hour = Timespan 3600000000000++-- | A 'Timespan' representing a single day.+day :: Timespan+day = Timespan 86400000000000++-- | A 'Timespan' representing a single week.+week :: Timespan+week = Timespan 604800000000000++{- | Convert 'Time' to 'Datetime'.++ prop> \(t :: Time) -> (datetimeToTime (timeToDatetime t)) == t+-}+timeToDatetime :: Time -> Datetime+timeToDatetime = utcTimeToDatetime . toUtc++{- | Convert 'Datetime' to 'Time'.++ prop> \(d :: Datetime) -> timeToDatetime (datetimeToTime d) == d+-}+datetimeToTime :: Datetime -> Time+datetimeToTime = fromUtc . datetimeToUtcTime++{- | A lens-compatible variant of half of the `timeToDatetime`/`datetimeToTime` isomorphism.++__Note__: We do not provide an iso as that requires a dependence on the `profunctor`+package.+-}+_timeToDatetime :: forall f. (Functor f) => (Datetime -> f Datetime) -> Time -> f Time+_timeToDatetime f = fmap datetimeToTime . f . timeToDatetime++{- | A lens-compatible variant of half of the `timeToDatetime`/`datetimeToTime` isomorphism.++__Note__: We do not provide an iso as that requires a dependence on the `profunctor`+package.+-}+_datetimeToTime :: forall f. (Functor f) => (Time -> f Time) -> Datetime -> f Datetime+_datetimeToTime f = fmap timeToDatetime . f . datetimeToTime++-- | Convert 'Datetime' to 'DayOfWeek'+datetimeToDayOfWeek :: Datetime -> DayOfWeek+datetimeToDayOfWeek (Datetime date _) = dateToDayOfWeek date++-- | Convert 'Date' to 'DayOfWeek'+dateToDayOfWeek :: Date -> DayOfWeek+dateToDayOfWeek (Date year month date) =+ let k = getDayOfMonth date+ m = ((getMonth month + 10) `mod` 12) + 1+ y = adjustedYear `mod` 100+ c = adjustedYear `div` 100+ adjustedYear = if m >= 11 then getYear year - 1 else getYear year+ in DayOfWeek $ (k + (floor $ ((2.6 :: Double) * fromIntegral m) - 0.2) - (2 * c) + y + (y `div` 4) + (c `div` 4)) `mod` 7++-- | Convert 'Time' to 'OffsetDatetime' by providing an 'Offset'.+timeToOffsetDatetime :: Offset -> Time -> OffsetDatetime+timeToOffsetDatetime offset = utcTimeToOffsetDatetime offset . toUtc++-- | Convert 'OffsetDatetime' to 'Time'.+offsetDatetimeToTime :: OffsetDatetime -> Time+offsetDatetimeToTime = fromUtc . offsetDatetimeToUtcTime++{- | Convert 'Time' to 'Day'. This function is lossy; consequently, it+ does not roundtrip with 'dayToTimeMidnight'.+-}+timeToDayTruncate :: Time -> Day+timeToDayTruncate (Time i) = Day (fromIntegral (div i 86400000000000) + 40587)++-- | Convert midnight of the given 'Day' to 'Time'.+dayToTimeMidnight :: Day -> Time+dayToTimeMidnight (Day d) = Time (fromIntegral (d - 40587) * 86400000000000)++{- | Convert 'Day' to a 'Date'.++ prop> \(d :: Day) -> dateToDay (dayToDate d) == d+-}+dayToDate :: Day -> Date+dayToDate theDay = Date year month dayOfMonth+ where+ OrdinalDate year yd = dayToOrdinalDate theDay+ MonthDate month dayOfMonth = dayOfYearToMonthDay (isLeapYear year) yd++{- | Convert a 'Date' to a 'Day'.++ prop> \(d :: Date) -> dayToDate (dateToDay d) == d+-}+dateToDay :: Date -> Day+dateToDay (Date y m d) =+ ordinalDateToDay $+ OrdinalDate+ y+ (monthDateToDayOfYear (isLeapYear y) (MonthDate m d))++{- | A lens-compatible variant of half of the `dayToDate`/`dateToDay` isomorphism.++__Note__: We do not provide an iso as that requires a dependence on the `profunctor`+package.+-}+_dayToDate :: forall f. (Functor f) => (Date -> f Date) -> Day -> f Day+_dayToDate f = fmap dateToDay . f . dayToDate++{- | A lens-compatible variant of half of the `dayToDate`/`dateToDay` isomorphism.++__Note__: We do not provide an iso as that requires a dependence on the `profunctor`+package.+-}+_dateToDay :: forall f. (Functor f) => (Day -> f Day) -> Date -> f Date+_dateToDay f = fmap dayToDate . f . dateToDay++{- | Construct a 'Datetime' from year, month, day, hour, minute, second:++ >>> datetimeFromYmdhms 2014 2 26 17 58 52+ Datetime {datetimeDate = Date {dateYear = Year {getYear = 2014}, dateMonth = Month {getMonth = 1}, dateDay = DayOfMonth {getDayOfMonth = 26}}, datetimeTime = TimeOfDay {timeOfDayHour = 17, timeOfDayMinute = 58, timeOfDayNanoseconds = 52000000000}}+-}+datetimeFromYmdhms ::+ -- | Year+ Int ->+ -- | Month+ Int ->+ -- | Day+ Int ->+ -- | Hour+ Int ->+ -- | Minute+ Int ->+ -- | Second+ Int ->+ Datetime+datetimeFromYmdhms y m d h m' s =+ Datetime+ ( Date+ (Year $ fromIntegral y)+ (Month mx)+ (DayOfMonth $ fromIntegral d)+ )+ ( TimeOfDay+ (fromIntegral h)+ (fromIntegral m')+ (fromIntegral s * 1000000000)+ )+ where+ mx =+ if m >= 1 && m <= 12+ then fromIntegral (m - 1)+ else 0++{- | Construct a 'Time' from year, month, day, hour, minute, second:++ >>> timeFromYmdhms 2014 2 26 17 58 52+ Time {getTime = 1393437532000000000}+-}+timeFromYmdhms ::+ -- | Year+ Int ->+ -- | Month+ Int ->+ -- | Day+ Int ->+ -- | Hour+ Int ->+ -- | Minute+ Int ->+ -- | Second+ Int ->+ Time+timeFromYmdhms y m d h m' s = datetimeToTime (datetimeFromYmdhms y m d h m' s)++{- | Gets the current 'Day'. This does not take the user\'s+ time zone into account.+-}+today :: IO Day+today = fmap timeToDayTruncate now++-- | Gets the 'Day' of tomorrow.+tomorrow :: IO Day+tomorrow = fmap (add 1 . timeToDayTruncate) now++-- | Gets the 'Day' of yesterday.+yesterday :: IO Day+yesterday = fmap (add (-1) . timeToDayTruncate) now++-- | Get the current time from the system clock.+now :: IO Time+#ifdef mingw32_HOST_OS+now = do+ SYSTEMTIME{..} <- W32.getSystemTime+ let date = Date+ { dateYear = Year (fromIntegral wYear)+ , dateMonth = Month (fromIntegral wMonth - 1)+ , dateDay = DayOfMonth (fromIntegral wDay)+ }+ let secNano = (fromIntegral wSecond :: Int64) * 1000000000+ msNano = (fromIntegral wMilliseconds :: Int64) * 1000000+ nano = secNano + msNano+ let time = TimeOfDay+ { timeOfDayHour = fromIntegral wHour+ , timeOfDayMinute = fromIntegral wMinute+ , timeOfDayNanoseconds = fromIntegral nano+ }+ let dt = Datetime date time+ pure $ datetimeToTime dt+#else+now = fmap Time getPosixNanoseconds+#endif++-- | Convert from 'Time' to 'DayOfWeek'.+timeToDayOfWeek :: Time -> DayOfWeek+timeToDayOfWeek (Time time) =+ DayOfWeek $+ (fromIntegral @Int64 @Int ((time `div` 86400000000000) + 4) `mod` 7)++-- | Get the current 'DayOfWeek' from the system clock.+todayDayOfWeek :: IO DayOfWeek+todayDayOfWeek = timeToDayOfWeek <$> now++-- | Get the yesterday\'s 'DayOfWeek' from the system clock.+yesterdayDayOfWeek :: IO DayOfWeek+yesterdayDayOfWeek =+ timeToDayOfWeek . (add (Timespan (-86400000000000))) <$> now++-- | Get the tomorrow\'s 'DayOfWeek' from the system clock.+tomorrowDayOfWeek :: IO DayOfWeek+tomorrowDayOfWeek =+ timeToDayOfWeek . (add (Timespan (86400000000000))) <$> now++-- | The Unix epoch, that is 1970-01-01 00:00:00.+epoch :: Time+epoch = Time 0++{- | Measures the time it takes to run an action and evaluate+ its result to WHNF. This measurement uses a monotonic clock+ instead of the standard system clock.+-}+stopwatch :: IO a -> IO (Timespan, a)+stopwatch action = do+ start <- getMonotonicTimeNSec+ a <- action >>= evaluate+ end <- getMonotonicTimeNSec+ pure ((Timespan (fromIntegral (end - start))), a)++{- | Measures the time it takes to run an action. The result+ is discarded. This measurement uses a monotonic clock+ instead of the standard system clock.+-}+stopwatch_ :: IO a -> IO Timespan+stopwatch_ action = do+ start <- getMonotonicTimeNSec+ _ <- action+ end <- getMonotonicTimeNSec+ pure (Timespan (fromIntegral (end - start)))++-- UtcTime. Used internally only.+data UtcTime+ = UtcTime+ {-# UNPACK #-} !Day -- day+ {-# UNPACK #-} !Int64 -- nanoseconds++toUtc :: Time -> UtcTime+toUtc (Time i) =+ let (d, t) = divMod i (getTimespan day)+ in UtcTime (add (fromIntegral d) epochDay) (fromIntegral t)++fromUtc :: UtcTime -> Time+fromUtc (UtcTime d ns') =+ Time $+ getTimespan $+ plus+ (scale (intToInt64 (difference d epochDay)) day)+ (if ns > day then day else ns)+ where+ ns = Timespan ns'++intToInt64 :: Int -> Int64+intToInt64 = fromIntegral++epochDay :: Day+epochDay = Day 40587++dayLengthInt64 :: Int64+dayLengthInt64 = getTimespan day++nanosecondsInMinute :: Int64+nanosecondsInMinute = 60000000000++-- | All UTC time offsets. See <https://en.wikipedia.org/wiki/List_of_UTC_time_offsets List of UTC time offsets>.+observedOffsets :: Vector Offset+observedOffsets =+ Vector.fromList $+ map+ Offset+ [ -1200+ , -1100+ , -1000+ , -930+ , -900+ , -800+ , -700+ , -600+ , -500+ , -400+ , -330+ , -300+ , -230+ , -200+ , -100+ , 0+ , 100+ , 200+ , 300+ , 330+ , 400+ , 430+ , 500+ , 530+ , 545+ , 600+ , 630+ , 700+ , 800+ , 845+ , 900+ , 930+ , 1000+ , 1030+ , 1100+ , 1200+ , 1245+ , 1300+ , 1345+ , 1400+ ]++{- | Compute the 'Timespan' between the given date and 'epoch'.++@since 1.1.6.0+-}+sinceEpoch :: Time -> Timespan+sinceEpoch t = difference t epoch++{- | Convert a 'Timespan' to its equivalent in seconds.++@since 1.1.6.0+-}+asSeconds :: Timespan -> Int64+asSeconds (Timespan t) = case second of+ Timespan s -> t `div` s++{- | The first argument in the resulting tuple in a day+ adjustment. It should be either -1, 0, or 1, as no+ offset should ever exceed 24 hours.+-}+offsetTimeOfDay :: Offset -> TimeOfDay -> (Int, TimeOfDay)+offsetTimeOfDay (Offset offset) (TimeOfDay h m s) =+ (dayAdjustment, TimeOfDay h'' m'' s)+ where+ (!dayAdjustment, !h'') = divMod h' 24+ (!hourAdjustment, !m'') = divMod m' 60+ m' = m + offset+ h' = h + hourAdjustment++nanosecondsSinceMidnightToTimeOfDay :: Int64 -> TimeOfDay+nanosecondsSinceMidnightToTimeOfDay ns =+ if ns >= dayLengthInt64+ then TimeOfDay 23 59 (nanosecondsInMinute + (ns - dayLengthInt64))+ else TimeOfDay h' m' ns'+ where+ (!mInt64, !ns') = quotRem ns nanosecondsInMinute+ !m = fromIntegral mInt64+ (!h', !m') = quotRem m 60++timeOfDayToNanosecondsSinceMidnight :: TimeOfDay -> Int64+timeOfDayToNanosecondsSinceMidnight (TimeOfDay h m ns) =+ fromIntegral h * 3600000000000 + fromIntegral m * 60000000000 + ns++-- datetimeToOffsetDatetime :: Offset -> Datetime -> OffsetDatetime+-- datetimeToOffsetDatetime offset++utcTimeToOffsetDatetime :: Offset -> UtcTime -> OffsetDatetime+utcTimeToOffsetDatetime offset (UtcTime (Day d) nanoseconds) =+ let (!dayAdjustment, !tod) = offsetTimeOfDay offset (nanosecondsSinceMidnightToTimeOfDay nanoseconds)+ !date = dayToDate (Day (d + dayAdjustment))+ in OffsetDatetime (Datetime date tod) offset++utcTimeToDatetime :: UtcTime -> Datetime+utcTimeToDatetime (UtcTime d nanoseconds) =+ let !tod = nanosecondsSinceMidnightToTimeOfDay nanoseconds+ !date = dayToDate d+ in Datetime date tod++datetimeToUtcTime :: Datetime -> UtcTime+datetimeToUtcTime (Datetime date timeOfDay) =+ UtcTime (dateToDay date) (timeOfDayToNanosecondsSinceMidnight timeOfDay)++offsetDatetimeToUtcTime :: OffsetDatetime -> UtcTime+offsetDatetimeToUtcTime (OffsetDatetime (Datetime date timeOfDay) (Offset off)) =+ let (!dayAdjustment, !tod) = offsetTimeOfDay (Offset $ negate off) timeOfDay+ !(Day !theDay) = dateToDay date+ in UtcTime+ (Day (theDay + dayAdjustment))+ (timeOfDayToNanosecondsSinceMidnight tod)++-- | Convert a 'MonthDate' to a 'DayOfYear'.+monthDateToDayOfYear ::+ -- | Is it a leap year?+ Bool ->+ MonthDate ->+ DayOfYear+monthDateToDayOfYear isLeap (MonthDate month@(Month m) (DayOfMonth dayOfMonth)) =+ DayOfYear ((div (367 * (fromIntegral m + 1) - 362) 12) + k + day')+ where+ day' = fromIntegral $ clip 1 (daysInMonth isLeap month) dayOfMonth+ k = if month < Month 2 then 0 else if isLeap then -1 else -2++-- | Convert an 'OrdinalDate' to a 'Day'.+ordinalDateToDay :: OrdinalDate -> Day+ordinalDateToDay (OrdinalDate year@(Year y') theDay) = Day mjd+ where+ y = y' - 1+ mjd =+ ( fromIntegral . getDayOfYear $+ (clip (DayOfYear 1) (if isLeapYear year then DayOfYear 366 else DayOfYear 365) theDay)+ )+ + (365 * y)+ + (div y 4)+ - (div y 100)+ + (div y 400)+ - 678576++{- | Is the 'Year' a leap year?++ >>> isLeapYear (Year 1996)+ True++ >>> isLeapYear (Year 2019)+ False+-}+isLeapYear :: Year -> Bool+isLeapYear (Year year) = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0))++-- | Convert a 'DayOfYear' to a 'MonthDate'.+dayOfYearToMonthDay ::+ -- | Is it a leap year?+ Bool ->+ DayOfYear ->+ MonthDate+dayOfYearToMonthDay isLeap dayOfYear =+ let (!doyUpperBound, !monthTable, !dayTable) =+ if isLeap+ then (DayOfYear 366, leapYearDayOfYearMonthTable, leapYearDayOfYearDayOfMonthTable)+ else (DayOfYear 365, normalYearDayOfYearMonthTable, normalYearDayOfYearDayOfMonthTable)+ DayOfYear clippedDay = clip (DayOfYear 1) doyUpperBound dayOfYear+ clippedDayInt = fromIntegral clippedDay :: Int+ month = UVector.unsafeIndex monthTable clippedDayInt+ theDay = UVector.unsafeIndex dayTable clippedDayInt+ in MonthDate month theDay++-- | Convert a 'Day' to an 'OrdinalDate'.+dayToOrdinalDate :: Day -> OrdinalDate+dayToOrdinalDate (Day mjd) = OrdinalDate (Year $ fromIntegral year) (DayOfYear $ fromIntegral yd)+ where+ a = (fromIntegral mjd :: Int64) + 678575+ quadcent = div a 146097+ b = mod a 146097+ cent = min (div b 36524) 3+ c = b - (cent * 36524)+ quad = div c 1461+ d = mod c 1461+ y = min (div d 365) 3+ yd = (d - (y * 365) + 1)+ year = quadcent * 400 + cent * 100 + quad * 4 + y + 1++{- $format++The formats provided is this module are language-agnostic.+To find meridiem formats and month formats, look in a+language-specific module.+-}++{- | The W3C 'DatetimeFormat'.++ >>> encode_YmdHMS SubsecondPrecisionAuto w3c (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))+ "2014-02-26T17:58:52"++ prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS w3c (encode_YmdHMS s w3c dt))+-}+w3c :: DatetimeFormat+w3c = DatetimeFormat (Just '-') (Just 'T') (Just ':')++{- | A 'DatetimeFormat' that separates the members of+ the 'Date' by slashes.++ >>> encode_YmdHMS SubsecondPrecisionAuto slash (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))+ "2014/02/26 17:58:52"++ prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS slash (encode_YmdHMS s slash dt))+-}+slash :: DatetimeFormat+slash = DatetimeFormat (Just '/') (Just ' ') (Just ':')++{- | A 'DatetimeFormat' that separates the members of+ the 'Date' by hyphens.++ >>> encode_YmdHMS SubsecondPrecisionAuto hyphen (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))+ "2014-02-26 17:58:52"++ prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS hyphen (encode_YmdHMS s hyphen dt))+-}+hyphen :: DatetimeFormat+hyphen = DatetimeFormat (Just '-') (Just ' ') (Just ':')++{- | A 'DatetimeFormat' with no separators, except for a+ `T` between the 'Date' and 'Time'.++ >>> encode_YmdHMS SubsecondPrecisionAuto compact (timeToDatetime (timeFromYmdhms 2014 2 26 17 58 52))+ "20140226T175852"++ prop> \(s :: SubsecondPrecision) (dt :: Datetime) -> isJust (decode_YmdHMS compact (encode_YmdHMS s compact dt))+-}+compact :: DatetimeFormat+compact = DatetimeFormat Nothing (Just 'T') Nothing++-- | Return the number of days in a given month.+daysInMonth ::+ -- | Is this a leap year?+ Bool ->+ -- | Month of year+ Month ->+ Int+daysInMonth isLeap m =+ if isLeap+ then caseMonth leapYearMonthLength m+ else caseMonth normalYearMonthLength m++leapYearMonthLength :: MonthMatch Int+leapYearMonthLength = buildMonthMatch 31 29 31 30 31 30 31 31 30 31 30 31++normalYearMonthLength :: MonthMatch Int+normalYearMonthLength = buildMonthMatch 31 28 31 30 31 30 31 31 30 31 30 31++leapYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth+leapYearDayOfYearDayOfMonthTable =+ UVector.fromList $+ (DayOfMonth 1 :) $+ concat+ [ enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 29)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ ]+{-# NOINLINE leapYearDayOfYearDayOfMonthTable #-}++normalYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth+normalYearDayOfYearDayOfMonthTable =+ UVector.fromList $+ (DayOfMonth 1 :) $+ concat+ [ enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 28)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 30)+ , enumFromTo (DayOfMonth 1) (DayOfMonth 31)+ ]+{-# NOINLINE normalYearDayOfYearDayOfMonthTable #-}++leapYearDayOfYearMonthTable :: UVector.Vector Month+leapYearDayOfYearMonthTable =+ UVector.fromList $+ (Month 0 :) $+ concat+ [ replicate 31 (Month 0)+ , replicate 29 (Month 1)+ , replicate 31 (Month 2)+ , replicate 30 (Month 3)+ , replicate 31 (Month 4)+ , replicate 30 (Month 5)+ , replicate 31 (Month 6)+ , replicate 31 (Month 7)+ , replicate 30 (Month 8)+ , replicate 31 (Month 9)+ , replicate 30 (Month 10)+ , replicate 31 (Month 11)+ ]+{-# NOINLINE leapYearDayOfYearMonthTable #-}++normalYearDayOfYearMonthTable :: UVector.Vector Month+normalYearDayOfYearMonthTable =+ UVector.fromList $+ (Month 0 :) $+ concat+ [ replicate 31 (Month 0)+ , replicate 28 (Month 1)+ , replicate 31 (Month 2)+ , replicate 30 (Month 3)+ , replicate 31 (Month 4)+ , replicate 30 (Month 5)+ , replicate 31 (Month 6)+ , replicate 31 (Month 7)+ , replicate 30 (Month 8)+ , replicate 31 (Month 9)+ , replicate 30 (Month 10)+ , replicate 31 (Month 11)+ ]+{-# NOINLINE normalYearDayOfYearMonthTable #-}++-- | Build a 'MonthMatch' from twelve (12) values.+buildMonthMatch :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> MonthMatch a+buildMonthMatch a b c d e f g h i j k l =+ MonthMatch (Vector.fromListN 12 [a, b, c, d, e, f, g, h, i, j, k, l])++-- | Match a 'Month' against a 'MonthMatch'.+caseMonth :: MonthMatch a -> Month -> a+caseMonth (MonthMatch v) (Month ix) = Vector.unsafeIndex v ix++-- | Build an 'UnboxedMonthMatch' from twelve (12) values.+buildUnboxedMonthMatch :: (UVector.Unbox a) => a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> UnboxedMonthMatch a+buildUnboxedMonthMatch a b c d e f g h i j k l =+ UnboxedMonthMatch (UVector.fromListN 12 [a, b, c, d, e, f, g, h, i, j, k, l])++-- | Match a 'Month' against an 'UnboxedMonthMatch'.+caseUnboxedMonth :: (UVector.Unbox a) => UnboxedMonthMatch a -> Month -> a+caseUnboxedMonth (UnboxedMonthMatch v) (Month ix) = UVector.unsafeIndex v ix++-- | Build a 'DayOfWeekMatch' from seven (7) values.+buildDayOfWeekMatch :: a -> a -> a -> a -> a -> a -> a -> DayOfWeekMatch a+buildDayOfWeekMatch a b c d e f g =+ DayOfWeekMatch (Vector.fromListN 7 [a, b, c, d, e, f, g])++-- | Match a 'DayOfWeek' against a 'DayOfWeekMatch'.+caseDayOfWeek :: DayOfWeekMatch a -> DayOfWeek -> a+caseDayOfWeek (DayOfWeekMatch v) (DayOfWeek ix) = Vector.unsafeIndex v ix++{- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder'+ corresponding to Year\/Month\/Day encoding.+-}+builder_Ymd :: Maybe Char -> Date -> TB.Builder+builder_Ymd msep (Date y m d) = case msep of+ Nothing ->+ yearToZeroPaddedDigit y+ <> monthToZeroPaddedDigit m+ <> zeroPadDayOfMonth d+ Just sep ->+ let sepBuilder = TB.singleton sep+ in yearToZeroPaddedDigit y+ <> sepBuilder+ <> monthToZeroPaddedDigit m+ <> sepBuilder+ <> zeroPadDayOfMonth d++{- | Given a 'Date' and a separator, construct a 'Text.Text'+ corresponding to a Year\/Month\/Day encoding.++ >>> encode_Ymd (Just ':') (Date (Year 2022) january (DayOfMonth 13))+ "2022:01:13"+-}+encode_Ymd :: Maybe Char -> Date -> Text+encode_Ymd msep = LT.toStrict . TB.toLazyText . builder_Ymd msep++{- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder'+ corresponding to a Day\/Month\/Year encoding.+-}+builder_Dmy :: Maybe Char -> Date -> TB.Builder+builder_Dmy msep (Date y m d) = case msep of+ Nothing ->+ zeroPadDayOfMonth d+ <> monthToZeroPaddedDigit m+ <> yearToZeroPaddedDigit y+ Just sep ->+ let sepBuilder = TB.singleton sep+ in zeroPadDayOfMonth d+ <> sepBuilder+ <> monthToZeroPaddedDigit m+ <> sepBuilder+ <> yearToZeroPaddedDigit y++{- | Given a 'Date' and a separator, construct a 'Text.Text'+ corresponding to a Day\/Month\/Year encoding.++ >>> encode_Dmy (Just ':') (Date (Year 2022) january (DayOfMonth 13))+ "13:01:2022"+-}+encode_Dmy :: Maybe Char -> Date -> Text+encode_Dmy msep = LT.toStrict . TB.toLazyText . builder_Dmy msep++{- | Parse a Year\/Month\/Day-encoded 'Date' that uses the+ given separator.+-}+parser_Ymd :: Maybe Char -> Parser Date+parser_Ymd msep = do+ y <- parseFixedDigits 4+ traverse_ AT.char msep+ m <- parseFixedDigits 2+ when (m < 1 || m > 12) (fail "month must be between 1 and 12")+ traverse_ AT.char msep+ d <- parseFixedDigits 2+ when (d < 1 || d > 31) (fail "day must be between 1 and 31")+ pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))++{- | Parse a Year\/Month\/Day-encoded 'Date' that either has no separators or+ uses any non-numeric character for each separator.+-}+parser_Ymd_lenient :: Parser Date+parser_Ymd_lenient = do+ y <- parseFixedDigits 4+ sep1 <- optional parserLenientSeparator+ m <- parseFixedDigits 2+ when (m < 1 || m > 12) (fail "month must be between 1 and 12")+ sep2 <- optional parserLenientSeparator+ d <- parseFixedDigits 2+ when (d < 1 || d > 31) (fail "day must be between 1 and 31")+ case (sep1, sep2) of+ (Nothing, Just _) -> fail "Separators must all exist or not"+ (Just _, Nothing) -> fail "Separators must all exist or not"+ _ -> pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))++{- | Parse a Month\/Day\/Year-encoded 'Date' that uses the+ given separator.+-}+parser_Mdy :: Maybe Char -> Parser Date+parser_Mdy msep = do+ m <- parseFixedDigits 2+ when (m < 1 || m > 12) (fail "month must be between 1 and 12")+ traverse_ AT.char msep+ d <- parseFixedDigits 2+ when (d < 1 || d > 31) (fail "day must be between 1 and 31")+ traverse_ AT.char msep+ y <- parseFixedDigits 4+ pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))++{- | Parse a Month\/Day\/Year-encoded 'Date' that either has no separators or+uses any non-numeric character for each separator.+-}+parser_Mdy_lenient :: Parser Date+parser_Mdy_lenient = do+ m <- parseFixedDigits 2+ when (m < 1 || m > 12) (fail "month must be between 1 and 12")+ sep1 <- optional parserLenientSeparator+ d <- parseFixedDigits 2+ when (d < 1 || d > 31) (fail "day must be between 1 and 31")+ sep2 <- optional parserLenientSeparator+ y <- parseFixedDigits 4+ case (sep1, sep2) of+ (Nothing, Just _) -> fail "Separators must all exist or not"+ (Just _, Nothing) -> fail "Separators must all exist or not"+ _ -> pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))++{- | Parse a Day\/Month\/Year-encoded 'Date' that uses the+ given separator.+-}+parser_Dmy :: Maybe Char -> Parser Date+parser_Dmy msep = do+ d <- parseFixedDigits 2+ when (d < 1 || d > 31) (fail "day must be between 1 and 31")+ traverse_ AT.char msep+ m <- parseFixedDigits 2+ when (m < 1 || m > 12) (fail "month must be between 1 and 12")+ traverse_ AT.char msep+ y <- parseFixedDigits 4+ pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))++{- | Parse a Day\/Month\/Year-encoded 'Date' that either has no separators or+ uses any non-numeric character for each separator.+-}+parser_Dmy_lenient :: Parser Date+parser_Dmy_lenient = do+ d <- parseFixedDigits 2+ when (d < 1 || d > 31) (fail "day must be between 1 and 31")+ sep1 <- optional parserLenientSeparator+ m <- parseFixedDigits 2+ when (m < 1 || m > 12) (fail "month must be between 1 and 12")+ sep2 <- optional parserLenientSeparator+ y <- parseFixedDigits 4+ case (sep1, sep2) of+ (Nothing, Just _) -> fail "Separators must all exist or not"+ (Just _, Nothing) -> fail "Separators must all exist or not"+ _ -> pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))++{- | Given a 'Date' and a separator, construct a 'ByteString' 'BB.Builder'+ corresponding to a Day\/Month\/Year encoding.+-}+builderUtf8_Ymd :: Maybe Char -> Date -> BB.Builder+builderUtf8_Ymd msep (Date y m d) = case msep of+ Nothing ->+ yearToZeroPaddedDigitBS y+ <> monthToZeroPaddedDigitBS m+ <> zeroPadDayOfMonthBS d+ Just sep ->+ let sepBuilder = BB.char7 sep+ in yearToZeroPaddedDigitBS y+ <> sepBuilder+ <> monthToZeroPaddedDigitBS m+ <> sepBuilder+ <> zeroPadDayOfMonthBS d++{- | Parse a Year\/Month\/Day-encoded 'Date' that uses the+ given separator.+-}+parserUtf8_Ymd :: Maybe Char -> AB.Parser Date+parserUtf8_Ymd msep = do+ y <- parseFixedDigitsIntBS 4+ traverse_ AB.char msep+ m <- parseFixedDigitsIntBS 2+ when (m < 1 || m > 12) (fail "month must be between 1 and 12")+ traverse_ AB.char msep+ d <- parseFixedDigitsIntBS 2+ when (d < 1 || d > 31) (fail "day must be between 1 and 31")+ pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))++{- | Given a 'SubsecondPrecision' and a separator, construct a+ 'Text' 'TB.Builder' corresponding to an Hour\/Minute\/Second+ encoding.+-}+builder_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder+builder_HMS sp msep (TimeOfDay h m ns) =+ indexTwoDigitTextBuilder h+ <> internalBuilder_NS sp msep m ns++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator,+ construct a 'Text' 'TB.Builder' according to an IMS encoding.++ This differs from 'builder_IMSp' in that their is a space+ between the seconds and locale.+-}+builder_IMS_p :: MeridiemLocale Text -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder+builder_IMS_p meridiemLocale sp msep (TimeOfDay h m ns) =+ internalBuilder_I h+ <> internalBuilder_NS sp msep m ns+ <> " "+ <> internalBuilder_p meridiemLocale h++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator,+ construct a 'Text' 'TB.Builder' according to an IMS encoding.+-}+builder_IMSp :: MeridiemLocale Text -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder+builder_IMSp meridiemLocale sp msep (TimeOfDay h m ns) =+ internalBuilder_I h+ <> internalBuilder_NS sp msep m ns+ <> internalBuilder_p meridiemLocale h++internalBuilder_I :: Int -> TB.Builder+internalBuilder_I h =+ indexTwoDigitTextBuilder $+ if h > 12+ then h - 12+ else+ if h == 0+ then 12+ else h++internalBuilder_p :: MeridiemLocale Text -> Int -> TB.Builder+internalBuilder_p (MeridiemLocale am pm) h =+ if h > 11+ then TB.fromText pm+ else TB.fromText am++{- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that uses+ the given separator.+-}+parser_HMS :: Maybe Char -> Parser TimeOfDay+parser_HMS msep = do+ h <- parseFixedDigits 2+ when (h > 23) (fail "hour must be between 0 and 23")+ traverse_ AT.char msep+ m <- parseFixedDigits 2+ when (m > 59) (fail "minute must be between 0 and 59")+ traverse_ AT.char msep+ ns <- parseSecondsAndNanoseconds+ pure (TimeOfDay h m ns)++parserLenientSeparator :: Parser ()+parserLenientSeparator = AT.satisfy (not . isDigit) *> pure ()++{- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that either has no+ separators or uses any given non-numeric character for each separator.+-}+parser_HMS_lenient :: Parser TimeOfDay+parser_HMS_lenient = do+ h <- parseFixedDigits 2+ when (h > 23) (fail "hour must be between 0 and 23")+ parserLenientSeparator+ m <- parseFixedDigits 2+ when (m > 59) (fail "minute must be between 0 and 59")+ parserLenientSeparator+ ns <- parseSecondsAndNanoseconds+ pure (TimeOfDay h m ns)++{- | Parses text that is formatted as either of the following:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+parser_HMS_opt_S :: Maybe Char -> Parser TimeOfDay+parser_HMS_opt_S msep = do+ h <- parseFixedDigits 2+ when (h > 23) (fail "hour must be between 0 and 23")+ traverse_ AT.char msep+ m <- parseFixedDigits 2+ when (m > 59) (fail "minute must be between 0 and 59")+ mc <- AT.peekChar+ case mc of+ Nothing -> pure (TimeOfDay h m 0)+ Just c -> case msep of+ Just sep ->+ if c == sep+ then do+ _ <- AT.anyChar -- should be the separator+ ns <- parseSecondsAndNanoseconds+ pure (TimeOfDay h m ns)+ else pure (TimeOfDay h m 0)+ -- if there is no separator, we will try to parse the+ -- remaining part as seconds. We commit to trying to+ -- parse as seconds if we see any number as the next+ -- character.+ Nothing ->+ if isDigit c+ then do+ ns <- parseSecondsAndNanoseconds+ pure (TimeOfDay h m ns)+ else pure (TimeOfDay h m 0)++{- | Parses text that is formatted as either of the following with either no+separators or any non-numeric characters for each separator:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+parser_HMS_opt_S_lenient :: Parser TimeOfDay+parser_HMS_opt_S_lenient = do+ h <- parseFixedDigits 2+ when (h > 23) (fail "hour must be between 0 and 23")+ parserLenientSeparator+ m <- parseFixedDigits 2+ when (m > 59) (fail "minute must be between 0 and 59")+ mc <- AT.peekChar+ case mc of+ Nothing -> pure (TimeOfDay h m 0)+ Just c | not (isDigit c) -> do+ _ <- AT.anyChar -- should be the separator+ ns <- parseSecondsAndNanoseconds+ pure (TimeOfDay h m ns)+ Just _ -> do+ ns <- parseSecondsAndNanoseconds+ pure (TimeOfDay h m ns)++parseSecondsAndNanoseconds :: Parser Int64+parseSecondsAndNanoseconds = do+ s' <- parseFixedDigits 2+ let s = fromIntegral s' :: Int64+ when (s > 60) (fail "seconds must be between 0 and 60")+ nanoseconds <-+ ( do+ _ <- AT.char '.'+ numberOfZeroes <- countZeroes+ 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)++countZeroes :: AT.Parser Int+countZeroes = go 0+ where+ go !i = do+ m <- AT.peekChar+ case m of+ Nothing -> pure i+ Just c ->+ if c == '0'+ then AT.anyChar *> go (i + 1)+ else pure i++nanosecondsBuilder :: Int64 -> TB.Builder+nanosecondsBuilder w+ | w == 0 = mempty+ | w > 99999999 = "." <> TB.decimal w+ | w > 9999999 = ".0" <> TB.decimal w+ | w > 999999 = ".00" <> TB.decimal w+ | w > 99999 = ".000" <> TB.decimal w+ | w > 9999 = ".0000" <> TB.decimal w+ | w > 999 = ".00000" <> TB.decimal w+ | w > 99 = ".000000" <> TB.decimal w+ | w > 9 = ".0000000" <> TB.decimal w+ | otherwise = ".00000000" <> TB.decimal w++microsecondsBuilder :: Int64 -> TB.Builder+microsecondsBuilder w+ | w == 0 = mempty+ | w > 99999 = "." <> TB.decimal w+ | w > 9999 = ".0" <> TB.decimal w+ | w > 999 = ".00" <> TB.decimal w+ | w > 99 = ".000" <> TB.decimal w+ | w > 9 = ".0000" <> TB.decimal w+ | otherwise = ".00000" <> TB.decimal w++millisecondsBuilder :: Int64 -> TB.Builder+millisecondsBuilder w+ | w == 0 = mempty+ | w > 99 = "." <> TB.decimal w+ | w > 9 = ".0" <> TB.decimal w+ | otherwise = ".00" <> TB.decimal w++prettyNanosecondsBuilder :: SubsecondPrecision -> Int64 -> TB.Builder+prettyNanosecondsBuilder sp nano = case sp of+ SubsecondPrecisionAuto+ | milliRem == 0 -> millisecondsBuilder milli+ | microRem == 0 -> microsecondsBuilder micro+ | otherwise -> nanosecondsBuilder nano+ SubsecondPrecisionFixed d ->+ if d == 0+ then mempty+ else+ let newSubsecondPart = quot nano (raiseTenTo (9 - d))+ in "."+ <> TB.fromText (Text.replicate (d - countDigits newSubsecondPart) "0")+ <> TB.decimal newSubsecondPart+ where+ (milli, milliRem) = quotRem nano 1000000+ (micro, microRem) = quotRem nano 1000++-- | Encode a 'Timespan' as 'Text' using the given 'SubsecondPrecision'.+encodeTimespan :: SubsecondPrecision -> Timespan -> Text+encodeTimespan sp =+ LT.toStrict . TB.toLazyText . builderTimespan sp++{- | Construct a 'Text' 'TB.Builder' corresponding to an encoding+ of the given 'Timespan' using the given 'SubsecondPrecision'.+-}+builderTimespan :: SubsecondPrecision -> Timespan -> TB.Builder+builderTimespan sp (Timespan ns) =+ TB.decimal sInt64 <> prettyNanosecondsBuilder sp nsRemainder+ where+ (!sInt64, !nsRemainder) = quotRem ns 1000000000++internalBuilder_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> TB.Builder+internalBuilder_NS sp msep m ns = case msep of+ Nothing ->+ indexTwoDigitTextBuilder m+ <> indexTwoDigitTextBuilder s+ <> prettyNanosecondsBuilder sp nsRemainder+ Just sep ->+ let sepBuilder = TB.singleton sep+ in sepBuilder+ <> indexTwoDigitTextBuilder m+ <> sepBuilder+ <> indexTwoDigitTextBuilder s+ <> prettyNanosecondsBuilder sp nsRemainder+ where+ (!sInt64, !nsRemainder) = quotRem ns 1000000000+ !s = fromIntegral sInt64++{- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct a+ 'Text' 'TB.Builder' corresponding to a+ Day\/Month\/Year,Hour\/Minute\/Second encoding of the given 'Datetime'.+-}+builder_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder+builder_DmyHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ case msep of+ Nothing ->+ builder_Dmy mdateSep date+ <> builder_HMS sp mtimeSep time+ Just sep ->+ builder_Dmy mdateSep date+ <> TB.singleton sep+ <> builder_HMS sp mtimeSep time++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision',+ and a 'DatetimeFormat', construct a 'Text' 'TB.Builder'+ corresponding to a Day\/Month\/Year,IMS encoding of the given+ 'Datetime'. This differs from 'builder_DmyIMSp' in that+ it adds a space between the locale and seconds.+-}+builder_DmyIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder+builder_DmyIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ builder_Dmy mdateSep date+ <> maybe mempty TB.singleton msep+ <> builder_IMS_p locale sp mtimeSep time++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision',+ and a 'DatetimeFormat', construct a 'Text' 'TB.Builder'+ corresponding to a Day\/Month\/Year,IMS encoding of the given+ 'Datetime'.+-}+builder_DmyIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder+builder_DmyIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ builder_Dmy mdateSep date+ <> maybe mempty TB.singleton msep+ <> builder_IMS_p locale sp mtimeSep time++{- | Given a 'SubsecondPrecision' and 'DatetimeFormat', construct+ 'Text' that corresponds to a Day\/Month\/Year,Hour\/Minute\/Second+ encoding of the given 'Datetime'.+-}+encode_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text+encode_DmyHMS sp format =+ LT.toStrict . TB.toLazyText . builder_DmyHMS sp format++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a+ 'DatetimeFormat', construct 'Text' that corresponds to a+ Day\/Month\/Year,IMS encoding of the given 'Datetime'. This+ inserts a space between the locale and seconds.+-}+encode_DmyIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text+encode_DmyIMS_p a sp b = LT.toStrict . TB.toLazyText . builder_DmyIMS_p a sp b++{- | Given a 'SubsecondPrecision' and 'DatetimeFormat', construct+ 'Text' that corresponds to a Year\/Month\/Day,Hour\/Minute\/Second+ encoding of the given 'Datetime'.+-}+encode_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text+encode_YmdHMS sp format =+ LT.toStrict . TB.toLazyText . builder_YmdHMS sp format++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a+ 'DatetimeFormat', construct 'Text' that corresponds to a+ Year\/Month\/Day,IMS encoding of the given 'Datetime'. This+ inserts a space between the locale and seconds.+-}+encode_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text+encode_YmdIMS_p a sp b = LT.toStrict . TB.toLazyText . builder_YmdIMS_p a sp b++{- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct+ a 'Text' 'TB.Builder' corresponding to a+ Year\/Month\/Day,Hour\/Minute\/Second encoding of the given 'Datetime'.+-}+builder_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder+builder_YmdHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ case msep of+ Nothing ->+ builder_Ymd mdateSep date+ <> builder_HMS sp mtimeSep time+ Just sep ->+ builder_Ymd mdateSep date+ <> TB.singleton sep+ <> builder_HMS sp mtimeSep time++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a+ 'DatetimeFormat', construct a 'Text' 'TB.Builder' that+ corresponds to a Year\/Month\/Day,IMS encoding of the+ given 'Datetime'. This inserts a space between the locale+ and seconds.+-}+builder_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder+builder_YmdIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ builder_Ymd mdateSep date+ <> maybe mempty TB.singleton msep+ <> builder_IMS_p locale sp mtimeSep time++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a+ 'DatetimeFormat', construct a 'Text' 'TB.Builder' that+ corresponds to a Year\/Month\/Day,IMS encoding of the+ given 'Datetime'.+-}+builder_YmdIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder+builder_YmdIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ builder_Ymd mdateSep date+ <> maybe mempty TB.singleton msep+ <> builder_IMS_p locale sp mtimeSep time++{- | Construct a 'Text' 'TB.Builder' corresponding to the W3C+ encoding of the given 'Datetime'.++ Deprecated. This is just a poorly named alias for 'builderIso8601'.+-}+builderW3C :: Datetime -> TB.Builder+builderW3C = builderIso8601++{- | Construct a 'Text' 'TB.Builder' corresponding to the ISO-8601+ encoding of the given 'Datetime'.+-}+builderIso8601 :: Datetime -> TB.Builder+builderIso8601 = builder_YmdHMS SubsecondPrecisionAuto w3c++{- | Construct 'Text' corresponding to the ISO-8601+ encoding of the given 'Datetime'.++ >>> encodeIso8601 (datetimeFromYmdhms 2014 2 26 17 58 52)+ "2014-02-26T17:58:52"+-}+encodeIso8601 :: Datetime -> Text+encodeIso8601 = LT.toStrict . TB.toLazyText . builderIso8601++{- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime'+ from 'Text' that was encoded with the given 'DatetimeFormat'.+-}+decode_YmdHMS :: DatetimeFormat -> Text -> Maybe Datetime+decode_YmdHMS format =+ either (const Nothing) Just . AT.parseOnly (parser_YmdHMS format)++{- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with either no separators or any non-numeric+ character for each separator.+-}+decode_YmdHMS_lenient :: Text -> Maybe Datetime+decode_YmdHMS_lenient =+ either (const Nothing) Just . AT.parseOnly parser_YmdHMS_lenient++{- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime'+ that was encoded with the given 'DatetimeFormat'.+-}+parser_DmyHMS :: DatetimeFormat -> Parser Datetime+parser_DmyHMS (DatetimeFormat mdateSep msep mtimeSep) = do+ date <- parser_Dmy mdateSep+ traverse_ AT.char msep+ time <- parser_HMS mtimeSep+ pure (Datetime date time)++{- | Parses text that is formatted as either of the following:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+parser_DmyHMS_opt_S :: DatetimeFormat -> Parser Datetime+parser_DmyHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do+ date <- parser_Dmy mdateSep+ traverse_ AT.char msep+ time <- parser_HMS_opt_S mtimeSep+ pure (Datetime date time)++{- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with either no separators or any non-numeric+ character for each separator, such as:++01-05-2017T23:13:05+01-05-2017 23:13:05+01/05/2017 23:13:05+01y01/2018x23;50&29+-}+parser_DmyHMS_lenient :: Parser Datetime+parser_DmyHMS_lenient = do+ mdate <- optional $ parser_Dmy Nothing+ case mdate of+ Just date -> Datetime date <$> parser_HMS Nothing+ Nothing -> Datetime <$> parser_Dmy_lenient <* parserLenientSeparator <*> parser_HMS_lenient++{- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with either no separators or any non-numeric+ character for each separator and with either of the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+parser_DmyHMS_opt_S_lenient :: Parser Datetime+parser_DmyHMS_opt_S_lenient = do+ mdate <- optional $ parser_Dmy Nothing+ case mdate of+ Just date -> Datetime date <$> parser_HMS_opt_S Nothing+ Nothing -> Datetime <$> parser_Dmy_lenient <* parserLenientSeparator <*> parser_HMS_opt_S_lenient++{- | Decodes Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+'Text' that is encoded with either no separators or any non-numeric+characters as separators, such as:++2017-01-05T23:13:05+2017-01-05 23:13:05+2017/01/05 23:13:05+2018x01y01/23;50&29+-}+decode_DmyHMS_lenient :: Text -> Maybe Datetime+decode_DmyHMS_lenient = either (const Nothing) Just . AT.parseOnly parser_DmyHMS_lenient++{- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime'+ from 'Text' that was encoded with the given 'DatetimeFormat'.+-}+decode_DmyHMS :: DatetimeFormat -> Text -> Maybe Datetime+decode_DmyHMS format =+ either (const Nothing) Just . AT.parseOnly (parser_DmyHMS format)++{- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with with the given 'DatetimeFormat' and with+ either of the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+decode_DmyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime+decode_DmyHMS_opt_S format =+ either (const Nothing) Just . AT.parseOnly (parser_DmyHMS_opt_S format)++{- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with either no separators or any non-numeric+ character for each separator and with either of the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+decode_DmyHMS_opt_S_lenient :: Text -> Maybe Datetime+decode_DmyHMS_opt_S_lenient =+ either (const Nothing) Just . AT.parseOnly parser_DmyHMS_opt_S_lenient++{- | Parses a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime'+ that was encoded using the given 'DatetimeFormat'.+-}+parser_MdyHMS :: DatetimeFormat -> Parser Datetime+parser_MdyHMS (DatetimeFormat mdateSep msep mtimeSep) = do+ date <- parser_Mdy mdateSep+ traverse_ AT.char msep+ time <- parser_HMS mtimeSep+ pure (Datetime date time)++{- | Parses a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' that was+ encoded with either no separators or any non-numeric character for each+ separator.+-}+parser_MdyHMS_lenient :: Parser Datetime+parser_MdyHMS_lenient = do+ mdate <- optional $ parser_Mdy Nothing+ case mdate of+ Just date -> Datetime date <$> parser_HMS Nothing+ Nothing -> Datetime <$> parser_Mdy_lenient <* parserLenientSeparator <*> parser_HMS_lenient++{- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with with the given 'DatetimeFormat' and with+ either of the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero.+-}+parser_MdyHMS_opt_S :: DatetimeFormat -> Parser Datetime+parser_MdyHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do+ date <- parser_Mdy mdateSep+ traverse_ AT.char msep+ time <- parser_HMS_opt_S mtimeSep+ pure (Datetime date time)++{- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with either no separators or any non-numeric+ character for each separator and with either of the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero.+-}+parser_MdyHMS_opt_S_lenient :: Parser Datetime+parser_MdyHMS_opt_S_lenient = do+ mdate <- optional $ parser_Mdy Nothing+ case mdate of+ Just date -> Datetime date <$> parser_HMS_opt_S Nothing+ Nothing -> Datetime <$> parser_Mdy_lenient <* parserLenientSeparator <*> parser_HMS_opt_S_lenient++{- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime'+ from 'Text' that was encoded with the given 'DatetimeFormat'.+-}+decode_MdyHMS :: DatetimeFormat -> Text -> Maybe Datetime+decode_MdyHMS format =+ either (const Nothing) Just . AT.parseOnly (parser_MdyHMS format)++{- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' with either no separators or any non-numeric character for each+ separator.+-}+decode_MdyHMS_lenient :: Text -> Maybe Datetime+decode_MdyHMS_lenient =+ either (const Nothing) Just . AT.parseOnly parser_MdyHMS_lenient++{- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with the given 'DatetimeFormat' and with either of+ the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero.+-}+decode_MdyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime+decode_MdyHMS_opt_S format =+ either (const Nothing) Just . AT.parseOnly (parser_MdyHMS_opt_S format)++{- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' with either no separators or any non-numeric character for each+ separator and with either of the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero.+-}+decode_MdyHMS_opt_S_lenient :: Text -> Maybe Datetime+decode_MdyHMS_opt_S_lenient =+ either (const Nothing) Just . AT.parseOnly parser_MdyHMS_opt_S_lenient++{- | Parses a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime'+ that was encoded using the given 'DatetimeFormat'.+-}+parser_YmdHMS :: DatetimeFormat -> Parser Datetime+parser_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do+ date <- parser_Ymd mdateSep+ traverse_ AT.char msep+ time <- parser_HMS mtimeSep+ pure (Datetime date time)++{- | Parses a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' that was+ encoded with either no separators or any non-numeric character for each+ separator.+-}+parser_YmdHMS_lenient :: Parser Datetime+parser_YmdHMS_lenient = do+ mdate <- optional $ parser_Ymd Nothing+ case mdate of+ Just date -> Datetime date <$> parser_HMS Nothing+ Nothing -> Datetime <$> parser_Ymd_lenient <* parserLenientSeparator <*> parser_HMS_lenient++{- | Parses a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with the given 'DatetimeFormat' and with either of+ the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+parser_YmdHMS_opt_S :: DatetimeFormat -> Parser Datetime+parser_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do+ date <- parser_Ymd mdateSep+ traverse_ AT.char msep+ time <- parser_HMS_opt_S mtimeSep+ pure (Datetime date time)++{- | Parses a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with either no separators or any non-numeric+ character for each separator and with either of the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+parser_YmdHMS_opt_S_lenient :: Parser Datetime+parser_YmdHMS_opt_S_lenient = do+ mdate <- optional $ parser_Ymd Nothing+ case mdate of+ Just date -> Datetime date <$> parser_HMS_opt_S Nothing+ Nothing -> Datetime <$> parser_Ymd_lenient <* parserLenientSeparator <*> parser_HMS_opt_S_lenient++{- | Decode a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with the given 'DatetimeFormat' and with either of+ the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+decode_YmdHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime+decode_YmdHMS_opt_S format =+ either (const Nothing) Just . AT.parseOnly (parser_YmdHMS_opt_S format)++{- | Decode a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from+ 'Text' that was encoded with either no separators or any non-numeric+ character for each separator and with either of the following time formats:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+decode_YmdHMS_opt_S_lenient :: Text -> Maybe Datetime+decode_YmdHMS_opt_S_lenient =+ either (const Nothing) Just . AT.parseOnly parser_YmdHMS_opt_S_lenient++{- | Parses a 'Datetime' from 'Text' that was encoded with any of the following+formats and with either no separators or any non-numeric character for each+separator.++* @%Y-%M-%D %H:%M@+* @%Y-%M-%D %H:%M:%S@+* @%D-%M-%Y %H:%M@+* @%D-%M-%Y %H:%M:%S@+* @%M-%D-%Y %H:%M@+* @%M-%D-%Y %H:%M:%S@++That is, the seconds and subseconds part is optional. If it is not provided,+it is assumed to be zero. Note that this is the least performant parser due+to backtracking+-}+parser_lenient :: Parser Datetime+parser_lenient = parser_YmdHMS_opt_S_lenient <|> parser_DmyHMS_opt_S_lenient <|> parser_MdyHMS_opt_S_lenient++{- | Parses text that was encoded in DMY, YMD, or MDY format with optional+seconds and any non-numeric character as separators.+-}+decode_lenient :: Text -> Maybe Datetime+decode_lenient =+ either (const Nothing) Just . AT.parseOnly parser_lenient++---------------+-- ByteString stuff+---------------++-- | Given a 'SubsecondPrecision' and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an Hour\/Minute\/Second encoding of the given 'TimeOfDay'.+builderUtf8_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder+builderUtf8_HMS sp msep (TimeOfDay h m ns) =+ indexTwoDigitByteStringBuilder h+ <> internalBuilderUtf8_NS sp msep m ns++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an IMS encoding of the given 'TimeOfDay'. This differs from 'builderUtf8_IMSp' in that+there is a space between the seconds and locale.+-}+builderUtf8_IMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder+builderUtf8_IMS_p meridiemLocale sp msep (TimeOfDay h m ns) =+ internalBuilderUtf8_I h+ <> internalBuilderUtf8_NS sp msep m ns+ <> " "+ <> internalBuilderUtf8_p meridiemLocale h++internalBuilderUtf8_I :: Int -> BB.Builder+internalBuilderUtf8_I h =+ indexTwoDigitByteStringBuilder $+ if h > 12+ then h - 12+ else+ if h == 0+ then 12+ else h++internalBuilderUtf8_p :: MeridiemLocale ByteString -> Int -> BB.Builder+internalBuilderUtf8_p (MeridiemLocale am pm) h =+ if h > 11+ then BB.byteString pm+ else BB.byteString am++-- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an IMS encoding of the given 'TimeOfDay'.+builderUtf8_IMSp :: MeridiemLocale ByteString -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder+builderUtf8_IMSp meridiemLocale sp msep (TimeOfDay h m ns) =+ internalBuilderUtf8_I h+ <> internalBuilderUtf8_NS sp msep m ns+ <> internalBuilderUtf8_p meridiemLocale h++{- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that uses+ the given separator.+-}+parserUtf8_HMS :: Maybe Char -> AB.Parser TimeOfDay+parserUtf8_HMS msep = do+ h <- parseFixedDigitsIntBS 2+ when (h > 23) (fail "hour must be between 0 and 23")+ traverse_ AB.char msep+ m <- parseFixedDigitsIntBS 2+ when (m > 59) (fail "minute must be between 0 and 59")+ traverse_ AB.char msep+ ns <- parseSecondsAndNanosecondsUtf8+ pure (TimeOfDay h m ns)++{- | Parses text that is formatted as either of the following:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+parserUtf8_HMS_opt_S :: Maybe Char -> AB.Parser TimeOfDay+parserUtf8_HMS_opt_S msep = do+ h <- parseFixedDigitsIntBS 2+ when (h > 23) (fail "hour must be between 0 and 23")+ traverse_ AB.char msep+ m <- parseFixedDigitsIntBS 2+ when (m > 59) (fail "minute must be between 0 and 59")+ mc <- AB.peekChar+ case mc of+ Nothing -> pure (TimeOfDay h m 0)+ Just c -> case msep of+ Just sep ->+ if c == sep+ then do+ _ <- AB.anyChar -- should be the separator+ ns <- parseSecondsAndNanosecondsUtf8+ pure (TimeOfDay h m ns)+ else pure (TimeOfDay h m 0)+ -- if there is no separator, we will try to parse the+ -- remaining part as seconds. We commit to trying to+ -- parse as seconds if we see any number as the next+ -- character.+ Nothing ->+ if isDigit c+ then do+ ns <- parseSecondsAndNanosecondsUtf8+ pure (TimeOfDay h m ns)+ else pure (TimeOfDay h m 0)++parseSecondsAndNanosecondsUtf8 :: AB.Parser Int64+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+ 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)++countZeroesUtf8 :: AB.Parser Int+countZeroesUtf8 = go 0+ where+ go !i = do+ m <- AB.peekChar+ case m of+ Nothing -> pure i+ Just c ->+ if c == '0'+ then AB.anyChar *> go (i + 1)+ else pure i++nanosecondsBuilderUtf8 :: Int64 -> BB.Builder+nanosecondsBuilderUtf8 w+ | w == 0 = mempty+ | w > 99999999 = "." <> int64Builder w+ | w > 9999999 = ".0" <> int64Builder w+ | w > 999999 = ".00" <> int64Builder w+ | w > 99999 = ".000" <> int64Builder w+ | w > 9999 = ".0000" <> int64Builder w+ | w > 999 = ".00000" <> int64Builder w+ | w > 99 = ".000000" <> int64Builder w+ | w > 9 = ".0000000" <> int64Builder w+ | otherwise = ".00000000" <> int64Builder w++microsecondsBuilderUtf8 :: Int64 -> BB.Builder+microsecondsBuilderUtf8 w+ | w == 0 = mempty+ | w > 99999 = "." <> int64Builder w+ | w > 9999 = ".0" <> int64Builder w+ | w > 999 = ".00" <> int64Builder w+ | w > 99 = ".000" <> int64Builder w+ | w > 9 = ".0000" <> int64Builder w+ | otherwise = ".00000" <> int64Builder w++millisecondsBuilderUtf8 :: Int64 -> BB.Builder+millisecondsBuilderUtf8 w+ | w == 0 = mempty+ | w > 99 = "." <> int64Builder w+ | w > 9 = ".0" <> int64Builder w+ | otherwise = ".00" <> int64Builder w++prettyNanosecondsBuilderUtf8 :: SubsecondPrecision -> Int64 -> BB.Builder+prettyNanosecondsBuilderUtf8 sp nano = case sp of+ SubsecondPrecisionAuto+ | milliRem == 0 -> millisecondsBuilderUtf8 milli+ | microRem == 0 -> microsecondsBuilderUtf8 micro+ | otherwise -> nanosecondsBuilderUtf8 nano+ SubsecondPrecisionFixed d ->+ if d == 0+ then mempty+ else+ let newSubsecondPart = quot nano (raiseTenTo (9 - d))+ in BB.char7 '.'+ <> BB.byteString (BC.replicate (d - countDigits newSubsecondPart) '0')+ <> int64Builder newSubsecondPart+ where+ (milli, milliRem) = quotRem nano 1000000+ (micro, microRem) = quotRem nano 1000++{- | Given a 'SubsecondPrecision', construct a 'ByteString' corresponding+ to an encoding of the given 'Timespan'.+-}+encodeTimespanUtf8 :: SubsecondPrecision -> Timespan -> ByteString+encodeTimespanUtf8 sp =+ LB.toStrict . BB.toLazyByteString . builderTimespanUtf8 sp++{- | Given a 'SubsecondPrecision', construct a 'ByteString' 'BB.Builder'+ corresponding to an encoding of the given 'Timespan'.+-}+builderTimespanUtf8 :: SubsecondPrecision -> Timespan -> BB.Builder+builderTimespanUtf8 sp (Timespan ns) =+ int64Builder sInt64 <> prettyNanosecondsBuilderUtf8 sp nsRemainder+ where+ (!sInt64, !nsRemainder) = quotRem ns 1000000000++int64Builder :: Int64 -> BB.Builder+int64Builder = BB.integerDec . fromIntegral++internalBuilderUtf8_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> BB.Builder+internalBuilderUtf8_NS sp msep m ns = case msep of+ Nothing ->+ indexTwoDigitByteStringBuilder m+ <> indexTwoDigitByteStringBuilder s+ <> prettyNanosecondsBuilderUtf8 sp nsRemainder+ Just sep ->+ let sepBuilder = BB.char7 sep+ in sepBuilder+ <> indexTwoDigitByteStringBuilder m+ <> sepBuilder+ <> indexTwoDigitByteStringBuilder s+ <> prettyNanosecondsBuilderUtf8 sp nsRemainder+ where+ (!sInt64, !nsRemainder) = quotRem ns 1000000000+ !s = fromIntegral sInt64++{- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct+ a 'ByteString' corresponding to a Year\/Month\/Day,Hour\/Minute\/Second+ encoding of the given 'Datetime'.+-}+encodeUtf8_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString+encodeUtf8_YmdHMS sp format =+ LB.toStrict . BB.toLazyByteString . builderUtf8_YmdHMS sp format++{- | Given a 'MeridiemLocale', a 'SubsecondPrecision', and a 'DatetimeFormat',+ construct a 'ByteString' corresponding to a Year\/Month\/Day,IMS encoding+ of the given 'Datetime'. This inserts a space between the locale and+ seconds.+-}+encodeUtf8_YmdIMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString+encodeUtf8_YmdIMS_p a sp b = LB.toStrict . BB.toLazyByteString . builderUtf8_YmdIMS_p a sp b++{- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct+ a 'ByteString' 'BB.Builder' corresponding to a+ Year\/Month\/Day,Hour\/Minute\/Second encoding of the+ given 'Datetime'.+-}+builderUtf8_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder+builderUtf8_YmdHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ case msep of+ Nothing ->+ builderUtf8_Ymd mdateSep date+ <> builderUtf8_HMS sp mtimeSep time+ Just sep ->+ builderUtf8_Ymd mdateSep date+ <> BB.char7 sep+ <> builderUtf8_HMS sp mtimeSep time++{- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct+ a 'ByteString' 'BB.Builder' corresponding to a+ Year\/Month\/Day,IMS encoding of the given 'Datetime'. This inserts+ a space between the locale and seconds.+-}+builderUtf8_YmdIMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder+builderUtf8_YmdIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ builderUtf8_Ymd mdateSep date+ <> maybe mempty BB.char7 msep+ <> builderUtf8_IMS_p locale sp mtimeSep time++{- | Given a 'SubsecondPrecision' and a 'DatetimeFormat', construct+ a 'ByteString' 'BB.Builder' corresponding to a+ Year\/Month\/Day,IMS encoding of the given 'Datetime'.+-}+builderUtf8_YmdIMSp :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> BB.Builder+builderUtf8_YmdIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) =+ builderUtf8_Ymd mdateSep date+ <> maybe mempty BB.char7 msep+ <> builderUtf8_IMS_p locale sp mtimeSep time++{- | Construct a 'ByteString' 'BB.Builder' corresponding to+ a W3C encoding of the given 'Datetime'.+-}+builderUtf8W3C :: Datetime -> BB.Builder+builderUtf8W3C = builderUtf8_YmdHMS SubsecondPrecisionAuto (DatetimeFormat (Just '-') (Just 'T') (Just ':'))++{- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' from+ a 'ByteString'.+-}+decodeUtf8_YmdHMS :: DatetimeFormat -> ByteString -> Maybe Datetime+decodeUtf8_YmdHMS format =+ either (const Nothing) Just . AB.parseOnly (parserUtf8_YmdHMS format)++{- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' that was+ encoded using the given 'DatetimeFormat'.+-}+parserUtf8_YmdHMS :: DatetimeFormat -> AB.Parser Datetime+parserUtf8_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do+ date <- parserUtf8_Ymd mdateSep+ traverse_ AB.char msep+ time <- parserUtf8_HMS mtimeSep+ pure (Datetime date time)++{- | Parses text that is formatted as either of the following:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+parserUtf8_YmdHMS_opt_S :: DatetimeFormat -> AB.Parser Datetime+parserUtf8_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do+ date <- parserUtf8_Ymd mdateSep+ traverse_ AB.char msep+ time <- parserUtf8_HMS_opt_S mtimeSep+ pure (Datetime date time)++{- | Parses text that is formatted as either of the following:++* @%H:%M@+* @%H:%M:%S@++That is, the seconds and subseconds part is optional. If it is+not provided, it is assumed to be zero. This format shows up+in Google Chrome\'s @datetime-local@ inputs.+-}+decodeUtf8_YmdHMS_opt_S :: DatetimeFormat -> ByteString -> Maybe Datetime+decodeUtf8_YmdHMS_opt_S format =+ either (const Nothing) Just . AB.parseOnly (parserUtf8_YmdHMS_opt_S format)++{- | Given an 'OffsetFormat', a 'SubsecondPrecision', and+ a 'DatetimeFormat', construct a 'Text' 'TB.Builder'+ corresponding to a Year\/Month\/Day,Hour\/Minute\/Second encoding+ of the given 'OffsetDatetime'.+-}+builder_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder+builder_YmdHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) =+ builder_YmdHMS sp datetimeFormat datetime+ <> builderOffset offsetFormat offset++{- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'OffsetDatetime'+ that was encoded using the given 'OffsetFormat'+ and 'DatetimeFormat'.+-}+parser_YmdHMSz :: OffsetFormat -> DatetimeFormat -> Parser OffsetDatetime+parser_YmdHMSz offsetFormat datetimeFormat =+ OffsetDatetime+ <$> parser_YmdHMS datetimeFormat+ <*> parserOffset offsetFormat++{- | Given an 'OffsetFormat', a 'MeridiemLocale', a+ 'SubsecondPrecision', and 'DatetimeFormat', construct a+ 'Text' 'TB.Builder' corresponding to a Year\/Month\/Day,IMS-encoding+ of the given 'OffsetDatetime'.+-}+builder_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder+builder_YmdIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) =+ builder_YmdIMS_p meridiemLocale sp datetimeFormat datetime+ <> " "+ <> builderOffset offsetFormat offset++{- | Given an 'OffsetFormat', a 'SubsecondPrecision',+ and a 'DatetimeFormat', construct 'Text' corresponding to+ the Year\/Month\/Day,Hour\/Minute\/Second-encoding of+ the given 'OffsetDatetime'.+-}+encode_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Text+encode_YmdHMSz offsetFormat sp datetimeFormat =+ LT.toStrict . TB.toLazyText . builder_YmdHMSz offsetFormat sp datetimeFormat++{- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a+ 'DatetimeFormat', construct a 'Text' 'TB.Builder' corresponding+ to the Day\/Month\/Year,Hour\/Minute\/Second-encoding of+ the given 'OffsetDatetime'.+-}+builder_DmyHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder+builder_DmyHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) =+ builder_DmyHMS sp datetimeFormat datetime+ <> builderOffset offsetFormat offset++{- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'OffsetDatetime'+ that was encoded using the given 'OffsetFormat'+ and 'DatetimeFormat'.+-}+parser_DmyHMSz :: OffsetFormat -> DatetimeFormat -> AT.Parser OffsetDatetime+parser_DmyHMSz offsetFormat datetimeFormat =+ OffsetDatetime+ <$> parser_DmyHMS datetimeFormat+ <*> parserOffset offsetFormat++{- | Given an 'OffsetFormat', a 'MeridiemLocale', a+ 'SubsecondPrecision', and a 'DatetimeFormat', construct a 'Text'+ 'TB.Builder' corresponding to the Day\/Month\/Year,IMS encoding+ of the given 'OffsetDatetime'.+-}+builder_DmyIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder+builder_DmyIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) =+ builder_DmyIMS_p meridiemLocale sp datetimeFormat datetime+ <> " "+ <> builderOffset offsetFormat offset++{- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a+ 'DatetimeFormat', construct 'Text' corresponding to the+ Day\/Month\/Year,Hour\/Minute\/Second encoding of the given+ 'OffsetDatetime'.+-}+encode_DmyHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Text+encode_DmyHMSz offsetFormat sp datetimeFormat =+ LT.toStrict . TB.toLazyText . builder_DmyHMSz offsetFormat sp datetimeFormat++{- | Construct a 'Text' 'TB.Builder' corresponding to the w3c-formatting+ of the given 'OffsetDatetime'.+-}+builderW3Cz :: OffsetDatetime -> TB.Builder+builderW3Cz =+ builder_YmdHMSz+ OffsetFormatColonOn+ SubsecondPrecisionAuto+ (DatetimeFormat (Just '-') (Just 'T') (Just ':'))++-- | Encode an 'Offset' to 'Text' using the given 'OffsetFormat'.+encodeOffset :: OffsetFormat -> Offset -> Text+encodeOffset fmt = LT.toStrict . TB.toLazyText . builderOffset fmt++{- | Construct a 'TB.Builder' corresponding to the given 'Offset'+ encoded using the given 'OffsetFormat'.+-}+builderOffset :: OffsetFormat -> Offset -> TB.Builder+builderOffset x = case x of+ OffsetFormatColonOff -> builderOffset_z+ OffsetFormatColonOn -> builderOffset_z1+ OffsetFormatSecondsPrecision -> builderOffset_z2+ OffsetFormatColonAuto -> builderOffset_z3++{- | Decode an 'Offset' from 'Text' that was encoded+ using the given 'OffsetFormat'.+-}+decodeOffset :: OffsetFormat -> Text -> Maybe Offset+decodeOffset fmt =+ either (const Nothing) Just . AT.parseOnly (parserOffset fmt <* AT.endOfInput)++-- | Parse an 'Offset' that was encoded using the given 'OffsetFormat'.+parserOffset :: OffsetFormat -> Parser Offset+parserOffset x = case x of+ OffsetFormatColonOff -> parserOffset_z+ OffsetFormatColonOn -> parserOffset_z1+ OffsetFormatSecondsPrecision -> parserOffset_z2+ OffsetFormatColonAuto -> parserOffset_z3++-- | True means positive, false means negative+parseSignedness :: Parser Bool+parseSignedness = do+ c <- AT.anyChar+ if c == '-'+ then pure False+ else+ if c == '+'+ then pure True+ else fail "while parsing offset, expected [+] or [-]"++parserOffset_z :: Parser Offset+parserOffset_z = do+ pos <- parseSignedness+ h <- parseFixedDigits 2+ m <- parseFixedDigits 2+ let !res = h * 60 + m+ pure . Offset $+ if pos+ then res+ else negate res++parserOffset_z1 :: Parser Offset+parserOffset_z1 = do+ pos <- parseSignedness+ h <- parseFixedDigits 2+ _ <- AT.char ':'+ m <- parseFixedDigits 2+ let !res = h * 60 + m+ pure . Offset $+ if pos+ then res+ else negate res++parserOffset_z2 :: AT.Parser Offset+parserOffset_z2 = do+ pos <- parseSignedness+ h <- parseFixedDigits 2+ _ <- AT.char ':'+ m <- parseFixedDigits 2+ _ <- AT.string ":00"+ let !res = h * 60 + m+ pure . Offset $+ if pos+ then res+ else negate res++{- | This is generous in what it accepts. If you give+ something like +04:00 as the offset, it will be+ allowed, even though it could be shorter.+-}+parserOffset_z3 :: AT.Parser Offset+parserOffset_z3 = do+ pos <- parseSignedness+ h <- parseFixedDigits 2+ mc <- AT.peekChar+ case mc of+ Just ':' -> do+ _ <- AT.anyChar -- should be a colon+ m <- parseFixedDigits 2+ let !res = h * 60 + m+ pure . Offset $+ if pos+ then res+ else negate res+ _ ->+ pure . Offset $+ if pos+ then h * 60+ else h * (-60)++builderOffset_z :: Offset -> TB.Builder+builderOffset_z (Offset i) =+ let (!a, !b) = divMod (abs i) 60+ !prefix = if signum i == (-1) then "-" else "+"+ in prefix+ <> indexTwoDigitTextBuilder a+ <> indexTwoDigitTextBuilder b++builderOffset_z1 :: Offset -> TB.Builder+builderOffset_z1 (Offset i) =+ let (!a, !b) = divMod (abs i) 60+ !prefix = if signum i == (-1) then "-" else "+"+ in prefix+ <> indexTwoDigitTextBuilder a+ <> ":"+ <> indexTwoDigitTextBuilder b++builderOffset_z2 :: Offset -> TB.Builder+builderOffset_z2 (Offset i) =+ let (!a, !b) = divMod (abs i) 60+ !prefix = if signum i == (-1) then "-" else "+"+ in prefix+ <> indexTwoDigitTextBuilder a+ <> ":"+ <> indexTwoDigitTextBuilder b+ <> ":00"++builderOffset_z3 :: Offset -> TB.Builder+builderOffset_z3 (Offset i) =+ let (!a, !b) = divMod (abs i) 60+ !prefix = if signum i == (-1) then "-" else "+"+ in if b == 0+ then+ prefix+ <> indexTwoDigitTextBuilder a+ else+ prefix+ <> indexTwoDigitTextBuilder a+ <> ":"+ <> indexTwoDigitTextBuilder b++{- | Given an 'OffsetFormat', a 'SubsecondPrecision', and a+ 'DatetimeFormat', construct a 'ByteString' 'BB.Builder'+ corresponding to the Year\/Month\/Day,Hour\/Minute\/Second+ encoding of the given 'OffsetDatetime'.+-}+builderUtf8_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> BB.Builder+builderUtf8_YmdHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) =+ builderUtf8_YmdHMS sp datetimeFormat datetime+ <> builderOffsetUtf8 offsetFormat offset++{- | Parse a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'OffsetDatetime'+ that was encoded using the given 'OffsetFormat' and+ 'DatetimeFormat'.+-}+parserUtf8_YmdHMSz :: OffsetFormat -> DatetimeFormat -> AB.Parser OffsetDatetime+parserUtf8_YmdHMSz offsetFormat datetimeFormat =+ OffsetDatetime+ <$> parserUtf8_YmdHMS datetimeFormat+ <*> parserOffsetUtf8 offsetFormat++{- | Given an 'OffsetFormat', a 'MeridiemLocale, a 'SubsecondPrecision',+ and a 'DatetimeFormat', construct a 'ByteString' 'BB.Builder'+ corresponding to a Year\/Month\/Day,IMS-encoded 'OffsetDatetime'.+-}+builderUtf8_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> BB.Builder+builderUtf8_YmdIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) =+ builderUtf8_YmdIMS_p meridiemLocale sp datetimeFormat datetime+ <> " "+ <> builderOffsetUtf8 offsetFormat offset++{- | Construct a 'ByteString' 'BB.Builder' corresponding to the W3C+ encoding of the given 'Datetime'.+-}+builderUtf8W3Cz :: OffsetDatetime -> BB.Builder+builderUtf8W3Cz =+ builderUtf8_YmdHMSz+ OffsetFormatColonOn+ SubsecondPrecisionAuto+ (DatetimeFormat (Just '-') (Just 'T') (Just ':'))++-- | Encode an 'Offset' as a 'ByteString' using the given 'OffsetFormat'.+encodeOffsetUtf8 :: OffsetFormat -> Offset -> ByteString+encodeOffsetUtf8 fmt = LB.toStrict . BB.toLazyByteString . builderOffsetUtf8 fmt++{- | Decode an 'Offset' from a 'ByteString' that was encoded using the given+ 'OffsetFormat'.+-}+decodeOffsetUtf8 :: OffsetFormat -> ByteString -> Maybe Offset+decodeOffsetUtf8 fmt =+ either (const Nothing) Just . AB.parseOnly (parserOffsetUtf8 fmt)++{- | Construct a 'ByteString' 'BB.Builder' corresponding to the+ encoding of an 'Offset' using the given 'OffsetFormat'.+-}+builderOffsetUtf8 :: OffsetFormat -> Offset -> BB.Builder+builderOffsetUtf8 x = case x of+ OffsetFormatColonOff -> builderOffsetUtf8_z+ OffsetFormatColonOn -> builderOffsetUtf8_z1+ OffsetFormatSecondsPrecision -> builderOffsetUtf8_z2+ OffsetFormatColonAuto -> builderOffsetUtf8_z3++{- | Parse an 'Offset' that was encoded using the given+ 'OffsetFormat'.+-}+parserOffsetUtf8 :: OffsetFormat -> AB.Parser Offset+parserOffsetUtf8 x = case x of+ OffsetFormatColonOff -> parserOffsetUtf8_z+ OffsetFormatColonOn -> parserOffsetUtf8_z1+ OffsetFormatSecondsPrecision -> parserOffsetUtf8_z2+ OffsetFormatColonAuto -> parserOffsetUtf8_z3++-- | True means positive, false means negative+parseSignednessUtf8 :: AB.Parser Bool+parseSignednessUtf8 = do+ c <- AB.anyChar+ if c == '-'+ then pure False+ else+ if c == '+'+ then pure True+ else fail "while parsing offset, expected [+] or [-]"++parserOffsetUtf8_z :: AB.Parser Offset+parserOffsetUtf8_z = do+ pos <- parseSignednessUtf8+ h <- parseFixedDigitsIntBS 2+ m <- parseFixedDigitsIntBS 2+ let !res = h * 60 + m+ pure . Offset $+ if pos+ then res+ else negate res++parserOffsetUtf8_z1 :: AB.Parser Offset+parserOffsetUtf8_z1 = do+ pos <- parseSignednessUtf8+ h <- parseFixedDigitsIntBS 2+ _ <- AB.char ':'+ m <- parseFixedDigitsIntBS 2+ let !res = h * 60 + m+ pure . Offset $+ if pos+ then res+ else negate res++parserOffsetUtf8_z2 :: AB.Parser Offset+parserOffsetUtf8_z2 = do+ pos <- parseSignednessUtf8+ h <- parseFixedDigitsIntBS 2+ _ <- AB.char ':'+ m <- parseFixedDigitsIntBS 2+ _ <- AB.string ":00"+ let !res = h * 60 + m+ pure . Offset $+ if pos+ then res+ else negate res++{- | This is generous in what it accepts. If you give+ something like +04:00 as the offset, it will be+ allowed, even though it could be shorter.+-}+parserOffsetUtf8_z3 :: AB.Parser Offset+parserOffsetUtf8_z3 = do+ pos <- parseSignednessUtf8+ h <- parseFixedDigitsIntBS 2+ mc <- AB.peekChar+ case mc of+ Just ':' -> do+ _ <- AB.anyChar -- should be a colon+ m <- parseFixedDigitsIntBS 2+ let !res = h * 60 + m+ pure . Offset $+ if pos+ then res+ else negate res+ _ ->+ pure . Offset $+ if pos+ then h * 60+ else h * (-60)++builderOffsetUtf8_z :: Offset -> BB.Builder+builderOffsetUtf8_z (Offset i) =+ let (!a, !b) = divMod (abs i) 60+ !prefix = if signum i == (-1) then "-" else "+"+ in prefix+ <> indexTwoDigitByteStringBuilder a+ <> indexTwoDigitByteStringBuilder b++builderOffsetUtf8_z1 :: Offset -> BB.Builder+builderOffsetUtf8_z1 (Offset i) =+ let (!a, !b) = divMod (abs i) 60+ !prefix = if signum i == (-1) then "-" else "+"+ in prefix+ <> indexTwoDigitByteStringBuilder a+ <> ":"+ <> indexTwoDigitByteStringBuilder b++builderOffsetUtf8_z2 :: Offset -> BB.Builder+builderOffsetUtf8_z2 (Offset i) =+ let (!a, !b) = divMod (abs i) 60+ !prefix = if signum i == (-1) then "-" else "+"+ in prefix+ <> indexTwoDigitByteStringBuilder a+ <> ":"+ <> indexTwoDigitByteStringBuilder b+ <> ":00"++builderOffsetUtf8_z3 :: Offset -> BB.Builder+builderOffsetUtf8_z3 (Offset i) =+ let (!a, !b) = divMod (abs i) 60+ !prefix = if signum i == (-1) then "-" else "+"+ in if b == 0+ then+ prefix+ <> indexTwoDigitByteStringBuilder a+ else+ prefix+ <> indexTwoDigitByteStringBuilder a+ <> ":"+ <> indexTwoDigitByteStringBuilder b++-- Zepto parsers++{- | Parse a 'Datetime' that was encoded using the+ given 'DatetimeFormat'.+-}+zeptoUtf8_YmdHMS :: DatetimeFormat -> Z.Parser Datetime+zeptoUtf8_YmdHMS (DatetimeFormat mdateSep msep' mtimeSep) = do+ date <- zeptoUtf8_Ymd mdateSep+ let msep = BC.singleton <$> msep'+ traverse_ Z.string msep+ time <- zeptoUtf8_HMS mtimeSep+ pure (Datetime date time)++zeptoCountZeroes :: Z.Parser Int+zeptoCountZeroes = do+ bs <- Z.takeWhile (0x30 ==)+ pure $! BC.length bs++{- | Parse a 'Date' that was encoded using+ the given separator.+-}+zeptoUtf8_Ymd :: Maybe Char -> Z.Parser Date+zeptoUtf8_Ymd msep' = do+ y <- zeptoFixedDigitsIntBS 4+ let msep = BC.singleton <$> msep'+ traverse_ Z.string msep+ m <- zeptoFixedDigitsIntBS 2+ when (m < 1 || m > 12) (fail "month must be between 1 and 12")+ traverse_ Z.string msep+ d <- zeptoFixedDigitsIntBS 2+ when (d < 1 || d > 31) (fail "day must be between 1 and 31")+ pure (Date (Year y) (Month $ m - 1) (DayOfMonth d))++{- | Parse a 'TimeOfDay' that was encoded using+ the given separator.+-}+zeptoUtf8_HMS :: Maybe Char -> Z.Parser TimeOfDay+zeptoUtf8_HMS msep' = do+ h <- zeptoFixedDigitsIntBS 2+ when (h > 23) (fail "hour must be between 0 and 23")+ let msep = BC.singleton <$> msep'+ traverse_ Z.string msep+ m <- zeptoFixedDigitsIntBS 2+ when (m > 59) (fail "minute must be between 0 and 59")+ traverse_ Z.string msep+ ns <- zeptoSecondsAndNanosecondsUtf8+ pure (TimeOfDay h m ns)++zeptoFixedDigitsIntBS :: Int -> Z.Parser Int+zeptoFixedDigitsIntBS n = do+ t <- Z.take n+ case BC.readInt t of+ Nothing -> fail "datetime decoding could not parse integral bytestring (a)"+ Just (i, r) ->+ if BC.null r+ then pure i+ else fail "datetime decoding could not parse integral bytestring (b)"++zeptoSecondsAndNanosecondsUtf8 :: Z.Parser Int64+zeptoSecondsAndNanosecondsUtf8 = do+ s' <- zeptoFixedDigitsIntBS 2+ let s = fromIntegral s' :: Int64+ when (s > 60) (fail "seconds must be between 0 and 60")+ nanoseconds <-+ ( do+ _ <- Z.string "."+ numberOfZeroes <- zeptoCountZeroes+ x <- zdecimal+ 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 (s * 1000000000 + nanoseconds)++zdecimal :: Z.Parser Int64+zdecimal = do+ digits <- Z.takeWhile wordIsDigit+ case BC.readInt digits of+ Nothing -> fail "somehow this didn't work"+ Just (i, _) -> pure $! fromIntegral i++wordIsDigit :: Word8 -> Bool+wordIsDigit a = 0x30 <= a && a <= 0x39++-- | The 'Month' of January.+january :: Month+january = Month 0++-- | The 'Month' of February.+february :: Month+february = Month 1++-- | The 'Month' of March.+march :: Month+march = Month 2++-- | The 'Month' of April.+april :: Month+april = Month 3++-- | The 'Month' of May.+may :: Month+may = Month 4++-- | The 'Month' of June.+june :: Month+june = Month 5++-- | The 'Month' of July.+july :: Month+july = Month 6++-- | The 'Month' of August.+august :: Month+august = Month 7++-- | The 'Month' of September.+september :: Month+september = Month 8++-- | The 'Month' of October.+october :: Month+october = Month 9++-- | The 'Month' of November.+november :: Month+november = Month 10++-- | The 'Month' of December.+december :: Month+december = Month 11++-- | The 'DayOfWeek' Sunday.+sunday :: DayOfWeek+sunday = DayOfWeek 0++-- | The 'DayOfWeek' Monday.+monday :: DayOfWeek+monday = DayOfWeek 1++-- | The 'DayOfWeek' Tuesday.+tuesday :: DayOfWeek+tuesday = DayOfWeek 2++-- | The 'DayOfWeek' Wednesday.+wednesday :: DayOfWeek+wednesday = DayOfWeek 3++-- | The 'DayOfWeek' Thursday.+thursday :: DayOfWeek+thursday = DayOfWeek 4++-- | The 'DayOfWeek' Friday.+friday :: DayOfWeek+friday = DayOfWeek 5++-- | The 'DayOfWeek' Saturday.+saturday :: DayOfWeek+saturday = DayOfWeek 6++countDigits :: (Integral a) => a -> Int+countDigits v0+ | fromIntegral v64 == v0 = go 1 v64+ | otherwise = goBig 1 (fromIntegral v0)+ where+ v64 = fromIntegral v0+ goBig !k (v :: Integer)+ | v > big = goBig (k + 19) (v `quot` big)+ | otherwise = go k (fromIntegral v)+ big = 10000000000000000000+ go !k (v :: Word64)+ | v < 10 = k+ | v < 100 = k + 1+ | v < 1000 = k + 2+ | v < 1000000000000 =+ k+ + if v < 100000000+ then+ if v < 1000000+ then+ if v < 10000+ then 3+ else 4 + fin v 100000+ else 6 + fin v 10000000+ else+ if v < 10000000000+ then 8 + fin v 1000000000+ else 10 + fin v 100000000000+ | otherwise = go (k + 12) (v `quot` 1000000000000)+ fin v n = if v >= n then 1 else 0++clip :: (Ord t) => t -> t -> t -> t+clip a _ x | x < a = a+clip _ b x | x > b = b+clip _ _ x = x++parseFixedDigits :: Int -> AT.Parser Int+parseFixedDigits n = do+ t <- AT.take n+ case Text.decimal t of+ Left err -> fail err+ Right (i, r) ->+ if Text.null r+ then pure i+ else fail "datetime decoding could not parse integral text"++parseFixedDigitsIntBS :: Int -> AB.Parser Int+parseFixedDigitsIntBS n = do+ t <- AB.take n+ case BC.readInt t of+ Nothing -> fail "datetime decoding could not parse integral bytestring (a)"+ Just (i, r) ->+ if BC.null r+ then pure i+ else fail "datetime decoding could not parse integral bytestring (b)"++-- Only provide positive numbers to this function.+indexTwoDigitTextBuilder :: Int -> TB.Builder+indexTwoDigitTextBuilder i =+ if i < 100+ then Vector.unsafeIndex twoDigitTextBuilder (fromIntegral i)+ else TB.decimal i++-- | Only provide positive numbers to this function.+indexTwoDigitByteStringBuilder :: Int -> BB.Builder+indexTwoDigitByteStringBuilder i =+ if i < 100+ then Vector.unsafeIndex twoDigitByteStringBuilder (fromIntegral i)+ else BB.intDec i++twoDigitByteStringBuilder :: Vector BB.Builder+twoDigitByteStringBuilder =+ Vector.fromList $+ map (BB.byteString . BC.pack) twoDigitStrings+{-# NOINLINE twoDigitByteStringBuilder #-}++twoDigitTextBuilder :: Vector TB.Builder+twoDigitTextBuilder =+ Vector.fromList $+ map (TB.fromText . Text.pack) twoDigitStrings+{-# NOINLINE twoDigitTextBuilder #-}++twoDigitStrings :: [String]+twoDigitStrings =+ [ "00"+ , "01"+ , "02"+ , "03"+ , "04"+ , "05"+ , "06"+ , "07"+ , "08"+ , "09"+ , "10"+ , "11"+ , "12"+ , "13"+ , "14"+ , "15"+ , "16"+ , "17"+ , "18"+ , "19"+ , "20"+ , "21"+ , "22"+ , "23"+ , "24"+ , "25"+ , "26"+ , "27"+ , "28"+ , "29"+ , "30"+ , "31"+ , "32"+ , "33"+ , "34"+ , "35"+ , "36"+ , "37"+ , "38"+ , "39"+ , "40"+ , "41"+ , "42"+ , "43"+ , "44"+ , "45"+ , "46"+ , "47"+ , "48"+ , "49"+ , "50"+ , "51"+ , "52"+ , "53"+ , "54"+ , "55"+ , "56"+ , "57"+ , "58"+ , "59"+ , "60"+ , "61"+ , "62"+ , "63"+ , "64"+ , "65"+ , "66"+ , "67"+ , "68"+ , "69"+ , "70"+ , "71"+ , "72"+ , "73"+ , "74"+ , "75"+ , "76"+ , "77"+ , "78"+ , "79"+ , "80"+ , "81"+ , "82"+ , "83"+ , "84"+ , "85"+ , "86"+ , "87"+ , "88"+ , "89"+ , "90"+ , "91"+ , "92"+ , "93"+ , "94"+ , "95"+ , "96"+ , "97"+ , "98"+ , "99"+ ]++raiseTenTo :: Int -> Int64+raiseTenTo i =+ if i > 15+ then 10 ^ i+ else UVector.unsafeIndex tenRaisedToSmallPowers i++tenRaisedToSmallPowers :: UVector.Vector Int64+tenRaisedToSmallPowers = UVector.fromList $ map (10 ^) [0 :: Int .. 15]++yearToZeroPaddedDigit :: Year -> TB.Builder+yearToZeroPaddedDigit (Year x)+ | x < 10 = "000" <> TB.decimal x+ | x < 100 = "00" <> TB.decimal x+ | x < 1000 = "0" <> TB.decimal x+ | otherwise = TB.decimal x++monthToZeroPaddedDigit :: Month -> TB.Builder+monthToZeroPaddedDigit (Month x) =+ indexTwoDigitTextBuilder (x + 1)++zeroPadDayOfMonth :: DayOfMonth -> TB.Builder+zeroPadDayOfMonth (DayOfMonth d) = indexTwoDigitTextBuilder d++yearToZeroPaddedDigitBS :: Year -> BB.Builder+yearToZeroPaddedDigitBS (Year x)+ | x < 10 = "000" <> BB.intDec x+ | x < 100 = "00" <> BB.intDec x+ | x < 1000 = "0" <> BB.intDec x+ | otherwise = BB.intDec x++monthToZeroPaddedDigitBS :: Month -> BB.Builder+monthToZeroPaddedDigitBS (Month x) =+ indexTwoDigitByteStringBuilder (x + 1)++zeroPadDayOfMonthBS :: DayOfMonth -> BB.Builder+zeroPadDayOfMonthBS (DayOfMonth d) = indexTwoDigitByteStringBuilder d++-- | Is the given 'Time' within the 'TimeInterval'?+within :: Time -> TimeInterval -> Bool+t `within` (TimeInterval t0 t1) = t >= t0 && t <= t1++-- | Convert a 'TimeInterval' to a 'Timespan'. This is equivalent to 'width'.+timeIntervalToTimespan :: TimeInterval -> Timespan+timeIntervalToTimespan = width++{- | The 'TimeInterval' that covers the entire range of 'Time's that Chronos supports.++ prop> \(t :: Time) -> within t whole+-}+whole :: TimeInterval+whole = TimeInterval minBound maxBound++-- | The singleton (degenerate) 'TimeInterval'.+singleton :: Time -> TimeInterval+singleton x = TimeInterval x x++-- | Get the lower bound of the 'TimeInterval'.+lowerBound :: TimeInterval -> Time+lowerBound (TimeInterval t0 _) = t0++-- | Get the upper bound of the 'TimeInterval'.+upperBound :: TimeInterval -> Time+upperBound (TimeInterval _ t1) = t1++-- | The width of the 'TimeInterval'. This is equivalent to 'timeIntervalToTimespan'.+width :: TimeInterval -> Timespan+width (TimeInterval x y) = difference y x++{- | A smart constructor for 'TimeInterval'. In general, you should prefer using this+ over the 'TimeInterval' constructor, since it maintains the invariant that+ @'lowerBound' interval '<=' 'upperBound' interval@.+-}+timeIntervalBuilder :: Time -> Time -> TimeInterval+timeIntervalBuilder x y = case compare x y of+ GT -> TimeInterval y x+ _ -> TimeInterval x y++infix 3 ...++-- | An infix 'timeIntervalBuilder'.+(...) :: Time -> Time -> TimeInterval+(...) = timeIntervalBuilder++{- | A day represented as the modified Julian date, the number of days+ since midnight on November 17, 1858.+-}+newtype Day = Day {getDay :: Int}+ deriving (Show, Read, Eq, Ord, Hashable, Enum, ToJSON, FromJSON, Storable, Prim, NFData)++instance Torsor Day Int where+ add i (Day d) = Day (d + i)+ difference (Day a) (Day b) = a - b++-- | a lens for accessing the `getDay` field.+_getDay :: (Functor f) => (Int -> f Int) -> Day -> f Day+_getDay f = fmap Day . f . getDay++-- | The day of the week.+newtype DayOfWeek = DayOfWeek {getDayOfWeek :: Int}+ deriving (Show, Read, Eq, Ord, Hashable, NFData)++-- | a lens for accessing the `getDayOfWeek` field.+_getDayOfWeek :: (Functor f) => (Int -> f Int) -> DayOfWeek -> f DayOfWeek+_getDayOfWeek f = fmap DayOfWeek . f . getDayOfWeek++-- | The day of the month.+newtype DayOfMonth = DayOfMonth {getDayOfMonth :: Int}+ deriving (Show, Read, Eq, Ord, Prim, Enum, NFData)++-- | a lens for accessing the `getDayOfMonth` field.+_getDayOfMonth :: (Functor f) => (Int -> f Int) -> DayOfMonth -> f DayOfMonth+_getDayOfMonth f = fmap DayOfMonth . f . getDayOfMonth++-- | The day of the year.+newtype DayOfYear = DayOfYear {getDayOfYear :: Int}+ deriving (Show, Read, Eq, Ord, Prim, NFData)++-- | a lens for accessing the `getDayOfYear` field.+_getDayOfYear :: (Functor f) => (Int -> f Int) -> DayOfYear -> f DayOfYear+_getDayOfYear f = fmap DayOfYear . f . getDayOfYear++-- | The month of the year.+newtype Month = Month {getMonth :: Int}+ deriving (Show, Read, Eq, Ord, Prim, NFData)++-- | a lens for accessing the `getMonth` field.+_getMonth :: (Functor f) => (Int -> f Int) -> Month -> f Month+_getMonth f = fmap Month . f . getMonth++instance Enum Month where+ fromEnum = getMonth+ toEnum = Month+ succ (Month x) =+ if x < 11+ then Month (x + 1)+ else error "Enum.succ{Month}: tried to take succ of December"+ pred (Month x) =+ if x > 0+ then Month (x - 1)+ else error "Enum.pred{Month}: tried to take pred of January"+ enumFrom x = enumFromTo x (Month 11)++-- | 'Month' starts at 0 and ends at 11 (January to December)+instance Bounded Month where+ minBound = Month 0+ maxBound = Month 11++{- | The number of years elapsed since the beginning+ of the Common Era.+-}+newtype Year = Year {getYear :: Int}+ deriving (Show, Read, Eq, Ord, NFData)++-- | a lens for accessing the `getYear` field.+_getYear :: (Functor f) => (Int -> f Int) -> Year -> f Year+_getYear f = fmap Year . f . getYear++-- | A <https://en.wikipedia.org/wiki/UTC_offset UTC offset> in minutes.+newtype Offset = Offset {getOffset :: Int}+ deriving (Show, Read, Eq, Ord, Enum, NFData)++-- | a lens for accessing the `getOffset` field.+_getOffset :: (Functor f) => (Int -> f Int) -> Offset -> f Offset+_getOffset f = fmap Offset . f . getOffset++-- | POSIX time with nanosecond resolution.+newtype Time = Time {getTime :: Int64}+ deriving (FromJSON, ToJSON, Hashable, Eq, Ord, Show, Read, Storable, Prim, Bounded, NFData)++-- | a lens for accessing the `getTime` field.+_getTime :: (Functor f) => (Int64 -> f Int64) -> Time -> f Time+_getTime f = fmap Time . f . getTime++{- | Match a 'DayOfWeek'. By `match`, we mean that a 'DayOfWeekMatch'+ is a mapping from the integer value of a 'DayOfWeek' to some value+ of type @a@. You should construct a 'DayOfWeekMatch' with+ 'buildDayOfWeekMatch', and match it using 'caseDayOfWeek'.+-}+newtype DayOfWeekMatch a = DayOfWeekMatch {getDayOfWeekMatch :: Vector a}+ deriving (NFData)++{- | Match a 'Month'. By `match`, we mean that a 'MonthMatch' is+ a mapping from the integer value of a 'Month' to some value of+ type @a@. You should construct a 'MonthMatch' with+ 'buildMonthMatch', and match it using 'caseMonth'.+-}+newtype MonthMatch a = MonthMatch {getMonthMatch :: Vector a}+ deriving (NFData)++{- | Like 'MonthMatch', but the matched value can have an instance of+ 'UVector.Unbox'.+-}+newtype UnboxedMonthMatch a = UnboxedMonthMatch {getUnboxedMonthMatch :: UVector.Vector a}+ deriving (NFData)++{- | A timespan. This is represented internally as a number+ of nanoseconds.+-}+newtype Timespan = Timespan {getTimespan :: Int64}+ deriving (Show, Read, Eq, Ord, ToJSON, FromJSON, Additive, NFData)++-- | a lens for accessing the `getTimespan` field.+_getTimespan :: (Functor f) => (Int64 -> f Int64) -> Timespan -> f Timespan+_getTimespan f = fmap Timespan . f . getTimespan++instance Semigroup Timespan where+ (Timespan a) <> (Timespan b) = Timespan (a + b)++instance Monoid Timespan where+ mempty = Timespan 0+ mappend = (SG.<>)++instance Torsor Time Timespan where+ add (Timespan ts) (Time t) = Time (t + ts)+ difference (Time t) (Time s) = Timespan (t - s)++instance Scaling Timespan Int64 where+ scale i (Timespan ts) = Timespan (i * ts)++instance Torsor Offset Int where+ add i (Offset x) = Offset (x + i)+ difference (Offset x) (Offset y) = x - y++-- | The precision used when encoding seconds to a human-readable format.+data SubsecondPrecision+ = -- | Rounds to second, millisecond, microsecond, or nanosecond+ SubsecondPrecisionAuto+ | -- | Specify number of places after decimal+ SubsecondPrecisionFixed {-# UNPACK #-} !Int+ deriving (Eq, Ord, Show, Read)++instance NFData SubsecondPrecision where+ rnf (SubsecondPrecisionAuto) = ()+ rnf (SubsecondPrecisionFixed a) = a `deepseq` ()++-- | A date as represented by the Gregorian calendar.+data Date = Date+ { dateYear :: {-# UNPACK #-} !Year+ , dateMonth :: {-# UNPACK #-} !Month+ , dateDay :: {-# UNPACK #-} !DayOfMonth+ }+ deriving (Show, Read, Eq, Ord)++instance NFData Date where+ rnf (Date y m d) = y `deepseq` m `deepseq` d `deepseq` ()++-- | a lens for accessing the `dateYear` field.+_dateYear :: (Functor f) => (Year -> f Year) -> Date -> f Date+_dateYear f date = fmap (\y -> date {dateYear = y}) . f . dateYear $ date++-- | a lens for accessing the `dateMonth` field.+_dateMonth :: (Functor f) => (Month -> f Month) -> Date -> f Date+_dateMonth f date = fmap (\m -> date {dateMonth = m}) . f . dateMonth $ date++-- | a lens for accessing the `dateDay` field.+_dateDay :: (Functor f) => (DayOfMonth -> f DayOfMonth) -> Date -> f Date+_dateDay f date = fmap (\d -> date {dateDay = d}) . f . dateDay $ date++{- | An 'OrdinalDate' is a 'Year' and the number of days elapsed+ since the 'Year' began.+-}+data OrdinalDate = OrdinalDate+ { ordinalDateYear :: {-# UNPACK #-} !Year+ , ordinalDateDayOfYear :: {-# UNPACK #-} !DayOfYear+ }+ deriving (Show, Read, Eq, Ord)++instance NFData OrdinalDate where+ rnf (OrdinalDate y d) = y `deepseq` d `deepseq` ()++-- | a lens for accessing the `ordinalDateYear` field.+_ordinalDateYear :: (Functor f) => (Year -> f Year) -> OrdinalDate -> f OrdinalDate+_ordinalDateYear f date = fmap (\y -> date {ordinalDateYear = y}) . f . ordinalDateYear $ date++-- | a lens for accessing the `ordinalDateDayOfYear` field.+_ordinalDateDayOfYear :: (Functor f) => (DayOfYear -> f DayOfYear) -> OrdinalDate -> f OrdinalDate+_ordinalDateDayOfYear f date =+ fmap (\d -> date {ordinalDateDayOfYear = d}) . f . ordinalDateDayOfYear $ date++{- | A month and the day of the month. This does not actually represent+ a specific date, since this recurs every year.+-}+data MonthDate = MonthDate+ { monthDateMonth :: {-# UNPACK #-} !Month+ , monthDateDay :: {-# UNPACK #-} !DayOfMonth+ }+ deriving (Show, Read, Eq, Ord)++instance NFData MonthDate where+ rnf (MonthDate m d) = m `deepseq` d `deepseq` ()++-- | a lens for accessing the `monthDateMonth` field.+_monthDateMonth :: (Functor f) => (Month -> f Month) -> MonthDate -> f MonthDate+_monthDateMonth f date = fmap (\m -> date {monthDateMonth = m}) . f . monthDateMonth $ date++-- | a lens for accessing the `monthDateDay` field.+_monthDateDay :: (Functor f) => (DayOfMonth -> f DayOfMonth) -> MonthDate -> f MonthDate+_monthDateDay f date = fmap (\d -> date {monthDateDay = d}) . f . monthDateDay $ date++{- | A 'Date' as represented by the Gregorian calendar+ and a 'TimeOfDay'.+ While the 'ToJSON' instance encodes with a hyphen separator, the+ 'FromJSON' instance allows any non-digit character to act as+ separator, using the lenient parser.+-}+data Datetime = Datetime+ { datetimeDate :: {-# UNPACK #-} !Date+ , datetimeTime :: {-# UNPACK #-} !TimeOfDay+ }+ deriving (Show, Read, Eq, Ord)++instance NFData Datetime where+ rnf (Datetime d t) = d `deepseq` t `deepseq` ()++-- | a lens for accessing the `datetimeDate` field.+_datetimeDate :: (Functor f) => (Date -> f Date) -> Datetime -> f Datetime+_datetimeDate f date = fmap (\y -> date {datetimeDate = y}) . f . datetimeDate $ date++-- | a lens for accessing the `datetimeTime` field.+_datetimeTime :: (Functor f) => (TimeOfDay -> f TimeOfDay) -> Datetime -> f Datetime+_datetimeTime f date = fmap (\t -> date {datetimeTime = t}) . f . datetimeTime $ date++-- | A 'Datetime' with a time zone 'Offset'.+data OffsetDatetime = OffsetDatetime+ { offsetDatetimeDatetime :: {-# UNPACK #-} !Datetime+ , offsetDatetimeOffset :: {-# UNPACK #-} !Offset+ }+ deriving (Show, Read, Eq, Ord)++instance NFData OffsetDatetime where+ rnf (OffsetDatetime dt o) = dt `deepseq` o `deepseq` ()++-- | a lens for accessing the `offsetDatetimeDatetime` field.+_offsetDatetimeDatetime ::+ (Functor f) => (Datetime -> f Datetime) -> OffsetDatetime -> f OffsetDatetime+_offsetDatetimeDatetime f date =+ fmap (\d -> date {offsetDatetimeDatetime = d}) . f . offsetDatetimeDatetime $ date++-- | a lens for accessing the `offsetDatetimeOffset` field.+_offsetDatetimeOffset ::+ (Functor f) => (Offset -> f Offset) -> OffsetDatetime -> f OffsetDatetime+_offsetDatetimeOffset f date =+ fmap (\y -> date {offsetDatetimeOffset = y}) . f . offsetDatetimeOffset $ date++-- | A time of day with nanosecond resolution.+data TimeOfDay = TimeOfDay+ { timeOfDayHour :: {-# UNPACK #-} !Int+ , timeOfDayMinute :: {-# UNPACK #-} !Int+ , timeOfDayNanoseconds :: {-# UNPACK #-} !Int64+ }+ deriving (Show, Read, Eq, Ord)++instance NFData TimeOfDay where+ rnf (TimeOfDay h m s) = h `deepseq` m `deepseq` s `deepseq` ()++-- | a lens for accessing the `timeOfDayHour` field.+_timeOfDayHour ::+ (Functor f) => (Int -> f Int) -> TimeOfDay -> f TimeOfDay+_timeOfDayHour f time =+ fmap (\h -> time {timeOfDayHour = h}) . f . timeOfDayHour $ time++-- | a lens for accessing the `timeOfDayMinute` field.+_timeOfDayMinute ::+ (Functor f) => (Int -> f Int) -> TimeOfDay -> f TimeOfDay+_timeOfDayMinute f time =+ fmap (\m -> time {timeOfDayMinute = m}) . f . timeOfDayMinute $ time++-- | a lens for accessing the `timeOfDayNanoseconds` field.+_timeOfDayNanoseconds ::+ (Functor f) => (Int64 -> f Int64) -> TimeOfDay -> f TimeOfDay+_timeOfDayNanoseconds f time =+ fmap (\n -> time {timeOfDayNanoseconds = n}) . f . timeOfDayNanoseconds $ time++{- | The format of a 'Datetime'. In particular+ this provides separators for parts of the 'Datetime'+ and nothing else.+-}+data DatetimeFormat = DatetimeFormat+ { datetimeFormatDateSeparator :: !(Maybe Char)+ -- ^ Separator in the date+ , datetimeFormatSeparator :: !(Maybe Char)+ -- ^ Separator between date and time+ , datetimeFormatTimeSeparator :: !(Maybe Char)+ -- ^ Separator in the time+ }+ deriving (Show, Read, Eq, Ord)++instance NFData DatetimeFormat where+ rnf (DatetimeFormat s1 s2 s3) = s1 `deepseq` s2 `deepseq` s3 `deepseq` ()++-- | Formatting settings for a timezone offset.+data OffsetFormat+ = -- | @%z@ (e.g., -0400)+ OffsetFormatColonOff+ | -- | @%:z@ (e.g., -04:00)+ OffsetFormatColonOn+ | -- | @%::z@ (e.g., -04:00:00)+ OffsetFormatSecondsPrecision+ | -- | @%:::z@ (e.g., -04, +05:30)+ OffsetFormatColonAuto+ deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)++instance NFData OffsetFormat where+ rnf !_ = ()++{- | Locale-specific formatting for weekdays and months. The+ type variable will likely be instantiated to @Text@+ or @ByteString@.+-}+data DatetimeLocale a = DatetimeLocale+ { datetimeLocaleDaysOfWeekFull :: !(DayOfWeekMatch a)+ -- ^ full weekdays starting with Sunday, 7 elements+ , datetimeLocaleDaysOfWeekAbbreviated :: !(DayOfWeekMatch a)+ -- ^ abbreviated weekdays starting with Sunday, 7 elements+ , datetimeLocaleMonthsFull :: !(MonthMatch a)+ -- ^ full months starting with January, 12 elements+ , datetimeLocaleMonthsAbbreviated :: !(MonthMatch a)+ -- ^ abbreviated months starting with January, 12 elements+ }++instance (NFData a) => NFData (DatetimeLocale a) where+ rnf (DatetimeLocale d1 d2 m1 m2) =+ d1 `deepseq` d2 `deepseq` m1 `deepseq` m2 `deepseq` ()++{- | A TimeInterval represents a start and end time.+ It can sometimes be more ergonomic than the 'Torsor' API when+ you only care about whether or not a 'Time' is within a certain range.++ To construct a 'TimeInterval', it is best to use 'timeIntervalBuilder',+ which maintains the invariant that @'lowerBound' interval '<=' 'upperBound' interval@+ (all functions that act on 'TimeInterval's assume this invariant).+-}+data TimeInterval = TimeInterval {-# UNPACK #-} !Time {-# UNPACK #-} !Time+ deriving (Read, Show, Eq, Ord, Bounded)++instance NFData TimeInterval where+ rnf (TimeInterval t1 t2) = t1 `deepseq` t2 `deepseq` ()++-- | Locale-specific formatting for AM and PM.+data MeridiemLocale a = MeridiemLocale+ { meridiemLocaleAm :: !a+ , meridiemLocalePm :: !a+ }+ deriving (Read, Show, Eq, Ord)++instance (NFData a) => NFData (MeridiemLocale a) where+ rnf (MeridiemLocale am pm) = am `deepseq` pm `deepseq` ()++newtype instance UVector.MVector s Month = MV_Month (PVector.MVector s Month)+newtype instance UVector.Vector Month = V_Month (PVector.Vector Month)++instance UVector.Unbox Month++instance MGVector.MVector UVector.MVector Month where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicInitialize #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MV_Month v) = MGVector.basicLength v+ basicUnsafeSlice i n (MV_Month v) = MV_Month $ MGVector.basicUnsafeSlice i n v+ basicOverlaps (MV_Month v1) (MV_Month v2) = MGVector.basicOverlaps v1 v2+ basicUnsafeNew n = MV_Month `liftM` MGVector.basicUnsafeNew n+ basicInitialize (MV_Month v) = MGVector.basicInitialize v+ basicUnsafeReplicate n x = MV_Month `liftM` MGVector.basicUnsafeReplicate n x+ basicUnsafeRead (MV_Month v) i = MGVector.basicUnsafeRead v i+ basicUnsafeWrite (MV_Month v) i x = MGVector.basicUnsafeWrite v i x+ basicClear (MV_Month v) = MGVector.basicClear v+ basicSet (MV_Month v) x = MGVector.basicSet v x+ basicUnsafeCopy (MV_Month v1) (MV_Month v2) = MGVector.basicUnsafeCopy v1 v2+ basicUnsafeMove (MV_Month v1) (MV_Month v2) = MGVector.basicUnsafeMove v1 v2+ basicUnsafeGrow (MV_Month v) n = MV_Month `liftM` MGVector.basicUnsafeGrow v n++instance GVector.Vector UVector.Vector Month where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MV_Month v) = V_Month `liftM` GVector.basicUnsafeFreeze v+ basicUnsafeThaw (V_Month v) = MV_Month `liftM` GVector.basicUnsafeThaw v+ basicLength (V_Month v) = GVector.basicLength v+ basicUnsafeSlice i n (V_Month v) = V_Month $ GVector.basicUnsafeSlice i n v+ basicUnsafeIndexM (V_Month v) i = GVector.basicUnsafeIndexM v i+ basicUnsafeCopy (MV_Month mv) (V_Month v) = GVector.basicUnsafeCopy mv v+ elemseq _ = seq++newtype instance UVector.MVector s DayOfMonth = MV_DayOfMonth (PVector.MVector s DayOfMonth)+newtype instance UVector.Vector DayOfMonth = V_DayOfMonth (PVector.Vector DayOfMonth)++instance UVector.Unbox DayOfMonth++instance MGVector.MVector UVector.MVector DayOfMonth where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicInitialize #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MV_DayOfMonth v) = MGVector.basicLength v+ basicUnsafeSlice i n (MV_DayOfMonth v) = MV_DayOfMonth $ MGVector.basicUnsafeSlice i n v+ basicOverlaps (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicOverlaps v1 v2+ basicUnsafeNew n = MV_DayOfMonth `liftM` MGVector.basicUnsafeNew n+ basicInitialize (MV_DayOfMonth v) = MGVector.basicInitialize v+ basicUnsafeReplicate n x = MV_DayOfMonth `liftM` MGVector.basicUnsafeReplicate n x+ basicUnsafeRead (MV_DayOfMonth v) i = MGVector.basicUnsafeRead v i+ basicUnsafeWrite (MV_DayOfMonth v) i x = MGVector.basicUnsafeWrite v i x+ basicClear (MV_DayOfMonth v) = MGVector.basicClear v+ basicSet (MV_DayOfMonth v) x = MGVector.basicSet v x+ basicUnsafeCopy (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicUnsafeCopy v1 v2+ basicUnsafeMove (MV_DayOfMonth v1) (MV_DayOfMonth v2) = MGVector.basicUnsafeMove v1 v2+ basicUnsafeGrow (MV_DayOfMonth v) n = MV_DayOfMonth `liftM` MGVector.basicUnsafeGrow v n++instance GVector.Vector UVector.Vector DayOfMonth where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MV_DayOfMonth v) = V_DayOfMonth `liftM` GVector.basicUnsafeFreeze v+ basicUnsafeThaw (V_DayOfMonth v) = MV_DayOfMonth `liftM` GVector.basicUnsafeThaw v+ basicLength (V_DayOfMonth v) = GVector.basicLength v+ basicUnsafeSlice i n (V_DayOfMonth v) = V_DayOfMonth $ GVector.basicUnsafeSlice i n v+ basicUnsafeIndexM (V_DayOfMonth v) i = GVector.basicUnsafeIndexM v i+ basicUnsafeCopy (MV_DayOfMonth mv) (V_DayOfMonth v) = GVector.basicUnsafeCopy mv v+ elemseq _ = seq++------------------------+-- The Torsor and Enum instances for Date and OrdinalDate+-- are both bad. This only causes problems for dates+-- at least a million years in the future. Some of this+-- badness is caused by pragmatism, and some of it is caused by+-- my own laziness.+--+-- The badness that comes from pragmatism:+-- - Int technically is not a good delta for Date. Date+-- has too many inhabitants. If we subtract the lowest+-- Date from the highest Date, we get something too+-- big to fit in a machine integer.+-- - There is no good way to write fromEnum or toEnum for+-- Date. Again, Date has more inhabitants than Int, so+-- it simply cannot be done.+-- The badness that comes from laziness:+-- - Technically, we should still be able to add deltas to+-- Dates that do not fit in machine integers. We should+-- also be able to correctly subtract Dates to cannot+-- fit in machine integers.+-- - For similar reasons, the Enum functions succ, pred,+-- enumFromThen, enumFromThenTo, etc. could all have+-- better definitions than the default ones currently+-- used.+-- If, for some reason, anyone ever wants to fix the badness+-- that comes from laziness, all+-- you really have to do is define a version of dateToDay,+-- dayToDate, ordinalDateToDay, and dayToOrdinalDate+-- that uses something bigger instead of Day. Maybe something like+-- (Int,Word) or (Int,Word,Word). I'm not exactly sure how+-- big it would need to be to work correctly. Then you could+-- handle deltas of two very far off days correctly, provided+-- that the two days weren't also super far from each other.+--+------------------------+instance Torsor Date Int where+ add i d = dayToDate (add i (dateToDay d))+ difference a b = difference (dateToDay a) (dateToDay b)++instance Torsor OrdinalDate Int where+ add i d = dayToOrdinalDate (add i (ordinalDateToDay d))+ difference a b = difference (ordinalDateToDay a) (ordinalDateToDay b)++instance Enum Date where+ fromEnum d = fromEnum (dateToDay d)+ toEnum i = dayToDate (toEnum i)++instance Enum OrdinalDate where+ fromEnum d = fromEnum (ordinalDateToDay d)+ toEnum i = dayToOrdinalDate (toEnum i)++instance ToJSON Datetime where+ toJSON = AE.String . encode_YmdHMS SubsecondPrecisionAuto hyphen+ toEncoding x = AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderUtf8_YmdHMS SubsecondPrecisionAuto hyphen x SG.<> BB.char7 '"')++instance FromJSON Datetime where+ parseJSON =+ AE.withText "Datetime" aesonParserDatetime++aesonParserDatetime :: Text -> AET.Parser Datetime+aesonParserDatetime =+ either (const (fail "could not parse Datetime")) pure . AT.parseOnly (parser_lenient <* AT.endOfInput)++instance ToJSON Offset where+ toJSON = AE.String . encodeOffset OffsetFormatColonOn+ toEncoding x = AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderOffsetUtf8 OffsetFormatColonOn x SG.<> BB.char7 '"')++instance FromJSON Offset where+ parseJSON = AE.withText "Offset" aesonParserOffset++instance ToJSONKey Offset where+ toJSONKey =+ AE.ToJSONKeyText+ (keyFromText . encodeOffset OffsetFormatColonOn)+ (\x -> AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderOffsetUtf8 OffsetFormatColonOn x SG.<> BB.char7 '"'))+ where+#if MIN_VERSION_aeson(2,0,0)+ keyFromText = AK.fromText+#else+ keyFromText = id+#endif++instance FromJSONKey Offset where+ fromJSONKey = AE.FromJSONKeyTextParser aesonParserOffset++aesonParserOffset :: Text -> AET.Parser Offset+aesonParserOffset t = case decodeOffset OffsetFormatColonOn t of+ Nothing -> fail "could not parse Offset"+ Just x -> pure x++{- | Holds all of the parts encoded by a 'Time'.+ Can be used for formatting if what is presently in the API+ does not suffice.+-}+data TimeParts = TimeParts+ { timePartsDay :: !Int+ -- ^ days 0-31+ , timePartsMonth :: !Int+ -- ^ months 0-11+ , timePartsYear :: !Int+ , timePartsHour :: !Int+ -- ^ hours 0-23+ , timePartsMinute :: !Int+ -- ^ minutes 0-59+ , timePartsSecond :: !Int+ -- ^ seconds 0-59+ , timePartsSubsecond :: !Int+ -- ^ fraction of a second with nanosecond resolution+ , timePartsOffset :: !Int+ }+ deriving (Eq, Read, Show)++instance NFData TimeParts where+ rnf (TimeParts d mo y h m s ss o) =+ d `deepseq` mo `deepseq` y `deepseq` h `deepseq` m `deepseq` s `deepseq` ss `deepseq` o `deepseq` ()++-- | Deconstruct a 'Time' into its 'TimeParts'.+timeParts :: Offset -> Time -> TimeParts+timeParts o0 t0 =+ let+ OffsetDatetime (Datetime dt t) o = timeToOffsetDatetime o0 t0+ Date y mo d = dt+ TimeOfDay h mi s = t+ (wholeSeconds, subsecond) = divMod s 100000000+ in+ TimeParts+ { timePartsDay = fromIntegral (getDayOfMonth d)+ , timePartsMonth = fromIntegral (getMonth mo)+ , timePartsYear = fromIntegral (getYear y)+ , timePartsHour = h+ , timePartsMinute = mi+ , timePartsSecond = fromIntegral wholeSeconds+ , timePartsSubsecond = fromIntegral subsecond+ , timePartsOffset = getOffset o+ }++{- | Decode an ISO-8601-encode datetime. The encoded time must be suffixed+by either @Z@ or @+00:00@ or @+00@.+-}+decodeIso8601Zulu :: Text -> Maybe Chronos.Datetime+{-# INLINE decodeIso8601Zulu #-}+decodeIso8601Zulu !t =+ BVP.parseBytesMaybe parserIso8601Zulu (Utf8.fromText t)++{- | Decode an ISO-8601-encode datetime. The encoded time must be suffixed+by either @Z@ or @+00:00@ or @+00@.+-}+decodeShortTextIso8601Zulu :: ShortText -> Maybe Chronos.Datetime+{-# INLINE decodeShortTextIso8601Zulu #-}+decodeShortTextIso8601Zulu !t =+ BVP.parseBytesMaybe parserIso8601Zulu (Utf8.fromShortText t)++parserIso8601Zulu :: BVP.Parser () s Chronos.Datetime+{-# NOINLINE parserIso8601Zulu #-}+parserIso8601Zulu = do+ d <- parserUtf8BytesIso8601Zoneless 'T'+ remaining <- BVP.remaining+ case Bytes.length remaining of+ 1 | Bytes.unsafeIndex remaining 0 == 0x5A -> pure d+ 3 | Bytes.equalsCString (Ptr "+00"#) remaining -> pure d+ 6 | Bytes.equalsCString (Ptr "+00:00"#) remaining -> pure d+ _ -> BVP.fail ()++{- | Decode an ISO-8601-encode datetime. The encoded time must not be suffixed+by an offset. Any offset (e.g. @-05:00@, @+00:00@, @Z@) will cause a decode+failure.+-}+decodeShortTextIso8601Zoneless :: ShortText -> Maybe Chronos.Datetime+decodeShortTextIso8601Zoneless !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))++-- | Decode an ISO-8601-encode datetime.+decodeUtf8BytesIso8601Zoneless :: Bytes -> Maybe Chronos.Datetime+decodeUtf8BytesIso8601Zoneless !b =+ BVP.parseBytesMaybe (parserUtf8BytesIso8601Zoneless 'T' <* BVP.endOfInput ()) b++{- | Decode a datetime that is nearly ISO-8601-encoded but uses a space+instead of a T to separate the date and the time. For example:+@2022-10-29 14:00:05@.+-}+decodeUtf8BytesIso8601ZonelessSpaced :: Bytes -> Maybe Chronos.Datetime+decodeUtf8BytesIso8601ZonelessSpaced !b =+ BVP.parseBytesMaybe (parserUtf8BytesIso8601Zoneless ' ' <* BVP.endOfInput ()) b++decodeUtf8BytesIso8601 :: Bytes -> Maybe Chronos.OffsetDatetime+decodeUtf8BytesIso8601 !b =+ BVP.parseBytesMaybe (parserUtf8BytesIso8601 <* BVP.endOfInput ()) b++parserUtf8BytesIso8601Zoneless :: Char -> BVP.Parser () s Chronos.Datetime+{-# NOINLINE parserUtf8BytesIso8601Zoneless #-}+parserUtf8BytesIso8601Zoneless !sep = 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 () sep+ 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 'T'+ 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.123+> 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+ _ ->+ let (ms, us) = quotRem ns 1_000_000+ in case us of+ 0 ->+ Bounded.weaken @4 @10+ Lte.constant+ ( Bounded.ascii '.'+ `Bounded.append` Bounded.wordPaddedDec3 (fromIntegral ms)+ )+ _ ->+ 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
src/Chronos/Internal/CTimespec.hs view
@@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-}++#if defined(ghcjs_HOST_OS) {-# LANGUAGE JavaScriptFFI #-}+#endif {-# OPTIONS_HADDOCK hide #-} -- for doctests @@ -7,8 +10,10 @@ ( #ifndef mingw32_HOST_OS getPosixNanoseconds+#ifndef ghcjs_HOST_OS , CTimespec(..) #endif+#endif ) where import Foreign@@ -57,6 +62,8 @@ throwErrnoIfMinus1_ "clock_gettime" $ clock_gettime 0 ptspec peek ptspec- return ((s * 1000000000) + ns)+ -- On most 64-bit platforms, the uses of fromIntegral here end up+ -- being i64->i64, but on 32-bit platforms, they are i32->i64.+ return ((fromIntegral s * 1000000000) + fromIntegral ns) #endif
src/Chronos/Locale/English.hs view
@@ -1,11 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -{-| This module provides some english locale helpers.+{- | This module provides some english locale helpers. It is very incomplete. Please send a pull request- to https://github.com/andrewthad/chronos if you need+ to https://github.com/byteverse/chronos if you need additions to this API.- -}-+-} module Chronos.Locale.English ( lower , upper@@ -19,11 +18,12 @@ import Chronos.Types import Data.Text (Text) --- $setup------ >>> :set -XOverloadedStrings--- >>> import Chronos (january, august, december, october, caseMonth)+{- $setup +>>> :set -XOverloadedStrings+>>> import Chronos (january, august, december, october, caseMonth)+-}+ -- | Lowercase "am"/"pm". lower :: MeridiemLocale Text lower = MeridiemLocale "am" "pm"@@ -40,28 +40,50 @@ upperDots :: MeridiemLocale Text upperDots = MeridiemLocale "A.M." "P.M." --- | Unabbreviated 'Month's of the year.------ >>> caseMonth unabbreviated january--- "January"------ >>> caseMonth unabbreviated december--- "December"+{- | Unabbreviated 'Month's of the year.++ >>> caseMonth unabbreviated january+ "January"++ >>> caseMonth unabbreviated december+ "December"+-} unabbreviated :: MonthMatch Text-unabbreviated = buildMonthMatch- "January" "February" "March" "April"- "May" "June" "July" "August"- "September" "October" "November" "December"+unabbreviated =+ buildMonthMatch+ "January"+ "February"+ "March"+ "April"+ "May"+ "June"+ "July"+ "August"+ "September"+ "October"+ "November"+ "December" --- | Abbreviated 'Month's of the year.------ >>> caseMonth abbreviated october--- "Oct"------ >>> caseMonth abbreviated august--- "Aug"-abbreviated :: MonthMatch Text-abbreviated = buildMonthMatch- "Jan" "Feb" "Mar" "Apr" "May" "Jun"- "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"+{- | Abbreviated 'Month's of the year. + >>> caseMonth abbreviated october+ "Oct"++ >>> caseMonth abbreviated august+ "Aug"+-}+abbreviated :: MonthMatch Text+abbreviated =+ buildMonthMatch+ "Jan"+ "Feb"+ "Mar"+ "Apr"+ "May"+ "Jun"+ "Jul"+ "Aug"+ "Sep"+ "Oct"+ "Nov"+ "Dec"
src/Chronos/Types.hs view
@@ -24,35 +24,33 @@ corruption of data if the user is trying to use out-of-bounds values for the month and the day. Users are advised to not use the data types provided here to model non-existent times.- -}- module Chronos.Types- ( Day(..)- , DayOfWeek(..)- , DayOfMonth(..)- , DayOfYear(..)- , Month(..)- , Year(..)- , Offset(..)- , Time(..)- , DayOfWeekMatch(..)- , MonthMatch(..)- , UnboxedMonthMatch(..)- , Timespan(..)- , SubsecondPrecision(..)- , Date(..)- , OrdinalDate(..)- , MonthDate(..)- , Datetime(..)- , OffsetDatetime(..)- , TimeOfDay(..)- , DatetimeFormat(..)- , OffsetFormat(..)- , DatetimeLocale(..)- , MeridiemLocale(..)- , TimeInterval(..)- , TimeParts(..)+ ( Day (..)+ , DayOfWeek (..)+ , DayOfMonth (..)+ , DayOfYear (..)+ , Month (..)+ , Year (..)+ , Offset (..)+ , Time (..)+ , DayOfWeekMatch (..)+ , MonthMatch (..)+ , UnboxedMonthMatch (..)+ , Timespan (..)+ , SubsecondPrecision (..)+ , Date (..)+ , OrdinalDate (..)+ , MonthDate (..)+ , Datetime (..)+ , OffsetDatetime (..)+ , TimeOfDay (..)+ , DatetimeFormat (..)+ , OffsetFormat (..)+ , DatetimeLocale (..)+ , MeridiemLocale (..)+ , TimeInterval (..)+ , TimeParts (..) ) where import Chronos
− test/Doctests.hs
@@ -1,8 +0,0 @@-import Test.DocTest--main :: IO ()-main = doctest- [ "-isrc"- , "src/Chronos.hs"- , "src/Chronos/Locale/English.hs"- ]
test/Spec.hs view
@@ -1,398 +1,926 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies #-}--module Main (main) where--import Chronos.Types-import Data.ByteString (ByteString)-import Data.Int (Int64)-import Data.List (intercalate)-import Data.Text (Text)-import Data.Text.Lazy.Builder (Builder)-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.Property (failed,succeeded,Result(..))-import qualified Chronos as C-import qualified Data.Attoparsec.ByteString as AttoBS-import qualified Data.Attoparsec.Text as Atto-import qualified Data.ByteString.Builder as BBuilder-import qualified Data.ByteString.Lazy as LByteString-import qualified Data.Text as Text-import qualified Data.Text.Lazy as LText-import qualified Data.Text.Lazy.Builder as Builder-import qualified Test.Framework as TF-import qualified Test.Framework.Providers.HUnit as PH-import qualified Torsor as T---- We increase the default number of property-based tests (provided--- by quickcheck) to 1000. Some of the encoding and decoding functions--- we test have special behavior when the minute is zero, which only--- happens in 1/60 of the generated scenarios. If we only generate 100--- scenarios, there is a 18.62% chance that none of these will have zero--- as the minute. If we increase this to 1000, that probability drops to--- almost nothing.-main :: IO ()-main = defaultMainWithOpts tests mempty- { TF.ropt_test_options = Just mempty- { TF.topt_maximum_generated_tests = Just 1000- , TF.topt_maximum_unsuitable_generated_tests = Just 10000- }- }--tests :: [Test]-tests =- [ testGroup "Time of Day"- [ testGroup "Text"- [ testGroup "Text Parsing Spec Tests"- [ PH.testCase "No Separator + microseconds"- (timeOfDayParse Nothing "165956.246052" (TimeOfDay 16 59 56246052000))- , PH.testCase "Separator + microseconds"- (timeOfDayParse (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))- , PH.testCase "Separator + milliseconds"- (timeOfDayParse (Just ':') "05:00:58.675" (TimeOfDay 05 00 58675000000))- , PH.testCase "Separator + deciseconds"- (timeOfDayParse (Just ':') "05:00:58.9" (TimeOfDay 05 00 58900000000))- , PH.testCase "Separator + no subseconds"- (timeOfDayParse (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))- , PH.testCase "Separator + nanoseconds"- (timeOfDayParse (Just ':') "05:00:58.111222999" (TimeOfDay 05 00 58111222999))- , PH.testCase "Separator + 10e-18 seconds (truncate)"- (timeOfDayParse (Just ':') "05:00:58.111222333444555666" (TimeOfDay 05 00 58111222333))- , PH.testCase "Separator + opt seconds (absent)"- (parseMatch (C.parser_HMS_opt_S (Just ':')) "00:01" (TimeOfDay 0 1 0))- , PH.testCase "Separator + opt seconds (present)"- (parseMatch (C.parser_HMS_opt_S (Just ':')) "00:01:05" (TimeOfDay 0 1 5000000000))- , PH.testCase "No Separator + opt seconds (absent)"- (parseMatch (C.parser_HMS_opt_S Nothing) "0001" (TimeOfDay 0 1 0))- , PH.testCase "No Separator + opt seconds (present)"- (parseMatch (C.parser_HMS_opt_S Nothing) "000105" (TimeOfDay 0 1 5000000000))- ]- , testGroup "Text Builder Spec Tests"- [ PH.testCase "No Separator + microseconds"- (timeOfDayBuilder (SubsecondPrecisionFixed 6) Nothing "165956.246052" (TimeOfDay 16 59 56246052000))- , PH.testCase "Separator + microseconds"- (timeOfDayBuilder (SubsecondPrecisionFixed 6) (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))- , PH.testCase "Separator + no subseconds"- (timeOfDayBuilder (SubsecondPrecisionFixed 0) (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))- ]- , testProperty "Text Builder Parser Isomorphism (H:M:S)" $ propEncodeDecodeIso- (LText.toStrict . Builder.toLazyText . C.builder_HMS (SubsecondPrecisionFixed 9) (Just ':'))- (either (const Nothing) Just . Atto.parseOnly (C.parser_HMS (Just ':')))- ]- , testGroup "ByteString"- [ testGroup "Parser Spec Tests"- [ PH.testCase "No Separator + microseconds"- (bsTimeOfDayParse Nothing "165956.246052" (TimeOfDay 16 59 56246052000))- , PH.testCase "Separator + microseconds"- (bsTimeOfDayParse (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))- , PH.testCase "Separator + milliseconds"- (bsTimeOfDayParse (Just ':') "05:00:58.675" (TimeOfDay 05 00 58675000000))- , PH.testCase "Separator + deciseconds"- (bsTimeOfDayParse (Just ':') "05:00:58.9" (TimeOfDay 05 00 58900000000))- , PH.testCase "Separator + no subseconds"- (bsTimeOfDayParse (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))- , PH.testCase "Separator + nanoseconds"- (bsTimeOfDayParse (Just ':') "05:00:58.111222999" (TimeOfDay 05 00 58111222999))- , PH.testCase "Separator + 10e-18 seconds (truncate)"- (bsTimeOfDayParse (Just ':') "05:00:58.111222333444555666" (TimeOfDay 05 00 58111222333))- , PH.testCase "Separator + opt seconds (absent)"- (bsParseMatch (C.parserUtf8_HMS_opt_S (Just ':')) "00:01" (TimeOfDay 0 1 0))- , PH.testCase "Separator + opt seconds (present)"- (bsParseMatch (C.parserUtf8_HMS_opt_S (Just ':')) "00:01:05" (TimeOfDay 0 1 5000000000))- , PH.testCase "No Separator + opt seconds (absent)"- (bsParseMatch (C.parserUtf8_HMS_opt_S Nothing) "0001" (TimeOfDay 0 1 0))- , PH.testCase "No Separator + opt seconds (present)"- (bsParseMatch (C.parserUtf8_HMS_opt_S Nothing) "000105" (TimeOfDay 0 1 5000000000))- ]- , testGroup "Builder Spec Tests"- [ PH.testCase "No Separator + microseconds"- (bsTimeOfDayBuilder (SubsecondPrecisionFixed 6) Nothing "165956.246052" (TimeOfDay 16 59 56246052000))- , PH.testCase "Separator + microseconds"- (bsTimeOfDayBuilder (SubsecondPrecisionFixed 6) (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))- , PH.testCase "Separator + no subseconds"- (bsTimeOfDayBuilder (SubsecondPrecisionFixed 0) (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))- ]- , testProperty "Builder Parser Isomorphism (H:M:S)" $ propEncodeDecodeIso- (LByteString.toStrict . BBuilder.toLazyByteString . C.builderUtf8_HMS (SubsecondPrecisionFixed 9) (Just ':'))- (either (const Nothing) Just . AttoBS.parseOnly (C.parserUtf8_HMS (Just ':')))- ]- ]- , testGroup "Date"- [ testGroup "Parser Spec Tests" $- [ PH.testCase "No Separator"- (dateParse Nothing "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1)))- , PH.testCase "Separator 1"- (dateParse (Just '-') "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1)))- , PH.testCase "Separator 2"- (dateParse (Just '-') "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27)))- ]- , testGroup "Builder Spec Tests" $- [ PH.testCase "No Separator"- (dateBuilder Nothing "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1)))- , PH.testCase "Separator 1"- (dateBuilder (Just '-') "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1)))- , PH.testCase "Separator 2"- (dateBuilder (Just '-') "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27)))- ]- , testProperty "Builder Parser Isomorphism (Y-m-d)" $ propEncodeDecodeIso- (LText.toStrict . Builder.toLazyText . C.builder_Ymd (Just '-'))- (either (const Nothing) Just . Atto.parseOnly (C.parser_Ymd (Just '-')))- ]- , testGroup "Datetime"- [ testProperty "Builder Parser Isomorphism (Y-m-dTH:M:S)" $ propEncodeDecodeIsoSettings- (\format -> LText.toStrict . Builder.toLazyText . C.builder_YmdHMS (SubsecondPrecisionFixed 9) format)- (\format -> either (const Nothing) Just . Atto.parseOnly (C.parser_YmdHMS format))- , testProperty "Builder Parser Isomorphism (YmdHMS)" $ propEncodeDecodeIso- (LText.toStrict . Builder.toLazyText . C.builder_YmdHMS (SubsecondPrecisionFixed 9) (DatetimeFormat Nothing Nothing Nothing))- (either (const Nothing) Just . Atto.parseOnly (C.parser_YmdHMS (DatetimeFormat Nothing Nothing Nothing)))- ]- , testGroup "Offset Datetime"- [ testGroup "Builder Spec Tests" $- [ PH.testCase "W3C" $ matchBuilder "1997-07-16T19:20:30.450+01:00" $- C.builderW3Cz $ OffsetDatetime- ( Datetime- ( Date (Year 1997) C.july (DayOfMonth 16) )- ( TimeOfDay 19 20 30450000000 )- ) (Offset 60)- ]- , testProperty "Builder Parser Isomorphism (YmdHMSz)" $ propEncodeDecodeIsoSettings- (\(offsetFormat,datetimeFormat) offsetDatetime ->- LText.toStrict $ Builder.toLazyText $- C.builder_YmdHMSz offsetFormat (SubsecondPrecisionFixed 9) datetimeFormat offsetDatetime- )- (\(offsetFormat,datetimeFormat) input ->- either (const Nothing) Just $ flip Atto.parseOnly input $- C.parser_YmdHMSz offsetFormat datetimeFormat- )- ]- , testGroup "Posix Time"- [ PH.testCase "Get now" $ do- now <- C.now- assertBool "Current time is the beginning of the epoch." (now /= C.epoch)- ]- , testGroup "Conversion"- [ testGroup "POSIX to Datetime"- [ PH.testCase "Epoch" $ C.timeToDatetime (Time 0)- @?= Datetime (Date (Year 1970) C.january (DayOfMonth 1))- (TimeOfDay 0 0 0)- , PH.testCase "Billion Seconds" $ C.timeToDatetime (Time $ 10 ^ 18)- @?= Datetime (Date (Year 2001) C.september (DayOfMonth 9))- (TimeOfDay 1 46 (40 * 10 ^ 9))- , testProperty "Isomorphism" $ propEncodeDecodeFullIso C.timeToDatetime C.datetimeToTime- ]- ]- , testGroup "TimeInterval"- [ testGroup "within"- [ testProperty "Verify that Time bounds are inside TimeInterval" propWithinInsideInterval- , testProperty "Verify that the sum of Time and the span of TimeInterval is outside the interval"- propWithinOutsideInterval- ]- , testGroup "timeIntervalToTimespan"- [ PH.testCase "Verify Timespan correctness with TimeInterval"- (C.timeIntervalToTimespan (TimeInterval (Time 13) (Time 25)) @?= Timespan 12)- , PH.testCase "Verify Timespan correctness with equal TimeInterval bounds"- (C.timeIntervalToTimespan (TimeInterval (Time 13) (Time 13)) @?= Timespan 0)- , testProperty "Almost isomorphism" propEncodeDecodeTimeInterval- ]- , testGroup "whole"- [ PH.testCase "Verify TimeInterval's bound correctness"- (C.whole @?= TimeInterval (Time (minBound :: Int64)) (Time (maxBound :: Int64)))- ]- , testGroup "singleton"- [ testProperty "Verify that upper and lower bound are always equals" propSingletonBoundsEquals- ]- , testGroup "width"- [ testProperty "Verify Time bounds correctness with TimeSpan" propWidthVerifyBounds- ]- , testGroup "timeIntervalBuilder"- [ testProperty "Verify TimeInterval construction correctness" propTimeIntervalBuilder- ]- ]- ]--failure :: String -> Result-failure msg = failed- { reason = msg- , theException = Nothing- }--propEncodeDecodeFullIso :: (Eq a,Show a,Show b) => (a -> b) -> (b -> a) -> a -> Result-propEncodeDecodeFullIso f g a =- let fa = f a- gfa = g fa- in if gfa == a- then succeeded- else failure $ concat- [ "x: ", show a, "\n"- , "f(x): ", show fa, "\n"- , "g(f(x)): ", show gfa, "\n"- ]--propEncodeDecodeIso :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool-propEncodeDecodeIso f g a = g (f a) == Just a--propEncodeDecodeIsoSettings :: (Eq a,Show a,Show b,Show e)- => (e -> a -> b) -> (e -> b -> Maybe a) -> e -> a -> Result-propEncodeDecodeIsoSettings f g e a =- let fa = f e a- gfa = g e fa- in if gfa == Just a- then succeeded- else failure $ concat- [ "env: ", show e, "\n"- , "x: ", show a, "\n"- , "f(x): ", show fa, "\n"- , "g(f(x)): ", show gfa, "\n"- ]--parseMatch :: (Eq a, Show a) => Atto.Parser a -> Text -> a -> Assertion-parseMatch p t expected = do- Atto.parseOnly (p <* Atto.endOfInput) t- @?= Right expected--bsParseMatch :: (Eq a, Show a) => AttoBS.Parser a -> ByteString -> a -> Assertion-bsParseMatch p t expected = do- AttoBS.parseOnly (p <* AttoBS.endOfInput) t- @?= Right expected--timeOfDayParse :: Maybe Char -> Text -> TimeOfDay -> Assertion-timeOfDayParse m t expected =- Atto.parseOnly (C.parser_HMS m <* Atto.endOfInput) t- @?= Right expected--bsTimeOfDayParse :: Maybe Char -> ByteString -> TimeOfDay -> Assertion-bsTimeOfDayParse m t expected =- AttoBS.parseOnly (C.parserUtf8_HMS m <* AttoBS.endOfInput) t- @?= Right expected--timeOfDayBuilder :: SubsecondPrecision -> Maybe Char -> Text -> TimeOfDay -> Assertion-timeOfDayBuilder sp m expected tod =- LText.toStrict (Builder.toLazyText (C.builder_HMS sp m tod))- @?= expected--bsTimeOfDayBuilder :: SubsecondPrecision -> Maybe Char -> Text -> TimeOfDay -> Assertion-bsTimeOfDayBuilder sp m expected tod =- LText.toStrict (Builder.toLazyText (C.builder_HMS sp m tod))- @?= expected--dateParse :: Maybe Char -> Text -> Date -> Assertion-dateParse m t expected =- Atto.parseOnly (C.parser_Ymd m <* Atto.endOfInput) t- @?= Right expected--dateBuilder :: Maybe Char -> Text -> Date -> Assertion-dateBuilder m expected tod =- LText.toStrict (Builder.toLazyText (C.builder_Ymd m tod))- @?= expected--matchBuilder :: Text -> Builder -> Assertion-matchBuilder a b = LText.toStrict (Builder.toLazyText b) @?= a--propWithinInsideInterval :: TimeInterval -> Bool-propWithinInsideInterval ti@(TimeInterval t0 t1) = C.within t1 ti && C.within t0 ti--propWithinOutsideInterval :: RelatedTimes -> Bool-propWithinOutsideInterval (RelatedTimes t ti@(TimeInterval t0 t1))- | t == t0 = discard- | t == t1 = discard- | t1 <= t0 = discard- | t0 < (Time 0) = discard- | t < (Time 0) = discard- | otherwise =- let- span = C.timeIntervalToTimespan ti- tm = T.add span t- in- not $ C.within tm ti--propEncodeDecodeTimeInterval :: TimeInterval -> Bool-propEncodeDecodeTimeInterval ti@(TimeInterval t0 t1)- | t0 < (Time 0) = discard- | t0 >= t1 = discard- | otherwise =- let- span = C.timeIntervalToTimespan ti- tm = T.add span t0- in- t1 == tm--propSingletonBoundsEquals :: Time -> Bool-propSingletonBoundsEquals tm =- let- (TimeInterval (Time ti) (Time te)) = C.singleton tm- in- ti == te--propWidthVerifyBounds :: TimeInterval -> Bool-propWidthVerifyBounds ti@(TimeInterval (Time lower) (Time upper)) =- let- tiWidth = (getTimespan . C.width) ti- in- T.add lower tiWidth == upper && T.difference upper tiWidth == lower--propTimeIntervalBuilder :: Time -> Time -> Bool-propTimeIntervalBuilder t0 t1 =- let- (TimeInterval ti te) = (C.timeIntervalBuilder t0 t1)- in- (getTime te) >= (getTime ti)--instance Arbitrary TimeOfDay where- arbitrary = TimeOfDay- <$> choose (0,23)- <*> choose (0,59)- -- never use leap seconds for property-based tests- <*> choose (0,60000000000 - 1)--instance Arbitrary Date where- arbitrary = Date- <$> fmap Year (choose (1800,2100))- <*> fmap Month (choose (0,11))- <*> fmap DayOfMonth (choose (1,28))--instance Arbitrary Datetime where- arbitrary = Datetime <$> arbitrary <*> arbitrary---- instance Arbitrary UtcTime where--- arbitrary = UtcTime--- <$> fmap Day (choose (-100000,100000))--- <*> choose (0,24 * 60 * 60 * 1000000000 - 1)--instance Arbitrary OffsetDatetime where- arbitrary = OffsetDatetime- <$> arbitrary- <*> arbitrary--instance Arbitrary DatetimeFormat where- arbitrary = DatetimeFormat- <$> arbitrary- <*> elements [Nothing, Just '/', Just ':', Just '-']- <*> arbitrary--instance Arbitrary OffsetFormat where- arbitrary = arbitraryBoundedEnum- shrink = genericShrink--deriving instance Arbitrary Time--instance Arbitrary TimeInterval where- arbitrary = do- t0 <- arbitrary- t1 <- suchThat arbitrary (>= t0)- pure (TimeInterval t0 t1)--data RelatedTimes = RelatedTimes Time TimeInterval- deriving (Show)--instance Arbitrary RelatedTimes where- arbitrary = do- ti@(TimeInterval t0 t1) <- arbitrary- tm <- fmap Time (choose (getTime t0, getTime t1))- pure $ RelatedTimes tm ti+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Main (main) where++import qualified Chronos as C+import Chronos.Types+import qualified Data.Aeson as AE+import qualified Data.Attoparsec.ByteString as AttoBS+import qualified Data.Attoparsec.Text as Atto+import Data.ByteString (ByteString)+import qualified Data.ByteString.Builder as BBuilder+import qualified Data.ByteString.Lazy as LByteString+import Data.Int (Int64)+import Data.Text (Text)+import qualified Data.Text.Lazy as LText+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as Builder+import Test.Framework (Test, defaultMainWithOpts, testGroup)+import qualified Test.Framework as TF+import qualified Test.Framework.Providers.HUnit as PH+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit (Assertion, assertBool, (@?=))+import Test.QuickCheck (Arbitrary (..), arbitraryBoundedEnum, choose, chooseInt, discard, elements, genericShrink, suchThat)+import Test.QuickCheck.Property (Result (..), failed, succeeded)+import qualified Torsor as T++-- We increase the default number of property-based tests (provided+-- by quickcheck) to 1000. Some of the encoding and decoding functions+-- we test have special behavior when the minute is zero, which only+-- happens in 1/60 of the generated scenarios. If we only generate 100+-- scenarios, there is a 18.62% chance that none of these will have zero+-- as the minute. If we increase this to 1000, that probability drops to+-- almost nothing.+main :: IO ()+main =+ defaultMainWithOpts+ tests+ mempty+ { TF.ropt_test_options =+ Just+ mempty+ { TF.topt_maximum_generated_tests = Just 1000+ , TF.topt_maximum_unsuitable_generated_tests = Just 10000+ }+ }++tests :: [Test]+tests =+ [ testGroup+ "Time of Day"+ [ testGroup+ "Text"+ [ testGroup+ "Text Parsing Spec Tests"+ [ PH.testCase+ "No Separator + microseconds"+ (timeOfDayParse Nothing "165956.246052" (TimeOfDay 16 59 56246052000))+ , PH.testCase+ "Separator + microseconds"+ (timeOfDayParse (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))+ , PH.testCase+ "Separator + milliseconds"+ (timeOfDayParse (Just ':') "05:00:58.675" (TimeOfDay 05 00 58675000000))+ , PH.testCase+ "Separator + deciseconds"+ (timeOfDayParse (Just ':') "05:00:58.9" (TimeOfDay 05 00 58900000000))+ , PH.testCase+ "Separator + no subseconds"+ (timeOfDayParse (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))+ , PH.testCase+ "Separator + nanoseconds"+ (timeOfDayParse (Just ':') "05:00:58.111222999" (TimeOfDay 05 00 58111222999))+ , PH.testCase+ "Separator + 10e-18 seconds (truncate)"+ (timeOfDayParse (Just ':') "05:00:58.111222333444555666" (TimeOfDay 05 00 58111222333))+ , PH.testCase+ "Separator + opt seconds (absent)"+ (parseMatch (C.parser_HMS_opt_S (Just ':')) "00:01" (TimeOfDay 0 1 0))+ , PH.testCase+ "Separator + opt seconds (present)"+ (parseMatch (C.parser_HMS_opt_S (Just ':')) "00:01:05" (TimeOfDay 0 1 5000000000))+ , PH.testCase+ "No Separator + opt seconds (absent)"+ (parseMatch (C.parser_HMS_opt_S Nothing) "0001" (TimeOfDay 0 1 0))+ , PH.testCase+ "No Separator + opt seconds (present)"+ (parseMatch (C.parser_HMS_opt_S Nothing) "000105" (TimeOfDay 0 1 5000000000))+ ]+ , testGroup+ "Text Builder Spec Tests"+ [ PH.testCase+ "No Separator + microseconds"+ (timeOfDayBuilder (SubsecondPrecisionFixed 6) Nothing "165956.246052" (TimeOfDay 16 59 56246052000))+ , PH.testCase+ "Separator + microseconds"+ (timeOfDayBuilder (SubsecondPrecisionFixed 6) (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))+ , PH.testCase+ "Separator + no subseconds"+ (timeOfDayBuilder (SubsecondPrecisionFixed 0) (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))+ ]+ , testProperty "Text Builder Parser Isomorphism (H:M:S)" $+ propEncodeDecodeIso+ (LText.toStrict . Builder.toLazyText . C.builder_HMS (SubsecondPrecisionFixed 9) (Just ':'))+ (either (const Nothing) Just . Atto.parseOnly (C.parser_HMS (Just ':')))+ ]+ , testGroup+ "ByteString"+ [ testGroup+ "Parser Spec Tests"+ [ PH.testCase+ "No Separator + microseconds"+ (bsTimeOfDayParse Nothing "165956.246052" (TimeOfDay 16 59 56246052000))+ , PH.testCase+ "Separator + microseconds"+ (bsTimeOfDayParse (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))+ , PH.testCase+ "Separator + milliseconds"+ (bsTimeOfDayParse (Just ':') "05:00:58.675" (TimeOfDay 05 00 58675000000))+ , PH.testCase+ "Separator + deciseconds"+ (bsTimeOfDayParse (Just ':') "05:00:58.9" (TimeOfDay 05 00 58900000000))+ , PH.testCase+ "Separator + no subseconds"+ (bsTimeOfDayParse (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))+ , PH.testCase+ "Separator + nanoseconds"+ (bsTimeOfDayParse (Just ':') "05:00:58.111222999" (TimeOfDay 05 00 58111222999))+ , PH.testCase+ "Separator + 10e-18 seconds (truncate)"+ (bsTimeOfDayParse (Just ':') "05:00:58.111222333444555666" (TimeOfDay 05 00 58111222333))+ , PH.testCase+ "Separator + opt seconds (absent)"+ (bsParseMatch (C.parserUtf8_HMS_opt_S (Just ':')) "00:01" (TimeOfDay 0 1 0))+ , PH.testCase+ "Separator + opt seconds (present)"+ (bsParseMatch (C.parserUtf8_HMS_opt_S (Just ':')) "00:01:05" (TimeOfDay 0 1 5000000000))+ , PH.testCase+ "No Separator + opt seconds (absent)"+ (bsParseMatch (C.parserUtf8_HMS_opt_S Nothing) "0001" (TimeOfDay 0 1 0))+ , PH.testCase+ "No Separator + opt seconds (present)"+ (bsParseMatch (C.parserUtf8_HMS_opt_S Nothing) "000105" (TimeOfDay 0 1 5000000000))+ ]+ , testGroup+ "Builder Spec Tests"+ [ PH.testCase+ "No Separator + microseconds"+ (bsTimeOfDayBuilder (SubsecondPrecisionFixed 6) Nothing "165956.246052" (TimeOfDay 16 59 56246052000))+ , PH.testCase+ "Separator + microseconds"+ (bsTimeOfDayBuilder (SubsecondPrecisionFixed 6) (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000))+ , PH.testCase+ "Separator + no subseconds"+ (bsTimeOfDayBuilder (SubsecondPrecisionFixed 0) (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000))+ ]+ , testProperty "Builder Parser Isomorphism (H:M:S)" $+ propEncodeDecodeIso+ (LByteString.toStrict . BBuilder.toLazyByteString . C.builderUtf8_HMS (SubsecondPrecisionFixed 9) (Just ':'))+ (either (const Nothing) Just . AttoBS.parseOnly (C.parserUtf8_HMS (Just ':')))+ ]+ ]+ , testGroup+ "Date"+ [ testGroup "Ymd Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ (dateParse (C.parser_Ymd Nothing) "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Passes With Separator 1"+ (dateParse (C.parser_Ymd (Just '-')) "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Passes With Separator 2"+ (dateParse (C.parser_Ymd (Just '-')) "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27)))+ ]+ , testGroup "Dmy Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ (dateParse (C.parser_Dmy Nothing) "01012016" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Passes With Separator 1"+ (dateParse (C.parser_Dmy (Just '-')) "01-01-2016" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Passes With Separator 2"+ (dateParse (C.parser_Dmy (Just '-')) "27-09-1876" (Date (Year 1876) (Month 8) (DayOfMonth 27)))+ ]+ , testGroup "Ymd Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ (dateParse C.parser_Ymd_lenient "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Passes With Separator 1"+ (dateParse C.parser_Ymd_lenient "2016!01@01" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Passes With Separator 2"+ (dateParse C.parser_Ymd_lenient "1876z09+27" (Date (Year 1876) (Month 8) (DayOfMonth 27)))+ ]+ , testGroup "Dmy Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ (dateParse C.parser_Dmy_lenient "01012016" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Passes With Separator 1"+ (dateParse C.parser_Dmy_lenient "01!01@2016" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Passes With Separator 2"+ (dateParse C.parser_Dmy_lenient "27z09+1876" (Date (Year 1876) (Month 8) (DayOfMonth 27)))+ ]+ , testGroup "Mdy Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ (dateParse C.parser_Mdy_lenient "01022016" (Date (Year 2016) (Month 0) (DayOfMonth 2)))+ , PH.testCase+ "Passes With Separator 1"+ (dateParse C.parser_Mdy_lenient "01!02@2016" (Date (Year 2016) (Month 0) (DayOfMonth 2)))+ , PH.testCase+ "Passes With Separator 2"+ (dateParse C.parser_Mdy_lenient "09+27z1876" (Date (Year 1876) (Month 8) (DayOfMonth 27)))+ ]+ , testGroup "Builder Spec Tests" $+ [ PH.testCase+ "No Separator"+ (dateBuilder Nothing "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Separator 1"+ (dateBuilder (Just '-') "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1)))+ , PH.testCase+ "Separator 2"+ (dateBuilder (Just '-') "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27)))+ , PH.testCase+ "zero-pad year"+ (dateBuilder (Just '-') "0001-01-01" (Date (Year 1) (Month 0) (DayOfMonth 1)))+ ]+ , testProperty "Builder Parser Isomorphism (Y-m-d)" $+ propEncodeDecodeIso+ (LText.toStrict . Builder.toLazyText . C.builder_Ymd (Just '-'))+ (either (const Nothing) Just . Atto.parseOnly (C.parser_Ymd (Just '-')))+ ]+ , testGroup+ "Datetime"+ [ testGroup "DmyHMS Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ ( datetimeParse (C.parser_DmyHMS (DatetimeFormat Nothing Nothing Nothing)) "01022016010223" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator"+ ( datetimeParse (C.parser_DmyHMS (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02:23" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ ]+ , testGroup "YmdHMS Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ ( datetimeParse (C.parser_YmdHMS (DatetimeFormat Nothing Nothing Nothing)) "20160101010223" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator"+ ( datetimeParse (C.parser_YmdHMS (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-01 01:02:23" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ ]+ , testGroup "MdyHMS Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ ( datetimeParse (C.parser_MdyHMS (DatetimeFormat Nothing Nothing Nothing)) "01012016010223" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator"+ ( datetimeParse (C.parser_MdyHMS (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-01-2016 01:02:23" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ ]+ , testGroup "DmyHMS Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ ( datetimeParse C.parser_DmyHMS_lenient "01022016010223" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator"+ ( datetimeParse C.parser_DmyHMS_lenient "01z02x2016$01;02:23" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail C.parser_DmyHMS_lenient "01-02-2016 01:02:23" "Failed reading: input does not start with a digit")+ , PH.testCase+ "Fails with some nonuniform empty Separators"+ (datetimeParseFail C.parser_DmyHMS_lenient "01-02-201601:02:23" "Failed reading: satisfy")+ ]+ , testGroup "YmdHMS Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ ( datetimeParse C.parser_YmdHMS_lenient "20160101010223" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator"+ ( datetimeParse C.parser_YmdHMS_lenient "2016!01z01^01a02c23" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail C.parser_YmdHMS_lenient "2016-01-02 01:02:03" "Failed reading: input does not start with a digit")+ ]+ , testGroup "MdyHMS Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator"+ ( datetimeParse C.parser_MdyHMS_lenient "01012016010223" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator"+ ( datetimeParse C.parser_MdyHMS_lenient "01z01%2016^01a02c23" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail C.parser_MdyHMS_lenient "01-02-2016 01:02:03" "Failed reading: input does not start with a digit")+ ]+ , testGroup "DmyHMS Optional Seconds Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator With Seconds"+ ( datetimeParse (C.parser_DmyHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "01022016010223" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With No Separator Without Seconds"+ ( datetimeParse (C.parser_DmyHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "010220160102" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Passes With With Separator With Seconds"+ ( datetimeParse (C.parser_DmyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02:23" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator Without Seconds"+ ( datetimeParse (C.parser_DmyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Fails with trailing seperator"+ (datetimeParseFail (C.parser_DmyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02:" "not enough input")+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail (C.parser_DmyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02" "Failed reading: input does not start with a digit")+ ]+ , testGroup "YmdHMS Optional Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator With Seconds"+ ( datetimeParse (C.parser_YmdHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "20160101010223" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With No Separator Without Seconds"+ ( datetimeParse (C.parser_YmdHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "201601010102" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Passes With With Separator With Seconds"+ ( datetimeParse (C.parser_YmdHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-01 01:02:23" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator Without Seconds"+ ( datetimeParse (C.parser_YmdHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-01 01:02" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Fails with trailing seperator"+ (datetimeParseFail (C.parser_YmdHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-02 01:02:" "not enough input")+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail (C.parser_YmdHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-02 01:02" "Failed reading: input does not start with a digit")+ ]+ , testGroup "MdyHMS Optional Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator With Seconds"+ ( datetimeParse (C.parser_MdyHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "01012016010223" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With No Separator Without Seconds"+ ( datetimeParse (C.parser_MdyHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "010120160102" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Passes With With Separator With Seconds"+ ( datetimeParse (C.parser_MdyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-01-2016 01:02:23" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator Without Seconds"+ ( datetimeParse (C.parser_MdyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-01-2016 01:02" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Fails with trailing seperator"+ (datetimeParseFail (C.parser_MdyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02:" "not enough input")+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail (C.parser_MdyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02" "Failed reading: input does not start with a digit")+ ]+ , testGroup "DmyHMS Optional Seconds Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator with seconds"+ ( datetimeParse C.parser_DmyHMS_opt_S_lenient "01022016010223" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With No Separator without seconds"+ ( datetimeParse C.parser_DmyHMS_opt_S_lenient "010220160102" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Passes With With Separator with seconds"+ ( datetimeParse C.parser_DmyHMS_opt_S_lenient "01z02x2016$01;02:23" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator without seconds"+ ( datetimeParse C.parser_DmyHMS_opt_S_lenient "01z02x2016$01;02" $+ Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Fails with trailing seperator"+ (datetimeParseFail C.parser_DmyHMS_opt_S_lenient "01z02x2016$01;02^" "not enough input")+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail C.parser_DmyHMS_opt_S_lenient "01-02-2016 01:02" "Failed reading: input does not start with a digit")+ ]+ , testGroup "YmdHMS Optional Seconds Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator With Seconds"+ ( datetimeParse C.parser_YmdHMS_opt_S_lenient "20160101010223" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With No Separator Without Seconds"+ ( datetimeParse C.parser_YmdHMS_opt_S_lenient "201601010102" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Passes With With Separator With Seconds"+ ( datetimeParse C.parser_YmdHMS_opt_S_lenient "2016!01z01^01a02c23" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator Without Seconds"+ ( datetimeParse C.parser_YmdHMS_opt_S_lenient "2016!01z01^01a02" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Fails with trailing seperator"+ (datetimeParseFail C.parser_YmdHMS_opt_S_lenient "2016!01z01^01a02^" "not enough input")+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail C.parser_YmdHMS_opt_S_lenient "2016-01-02 01:02" "Failed reading: input does not start with a digit")+ ]+ , testGroup "MdyHMS Optional Seconds Lenient Parser Spec Tests" $+ [ PH.testCase+ "Passes With No Separator With Seconds"+ ( datetimeParse C.parser_MdyHMS_opt_S_lenient "01012016010223" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With No Separator Without Seconds"+ ( datetimeParse C.parser_MdyHMS_opt_S_lenient "010120160102" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Passes With With Separator With Seconds"+ ( datetimeParse C.parser_MdyHMS_opt_S_lenient "01z01!2016^01a02c23" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000)+ )+ , PH.testCase+ "Passes With With Separator Without Seconds"+ ( datetimeParse C.parser_MdyHMS_opt_S_lenient "01z01(2016^01a02" $+ Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0)+ )+ , PH.testCase+ "Fails with trailing seperator"+ (datetimeParseFail C.parser_MdyHMS_opt_S_lenient "01z01!2016^01a02^" "not enough input")+ , PH.testCase+ "Fails with extra seperators"+ (datetimeParseFail C.parser_MdyHMS_opt_S_lenient "01-02-2016 01:02" "Failed reading: input does not start with a digit")+ ]+ , testGroup "Builder Parser Isomorphism" $+ [ testProperty "(Y-m-dTH:M:S)" $+ propEncodeDecodeIsoSettings+ (\format -> LText.toStrict . Builder.toLazyText . C.builder_YmdHMS (SubsecondPrecisionFixed 9) format)+ (\format -> either (const Nothing) Just . Atto.parseOnly (C.parser_YmdHMS format))+ , testProperty "Builder Parser Isomorphism (YmdHMS)" $+ propEncodeDecodeIso+ (LText.toStrict . Builder.toLazyText . C.builder_YmdHMS (SubsecondPrecisionFixed 9) (DatetimeFormat Nothing Nothing Nothing))+ (either (const Nothing) Just . Atto.parseOnly (C.parser_YmdHMS (DatetimeFormat Nothing Nothing Nothing)))+ ]+ , testProperty "ISO-8601 Roundtrip" $+ propEncodeDecodeIso+ C.encodeShortTextIso8601Zulu+ ( \input -> case C.decodeShortTextIso8601 input of+ Just (OffsetDatetime dt (Offset 0)) -> Just dt+ _ -> Nothing+ )+ , testProperty "ISO-8601 Zoneless Roundtrip" $+ propEncodeDecodeIso+ C.encodeShortTextIso8601Zoneless+ ( \input -> case C.decodeShortTextIso8601Zoneless input of+ Just dt -> Just dt+ _ -> Nothing+ )+ ]+ , testGroup+ "Offset Datetime"+ [ testGroup "Builder Spec Tests" $+ [ PH.testCase "W3C" $+ matchBuilder "1997-07-16T19:20:30.450+01:00" $+ C.builderW3Cz $+ OffsetDatetime+ ( Datetime+ (Date (Year 1997) C.july (DayOfMonth 16))+ (TimeOfDay 19 20 30450000000)+ )+ (Offset 60)+ ]+ , testProperty "Builder Parser Isomorphism (YmdHMSz)" $+ propEncodeDecodeIsoSettings+ ( \(offsetFormat, datetimeFormat) offsetDatetime ->+ LText.toStrict $+ Builder.toLazyText $+ C.builder_YmdHMSz offsetFormat (SubsecondPrecisionFixed 9) datetimeFormat offsetDatetime+ )+ ( \(offsetFormat, datetimeFormat) input ->+ either (const Nothing) Just $+ flip Atto.parseOnly input $+ C.parser_YmdHMSz offsetFormat datetimeFormat+ )+ ]+ , testGroup+ "Posix Time"+ [ PH.testCase "Get now" $ do+ now <- C.now+ assertBool "Current time is the beginning of the epoch." (now /= C.epoch)+ ]+ , testGroup+ "Conversion"+ [ testGroup+ "POSIX to Datetime"+ [ PH.testCase "Epoch" $+ C.timeToDatetime (Time 0)+ @?= Datetime+ (Date (Year 1970) C.january (DayOfMonth 1))+ (TimeOfDay 0 0 0)+ , PH.testCase "Billion Seconds" $+ C.timeToDatetime (Time $ 10 ^ (18 :: Integer))+ @?= Datetime+ (Date (Year 2001) C.september (DayOfMonth 9))+ (TimeOfDay 1 46 (40 * 10 ^ (9 :: Integer)))+ , testProperty "Isomorphism" $ propEncodeDecodeFullIso C.timeToDatetime C.datetimeToTime+ ]+ ]+ , testGroup+ "TimeInterval"+ [ testGroup+ "within"+ [ testProperty "Verify that Time bounds are inside TimeInterval" propWithinInsideInterval+ , testProperty+ "Verify that the sum of Time and the span of TimeInterval is outside the interval"+ propWithinOutsideInterval+ ]+ , testGroup+ "timeIntervalToTimespan"+ [ PH.testCase+ "Verify Timespan correctness with TimeInterval"+ (C.timeIntervalToTimespan (TimeInterval (Time 13) (Time 25)) @?= Timespan 12)+ , PH.testCase+ "Verify Timespan correctness with equal TimeInterval bounds"+ (C.timeIntervalToTimespan (TimeInterval (Time 13) (Time 13)) @?= Timespan 0)+ , testProperty "Almost isomorphism" propEncodeDecodeTimeInterval+ ]+ , testGroup+ "whole"+ [ PH.testCase+ "Verify TimeInterval's bound correctness"+ (C.whole @?= TimeInterval (Time (minBound :: Int64)) (Time (maxBound :: Int64)))+ ]+ , testGroup+ "singleton"+ [ testProperty "Verify that upper and lower bound are always equals" propSingletonBoundsEquals+ ]+ , testGroup+ "width"+ [ testProperty "Verify Time bounds correctness with TimeSpan" propWidthVerifyBounds+ ]+ , testGroup+ "timeIntervalBuilder"+ [ testProperty "Verify TimeInterval construction correctness" propTimeIntervalBuilder+ ]+ ]+ , testGroup+ "Datetime Conversions"+ [ testGroup+ "datetimeToDayOfWeek"+ [ PH.testCase+ "February 2nd 2020"+ (C.datetimeToDayOfWeek (Datetime (Date (Year 2020) (Month 1) (DayOfMonth 2)) (TimeOfDay 0 0 0)) @?= DayOfWeek 0)+ , PH.testCase+ "July 10th 2019"+ (C.datetimeToDayOfWeek (Datetime (Date (Year 2019) (Month 6) (DayOfMonth 10)) (TimeOfDay 0 0 0)) @?= DayOfWeek 3)+ , PH.testCase+ "November 16th 1946"+ (C.datetimeToDayOfWeek (Datetime (Date (Year 1946) (Month 10) (DayOfMonth 16)) (TimeOfDay 0 0 0)) @?= DayOfWeek 6)+ , PH.testCase+ "February 29th 2024 (Leap Year)"+ (C.datetimeToDayOfWeek (Datetime (Date (Year 2024) (Month 1) (DayOfMonth 29)) (TimeOfDay 0 0 0)) @?= DayOfWeek 4)+ ]+ ]+ , testGroup+ "timeToDayOfWeek Conversions"+ [ PH.testCase+ "Sunday, February 9, 2020 4:00:00 PM"+ (C.timeToDayOfWeek (Time 1581264000000000000) @?= DayOfWeek 0)+ , PH.testCase+ "Monday, April 9, 2001 4:00:00 PM"+ (C.timeToDayOfWeek (Time 986832000000000000) @?= DayOfWeek 1)+ , PH.testCase+ "Tuesday, March 7, 1995 4:00:00 PM"+ (C.timeToDayOfWeek (Time 794592000000000000) @?= DayOfWeek 2)+ , PH.testCase+ "Wednesday, June 17, 1987 4:00:00 PM"+ (C.timeToDayOfWeek (Time 550944000000000000) @?= DayOfWeek 3)+ , PH.testCase+ "Thursday, December 18, 1980 4:00:00 PM"+ (C.timeToDayOfWeek (Time 346003200000000000) @?= DayOfWeek 4)+ , PH.testCase+ "Friday, October 10, 1975 4:00:00 PM"+ (C.timeToDayOfWeek (Time 182188800000000000) @?= DayOfWeek 5)+ , PH.testCase+ "Saturday, August 11, 1973 4:00:00 PM"+ (C.timeToDayOfWeek (Time 113932800000000000) @?= DayOfWeek 6)+ , PH.testCase+ "Thursday, January 1, 1970 12:00:00 AM"+ (C.timeToDayOfWeek (Time 0) @?= DayOfWeek 4)+ , PH.testCase+ "Saturday, June 14, 1969 4:00:00 PM"+ (C.timeToDayOfWeek (Time (-17308800000000000)) @?= DayOfWeek 6)+ , PH.testCase+ "Tuesday, June 6, 1944 4:00:00 PM"+ (C.timeToDayOfWeek (Time (-806918400000000000)) @?= DayOfWeek 2)+ ]+ , testGroup+ "timeToOffsetDatetime"+ [ PH.testCase+ "EpochNeg4h"+ ( C.timeToOffsetDatetime (Offset (-240)) (Time 0)+ @?= OffsetDatetime+ ( Datetime+ (Date (Year 1969) C.december (DayOfMonth 31))+ (TimeOfDay 20 0 0)+ )+ (Offset (-240))+ )+ ]+ , testGroup+ "json"+ [ PH.testCase "Datetime" $+ let dt = Datetime (Date (Year 3000) (Month 11) (DayOfMonth 31)) (TimeOfDay 0 0 0)+ in AE.eitherDecode (AE.encode dt) @?= Right dt+ ]+ ]++failure :: String -> Result+failure msg =+ failed+ { reason = msg+ , theException = Nothing+ }++propEncodeDecodeFullIso :: (Eq a, Show a, Show b) => (a -> b) -> (b -> a) -> a -> Result+propEncodeDecodeFullIso f g a =+ let fa = f a+ gfa = g fa+ in if gfa == a+ then succeeded+ else+ failure $+ concat+ [ "x: "+ , show a+ , "\n"+ , "f(x): "+ , show fa+ , "\n"+ , "g(f(x)): "+ , show gfa+ , "\n"+ ]++propEncodeDecodeIso :: (Eq a) => (a -> b) -> (b -> Maybe a) -> a -> Bool+propEncodeDecodeIso f g a = g (f a) == Just a++propEncodeDecodeIsoSettings ::+ (Eq a, Show a, Show b, Show e) =>+ (e -> a -> b) ->+ (e -> b -> Maybe a) ->+ e ->+ a ->+ Result+propEncodeDecodeIsoSettings f g e a =+ let fa = f e a+ gfa = g e fa+ in if gfa == Just a+ then succeeded+ else+ failure $+ concat+ [ "env: "+ , show e+ , "\n"+ , "x: "+ , show a+ , "\n"+ , "f(x): "+ , show fa+ , "\n"+ , "g(f(x)): "+ , show gfa+ , "\n"+ ]++parseMatch :: (Eq a, Show a) => Atto.Parser a -> Text -> a -> Assertion+parseMatch p t expected =+ do+ Atto.parseOnly (p <* Atto.endOfInput) t+ @?= Right expected++bsParseMatch :: (Eq a, Show a) => AttoBS.Parser a -> ByteString -> a -> Assertion+bsParseMatch p t expected =+ do+ AttoBS.parseOnly (p <* AttoBS.endOfInput) t+ @?= Right expected++timeOfDayParse :: Maybe Char -> Text -> TimeOfDay -> Assertion+timeOfDayParse m t expected =+ Atto.parseOnly (C.parser_HMS m <* Atto.endOfInput) t+ @?= Right expected++bsTimeOfDayParse :: Maybe Char -> ByteString -> TimeOfDay -> Assertion+bsTimeOfDayParse m t expected =+ AttoBS.parseOnly (C.parserUtf8_HMS m <* AttoBS.endOfInput) t+ @?= Right expected++timeOfDayBuilder :: SubsecondPrecision -> Maybe Char -> Text -> TimeOfDay -> Assertion+timeOfDayBuilder sp m expected tod =+ LText.toStrict (Builder.toLazyText (C.builder_HMS sp m tod))+ @?= expected++bsTimeOfDayBuilder :: SubsecondPrecision -> Maybe Char -> Text -> TimeOfDay -> Assertion+bsTimeOfDayBuilder sp m expected tod =+ LText.toStrict (Builder.toLazyText (C.builder_HMS sp m tod))+ @?= expected++dateParse :: Atto.Parser Date -> Text -> Date -> Assertion+dateParse p t expected =+ Atto.parseOnly (p <* Atto.endOfInput) t+ @?= Right expected++-- dateParseFail :: Atto.Parser Date -> Text -> String -> Assertion+-- dateParseFail p t expected =+-- Atto.parseOnly (p <* Atto.endOfInput) t+-- @?= Left expected++datetimeParse :: Atto.Parser Datetime -> Text -> Datetime -> Assertion+datetimeParse p t expected =+ Atto.parseOnly (p <* Atto.endOfInput) t+ @?= Right expected++datetimeParseFail :: Atto.Parser Datetime -> Text -> String -> Assertion+datetimeParseFail p t expected =+ Atto.parseOnly (p <* Atto.endOfInput) t+ @?= Left expected++dateBuilder :: Maybe Char -> Text -> Date -> Assertion+dateBuilder m expected tod =+ LText.toStrict (Builder.toLazyText (C.builder_Ymd m tod))+ @?= expected++matchBuilder :: Text -> Builder -> Assertion+matchBuilder a b = LText.toStrict (Builder.toLazyText b) @?= a++propWithinInsideInterval :: TimeInterval -> Bool+propWithinInsideInterval ti@(TimeInterval t0 t1) = C.within t1 ti && C.within t0 ti++propWithinOutsideInterval :: RelatedTimes -> Bool+propWithinOutsideInterval (RelatedTimes t ti@(TimeInterval t0 t1))+ | t == t0 = discard+ | t == t1 = discard+ | t1 <= t0 = discard+ | t0 < (Time 0) = discard+ | t < (Time 0) = discard+ | otherwise =+ let+ span' = C.timeIntervalToTimespan ti+ tm = T.add span' t+ in+ not $ C.within tm ti++propEncodeDecodeTimeInterval :: TimeInterval -> Bool+propEncodeDecodeTimeInterval ti@(TimeInterval t0 t1)+ | t0 < (Time 0) = discard+ | t0 >= t1 = discard+ | otherwise =+ let+ span' = C.timeIntervalToTimespan ti+ tm = T.add span' t0+ in+ t1 == tm++propSingletonBoundsEquals :: Time -> Bool+propSingletonBoundsEquals tm =+ let+ (TimeInterval (Time ti) (Time te)) = C.singleton tm+ in+ ti == te++propWidthVerifyBounds :: TimeInterval -> Bool+propWidthVerifyBounds ti@(TimeInterval (Time lower) (Time upper)) =+ let+ tiWidth = (getTimespan . C.width) ti+ in+ T.add lower tiWidth == upper && T.difference upper tiWidth == lower++propTimeIntervalBuilder :: Time -> Time -> Bool+propTimeIntervalBuilder t0 t1 =+ let+ (TimeInterval ti te) = (C.timeIntervalBuilder t0 t1)+ in+ (getTime te) >= (getTime ti)++instance Arbitrary TimeOfDay where+ arbitrary =+ TimeOfDay+ <$> choose (0, 23)+ <*> choose (0, 59)+ -- never use leap seconds for property-based tests+ <*> ( 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+ <$> fmap Year (choose (1800, 2100))+ <*> fmap Month (choose (0, 11))+ <*> fmap DayOfMonth (choose (1, 28))++instance Arbitrary Datetime where+ arbitrary = Datetime <$> arbitrary <*> arbitrary++-- instance Arbitrary UtcTime where+-- arbitrary = UtcTime+-- <$> fmap Day (choose (-100000,100000))+-- <*> choose (0,24 * 60 * 60 * 1000000000 - 1)++instance Arbitrary OffsetDatetime where+ arbitrary =+ OffsetDatetime+ <$> arbitrary+ <*> arbitrary++instance Arbitrary DatetimeFormat where+ arbitrary =+ DatetimeFormat+ <$> 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+ shrink = genericShrink++deriving instance Arbitrary Time++instance Arbitrary TimeInterval where+ arbitrary = do+ t0 <- arbitrary+ t1 <- suchThat arbitrary (>= t0)+ pure (TimeInterval t0 t1)++data RelatedTimes = RelatedTimes Time TimeInterval+ deriving (Show)++instance Arbitrary RelatedTimes where+ arbitrary = do+ ti@(TimeInterval t0 t1) <- arbitrary+ tm <- fmap Time (choose (getTime t0, getTime t1))+ pure $ RelatedTimes tm ti instance Arbitrary Offset where arbitrary = fmap Offset (choose ((-24) * 60, 24 * 60))