From 5720bd494c0d92ad22aefa4dc34eb0b9585b673e Mon Sep 17 00:00:00 2001 From: Brian McKeon <135748266+brianjosephmckeon@users.noreply.github.com> Date: Thu, 15 Feb 2024 12:56:41 -0500 Subject: [PATCH] Prepare 1.1.6.1 release. Reformatted. Use new .github workflows. Updated package metadata. Added new workflow for building on Windows and MacOS. Added doctest support to workflows. Updated readme. --- .github/CODEOWNERS | 1 + .github/workflows/build.yaml | 12 + .github/workflows/ci.yml | 53 - .github/workflows/other-os.yaml | 62 + .github/workflows/release.yaml | 10 + CHANGELOG.md | 62 +- README.markdown => README.md | 7 +- Setup.hs | 2 - app/Main.hs | 6 - appveyor.yml | 34 - bench/Bench.hs | 142 +- chronos.cabal | 43 +- fourmolu.yaml | 51 + scripts/hackage-docs.sh | 48 - src/Chronos.hs | 3328 +++++++++++++++++-------------- src/Chronos/Locale/English.hs | 82 +- src/Chronos/Types.hs | 52 +- stack.ghcjs.yaml | 18 - test/Spec.hs | 1305 +++++++----- 19 files changed, 2963 insertions(+), 2355 deletions(-) create mode 100644 .github/CODEOWNERS create mode 100644 .github/workflows/build.yaml delete mode 100644 .github/workflows/ci.yml create mode 100644 .github/workflows/other-os.yaml create mode 100644 .github/workflows/release.yaml rename README.markdown => README.md (87%) delete mode 100644 Setup.hs delete mode 100644 app/Main.hs delete mode 100644 appveyor.yml create mode 100644 fourmolu.yaml delete mode 100755 scripts/hackage-docs.sh delete mode 100644 stack.ghcjs.yaml diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS new file mode 100644 index 0000000..f6c0b22 --- /dev/null +++ b/.github/CODEOWNERS @@ -0,0 +1 @@ +@byteverse/l3c diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml new file mode 100644 index 0000000..2165960 --- /dev/null +++ b/.github/workflows/build.yaml @@ -0,0 +1,12 @@ +# Build pull request branches only for Ubuntu. +name: build +on: + pull_request: + branches: + - "*" + +jobs: + call-workflow: + uses: byteverse/.github/.github/workflows/build-matrix.yaml@main + with: + cabal-file: chronos.cabal diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml deleted file mode 100644 index 10f021e..0000000 --- a/.github/workflows/ci.yml +++ /dev/null @@ -1,53 +0,0 @@ -name: CI - -# Trigger the workflow on push or pull request, but only for the main branch -on: - pull_request: - push: - branches: ["main"] - -jobs: - generate-matrix: - name: "Generate matrix from cabal" - outputs: - matrix: ${{ steps.set-matrix.outputs.matrix }} - runs-on: ubuntu-latest - steps: - - name: Extract the tested GHC versions - id: set-matrix - uses: kleidukos/get-tested@v0.1.6.0 - with: - cabal-file: chronos.cabal - ubuntu: true - version: 0.1.6.0 - tests: - name: ${{ matrix.ghc }} on ${{ matrix.os }} - needs: generate-matrix - runs-on: ${{ matrix.os }} - continue-on-error: true - strategy: - matrix: ${{ fromJSON(needs.generate-matrix.outputs.matrix) }} - fail-fast: false - steps: - - name: Checkout base repo - uses: actions/checkout@v4 - - name: Set up Haskell - id: setup-haskell - uses: haskell-actions/setup@latest - with: - ghc-version: ${{ matrix.ghc }} - cabal-version: 'latest' - - name: Configure - run: cabal configure --enable-tests - - name: Freeze - run: cabal freeze - - name: Cache - uses: actions/cache@v4 - with: - path: ${{ steps.setup-haskell.outputs.cabal-store }} - key: ${{ runner.os }}-ghc-${{ matrix.ghc }}-cabal-${{ hashFiles('**/plan.json') }} - restore-keys: ${{ runner.os }}-ghc-${{ matrix.ghc }}- - - name: Build - run: cabal new-build - - name: Test - run: cabal new-test all diff --git a/.github/workflows/other-os.yaml b/.github/workflows/other-os.yaml new file mode 100644 index 0000000..4c5446e --- /dev/null +++ b/.github/workflows/other-os.yaml @@ -0,0 +1,62 @@ +# Build main on Windows and MacOS. +name: other os + +on: + push: + branches: + - main + +# Concurrency settings. +# Only one job of this workflow will run at a time. +# If a job is currently running, it'll be canceled. +concurrency: + group: ${{ github.workflow }} + cancel-in-progress: true + +jobs: + generate-matrix: + name: "Generate matrix from cabal file" + outputs: + matrix: ${{ steps.set-matrix.outputs.matrix }} + runs-on: ubuntu-latest + steps: + - name: Extract GHC versions + id: set-matrix + uses: kleidukos/get-tested@v0.1.6.0 + with: + cabal-file: chronos.cabal + windows: true + macos: true + version: 0.1.6.0 + + build: + name: ${{ matrix.ghc }} on ${{ matrix.os }} + needs: generate-matrix + runs-on: ${{ matrix.os }} + continue-on-error: false + strategy: + matrix: ${{ fromJSON(needs.generate-matrix.outputs.matrix) }} + fail-fast: false + + steps: + - uses: actions/checkout@v4 + + - name: Set up GHC ${{ matrix.ghc }} + uses: haskell-actions/setup@latest + id: setup + with: + ghc-version: ${{ matrix.ghc }} + cabal-version: 'latest' + + - name: Configure the build + run: | + cabal configure --disable-documentation --disable-benchmarks + + - name: Build + run: cabal build all + + - name: Run tests + run: | + cabal test all --test-show-details=direct + cabal install doctest + cabal repl --build-depends=QuickCheck --with-ghc=doctest --repl-options='-fno-warn-orphans -Wno-unused-packages' diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml new file mode 100644 index 0000000..9411962 --- /dev/null +++ b/.github/workflows/release.yaml @@ -0,0 +1,10 @@ +name: release +on: + push: + tags: + - "*" + +jobs: + call-workflow: + uses: byteverse/.github/.github/workflows/release.yaml@main + secrets: inherit diff --git a/CHANGELOG.md b/CHANGELOG.md index ce2b7d3..5b2fd29 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,21 +1,26 @@ -1.1.6.0 [XXXX.XX.XX] --------------------- +# Revision history for chronos + +## 1.1.6.1 -- 2024-02-15 + +* Update package metadata. + +## 1.1.6.0 -- 2024-01-29 * Add `sinceEpoch` and `asSeconds` functions -1.1.5.1: [2023.08.24] ---------------------- +## 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] -------------------- +## 1.1.5 -- 2022-11-03 + * Add `decodeShortTextIso8601Zulu`. * Add `decodeUtf8BytesIso8601ZonelessSpaced`. -1.1.4: [2022.02.21] -------------------- +## 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` @@ -23,8 +28,8 @@ * Add various lenses for core data type fields and isos * Drop support for GHC 8.8 and earlier. -1.1.3: [2021.09.07] -------------------- +## 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 @@ -38,50 +43,49 @@ incorrectly identifier a subseconds part of 0 (i.e. `23:59:17.000`). * Improved layout of cabal file. -1.1.2: [2021.02.08] -------------------- +## 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. +* Fix formatting in cabal file. + +## 1.1.1 -- 2020-04-17 -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] ------------------ +## 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] -------------------- +## 1.0.9 -- 2019-11-09 + * Add `TimeParts` for custom formatting. -1.0.8: [2019.11.07] -------------------- +## 1.0.8 -- 2019-11-07 + * Allow newer semigroups. -1.0.7: [2019.08.16] -------------------- +## 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] ------------------ +## 1.0.6 -- 2019-07-19 + * Add 'TimeInterval' type and related functions. -1.0.5: [2019.05.01] -------------------- +## 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] -------------------- +## 1.0.4 -- 2018-08-14 * Initial version, w.r.t. CHANGELOG (i.e. there was no changelog before). diff --git a/README.markdown b/README.md similarity index 87% rename from README.markdown rename to README.md index 1cfa80c..a5d52a0 100644 --- a/README.markdown +++ b/README.md @@ -1,7 +1,5 @@ # Chronos -[![Windows build](https://ci.appveyor.com/api/projects/status/github/andrewthad/chronos?branch=master&svg=true)](https://ci.appveyor.com/project/andrewthad/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 @@ -64,7 +62,4 @@ do not require this to be run. To run the doctests, make sure you have 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.) +Doctest now runs as part of CI. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 index de1c1ab..0000000 --- a/app/Main.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main where - -import Lib - -main :: IO () -main = someFunc diff --git a/appveyor.yml b/appveyor.yml deleted file mode 100644 index acdc13a..0000000 --- a/appveyor.yml +++ /dev/null @@ -1,34 +0,0 @@ -clone_folder: "c:\\WORK" -clone_depth: 5 - -# Do not build feature branch with open Pull Requests -skip_branch_with_pr: true - -platform: - - x86_64 - -cache: - - "C:\\SR" - - dist-newstyle - -environment: - global: - CABOPTS: --store-dir=C:\\SR - - matrix: - - GHCVER: 9.0.2 - -install: - - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2 - - choco install -y cabal --version 3.6.2.0 - - choco install -y ghc --version 9.0.2 - - refreshenv - -before_build: - - cabal --version - - ghc --version - - cabal %CABOPTS% update - -build_script: - - cabal %CABOPTS% build all --enable-tests --write-ghc-environment-files=always - - cabal %CABOPTS% test all --enable-tests diff --git a/bench/Bench.hs b/bench/Bench.hs index 76123bb..5202d73 100644 --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE BangPatterns #-} module Main where @@ -35,13 +35,13 @@ main = do -- 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." - dmyhms = isoFormatString - timePretty = Time.formatTime Time.defaultTimeLocale - thymePretty = Thyme.formatTime Thyme.defaultTimeLocale + 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 @@ -50,35 +50,40 @@ main = do 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 - , bench "Chronos.decodeShortTextIso8601" $ nf chronosIso8601 shortText - ] - - , 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 + "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 "YmdHMS" - [ bench "Time.formatTime" $ nf (timePretty dmyhms) timeTime - , bench "Thyme.formatTime" $ nf (thymePretty dmyhms) thymeTime - , bench "Chronos.builder_YmdHMS" $ nf chronosPrettyYmdHMS 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 + ] ] - , bgroup "ISO-8601-Zulu" - [ bench "Chronos.encodeShortTextIso8601Zulu" $ nf encodeChronosIso8601Zulu chronosTime - ] - ] ] encodeChronosIso8601Zulu :: Chronos.Time -> ShortText @@ -86,62 +91,67 @@ encodeChronosIso8601Zulu !t = Chronos.encodeShortTextIso8601Zulu (Chronos.timeToDatetime t) chronosIso8601 :: ShortText -> Chronos.Time -{-# noinline chronosIso8601 #-} +{-# NOINLINE chronosIso8601 #-} chronosIso8601 !t = case Chronos.decodeShortTextIso8601Zoneless t of Just x -> Chronos.datetimeToTime x Nothing -> errorWithoutStackTrace "chronosIso8601: decode failure" chronosZepto :: BS8.ByteString -> Chronos.Time -{-# noinline chronosZepto #-} -chronosZepto !bs = either error Chronos.datetimeToTime - (Z.parse (Chronos.zeptoUtf8_YmdHMS Chronos.w3c) bs) - +{-# NOINLINE chronosZepto #-} +chronosZepto !bs = + either + error + Chronos.datetimeToTime + (Z.parse (Chronos.zeptoUtf8_YmdHMS Chronos.w3c) bs) chronosPrettyYmdHMS :: Chronos.Time -> LT.Text -{-# noinline chronosPrettyYmdHMS #-} -chronosPrettyYmdHMS = toLazyText - . Chronos.builder_YmdHMS Chronos.SubsecondPrecisionAuto Chronos.w3c - . Chronos.timeToDatetime +{-# 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 +{-# 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 +{-# NOINLINE chronosPrettyDmy #-} +chronosPrettyDmy = + toLazyText + . Chronos.builder_Dmy (Just ':') + . Chronos.datetimeDate + . Chronos.timeToDatetime chronosAttoparsec :: BS8.ByteString -> Chronos.Time -{-# noinline chronosAttoparsec #-} +{-# NOINLINE chronosAttoparsec #-} chronosAttoparsec = - either error Chronos.datetimeToTime - . parseOnly (Chronos.parserUtf8_YmdHMS Chronos.w3c) + either error Chronos.datetimeToTime + . parseOnly (Chronos.parserUtf8_YmdHMS Chronos.w3c) timeParser :: String -> Time.UTCTime -{-# noinline timeParser #-} +{-# NOINLINE timeParser #-} timeParser = fromMaybe (error "Failed to parse in timeParser") - . Time.parseTimeM True Time.defaultTimeLocale isoFormatString + . Time.parseTimeM True Time.defaultTimeLocale isoFormatString thymeParser :: String -> Thyme.UTCTime -{-# noinline thymeParser #-} +{-# NOINLINE thymeParser #-} thymeParser = fromMaybe (error "Failed to parse in thymeParser") - . Thyme.parseTime Thyme.defaultTimeLocale isoFormatString + . Thyme.parseTime Thyme.defaultTimeLocale isoFormatString thymeAttoparsec :: BS8.ByteString -> Thyme.UTCTime -{-# noinline thymeAttoparsec #-} +{-# NOINLINE thymeAttoparsec #-} thymeAttoparsec = Thyme.buildTime @Thyme.UTCTime - . either error id - . parseOnly (Thyme.timeParser Thyme.defaultTimeLocale isoFormatString) + . either error id + . parseOnly (Thyme.timeParser Thyme.defaultTimeLocale isoFormatString) isoFormatString :: String -{-# noinline isoFormatString #-} +{-# NOINLINE isoFormatString #-} isoFormatString = "%Y-%m-%dT%H:%M:%S" diff --git a/chronos.cabal b/chronos.cabal index 837d8c9..b2291f6 100644 --- a/chronos.cabal +++ b/chronos.cabal @@ -1,7 +1,7 @@ -cabal-version: 3.0 -name: chronos -version: 1.1.5.1 -synopsis: A high-performance time library +cabal-version: 3.0 +name: chronos +version: 1.1.6.1 +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 @@ -25,25 +25,20 @@ description: 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 - chessai +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 -copyright: 2016 Andrew Martin -category: Data, Time, Parsing, Development -build-type: Simple -tested-with: - GHC ==8.10.7 - || ==9.0.2 - || ==9.2.8 - || ==9.4.8 - || ==9.6.3 - || ==9.6.4 - || ==9.8.1 +tested-with: GHC ==9.4.8 || ==9.6.3 || ==9.8.1 common build-settings default-language: Haskell2010 @@ -123,6 +118,8 @@ benchmark bench , thyme , time + ghc-options: -O2 + source-repository head type: git - location: https://github.com/andrewthad/chronos + location: git://github.com/byteverse/chronos.git diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..40cd005 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,51 @@ +# Number of spaces per indentation step +indentation: 2 + +# Max line length for automatic line breaking +column-limit: 200 + +# Styling of arrows in type signatures (choices: trailing, leading, or leading-args) +function-arrows: trailing + +# How to place commas in multi-line lists, records, etc. (choices: leading or trailing) +comma-style: leading + +# Styling of import/export lists (choices: leading, trailing, or diff-friendly) +import-export-style: leading + +# Whether to full-indent or half-indent 'where' bindings past the preceding body +indent-wheres: false + +# Whether to leave a space before an opening record brace +record-brace-space: true + +# Number of spaces between top-level declarations +newlines-between-decls: 1 + +# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact) +haddock-style: multi-line + +# How to print module docstring +haddock-style-module: null + +# Styling of let blocks (choices: auto, inline, newline, or mixed) +let-style: auto + +# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space) +in-style: right-align + +# Whether to put parentheses around a single constraint (choices: auto, always, or never) +single-constraint-parens: always + +# Output Unicode syntax (choices: detect, always, or never) +unicode: never + +# Give the programmer more choice on where to insert blank lines +respectful: true + +# Fixity information for operators +fixities: [] + +# Module reexports Fourmolu should know about +reexports: [] + diff --git a/scripts/hackage-docs.sh b/scripts/hackage-docs.sh deleted file mode 100755 index 0ddbc20..0000000 --- a/scripts/hackage-docs.sh +++ /dev/null @@ -1,48 +0,0 @@ -#!/bin/bash -set -e - -if [ "$#" -ne 1 ]; then - echo "Usage: scripts/hackage-docs.sh HACKAGE_USER" - exit 1 -fi - -user=$1 - -cabal_file=$(find . -maxdepth 1 -name "*.cabal" -print -quit) -if [ ! -f "$cabal_file" ]; then - echo "Run this script in the top-level package directory" - exit 1 -fi - -pkg=$(awk -F ":[[:space:]]*" 'tolower($1)=="name" { print $2 }' < "$cabal_file") -ver=$(awk -F ":[[:space:]]*" 'tolower($1)=="version" { print $2 }' < "$cabal_file") - -if [ -z "$pkg" ]; then - echo "Unable to determine package name" - exit 1 -fi - -if [ -z "$ver" ]; then - echo "Unable to determine package version" - exit 1 -fi - -echo "Detected package: $pkg-$ver" - -dir=$(mktemp -d build-docs.XXXXXX) -trap 'rm -r "$dir"' EXIT - -# cabal haddock --hoogle --hyperlink-source --html-location='/package/$pkg-$version/docs' --contents-location='/package/$pkg-$version' -stack haddock - -cp -R .stack-work/dist/x86_64-linux/Cabal-1.22.5.0/doc/html/$pkg/ $dir/$pkg-$ver-docs -# /home/andrew/.stack/snapshots/x86_64-linux/lts-5.17/7.10.3/doc/index.html - -tar cvz -C $dir --format=ustar -f $dir/$pkg-$ver-docs.tar.gz $pkg-$ver-docs - -curl -X PUT \ - -H 'Content-Type: application/x-tar' \ - -H 'Content-Encoding: gzip' \ - -u "$user" \ - --data-binary "@$dir/$pkg-$ver-docs.tar.gz" \ - "https://hackage.haskell.org/package/$pkg-$ver/docs" diff --git a/src/Chronos.hs b/src/Chronos.hs index fa106d0..51fb64b 100644 --- a/src/Chronos.hs +++ b/src/Chronos.hs @@ -1,20 +1,20 @@ -{-# 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 +{-# 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 library are: @@ -36,10 +36,10 @@ 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 @@ -50,12 +50,15 @@ module Chronos , tomorrowDayOfWeek , timeToDayOfWeek , epoch + -- ** Duration , stopwatch , stopwatch_ + -- ** Construction , datetimeFromYmdhms , timeFromYmdhms + -- ** Conversion , timeToDatetime , datetimeToTime @@ -71,12 +74,14 @@ module Chronos , ordinalDateToDay , monthDateToDayOfYear , dayOfYearToMonthDay + -- ** Build Timespan , second , minute , hour , day , week + -- ** Matching , buildDayOfWeekMatch , buildMonthMatch @@ -84,6 +89,7 @@ module Chronos , caseDayOfWeek , caseMonth , caseUnboxedMonth + -- ** Format -- $format , w3c @@ -91,6 +97,7 @@ module Chronos , hyphen , compact , timeParts + -- ** Months , january , february @@ -104,6 +111,7 @@ module Chronos , october , november , december + -- ** Days of Week , sunday , monday @@ -112,6 +120,7 @@ module Chronos , thursday , friday , saturday + -- ** Utility , daysInMonth , isLeapYear @@ -120,7 +129,9 @@ module Chronos , asSeconds -- * Textual Conversion + -- ** Date + -- *** Text , builder_Ymd , builder_Dmy @@ -131,15 +142,19 @@ module Chronos , 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 @@ -147,7 +162,9 @@ module Chronos , parserUtf8_HMS , parserUtf8_HMS_opt_S , zeptoUtf8_HMS + -- ** Datetime + -- *** Text , builder_DmyHMS , builder_DmyIMSp @@ -190,6 +207,7 @@ module Chronos , decode_DmyHMS_opt_S , decode_DmyHMS_opt_S_lenient , decode_lenient + -- *** UTF-8 ByteString , encodeUtf8_YmdHMS , encodeUtf8_YmdIMS_p @@ -202,16 +220,20 @@ module Chronos , 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 @@ -222,36 +244,46 @@ module Chronos , 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 @@ -262,32 +294,34 @@ module Chronos , 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(..) + , 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 @@ -317,57 +351,57 @@ module Chronos , _timeOfDayNanoseconds ) where +import qualified Arithmetic.Lte as Lte +import qualified Arithmetic.Nat as Nat import Control.Applicative -import Control.DeepSeq (NFData(..), deepseq) +import Control.DeepSeq (NFData (..), deepseq) import Control.Exception (evaluate) import Control.Monad -import Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey) -import Data.Attoparsec.Text (Parser) -import Data.Bool (bool) -import Data.Bytes (Bytes) -import Data.ByteString (ByteString) -import Data.Char (isDigit) -import Data.Foldable -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 Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) import qualified Data.Aeson as AE import qualified Data.Aeson.Encoding as AEE import qualified Data.Aeson.Types as AET import qualified Data.Attoparsec.ByteString.Char8 as AB +import Data.Attoparsec.Text (Parser) import qualified Data.Attoparsec.Text as AT import qualified Data.Attoparsec.Zepto as Z -import qualified Data.Bytes as Bytes -import qualified Data.Bytes.Builder.Bounded as Bounded -import qualified Data.Bytes.Parser as BVP -import qualified Data.Bytes.Parser.Latin as Latin +import Data.Bool (bool) +import Data.ByteString (ByteString) import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Short.Internal as SBS +import Data.Bytes (Bytes) +import qualified Data.Bytes as Bytes +import qualified Data.Bytes.Builder.Bounded as Bounded +import qualified Data.Bytes.Parser as BVP +import qualified Data.Bytes.Parser.Latin as Latin +import Data.Char (isDigit) +import Data.Foldable +import Data.Hashable (Hashable) +import Data.Int (Int64) +import Data.Primitive import qualified Data.Semigroup as SG +import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Lazy.Builder.Int as TB import qualified Data.Text.Read as Text +import Data.Text.Short (ShortText) import qualified Data.Text.Short as TS import qualified Data.Text.Short.Unsafe as TS +import Data.Vector (Vector) import qualified Data.Vector as Vector import qualified Data.Vector.Generic as GVector import qualified Data.Vector.Generic.Mutable as MGVector import qualified Data.Vector.Primitive as PVector import qualified Data.Vector.Unboxed as UVector +import Data.Word (Word64, Word8) +import Foreign.Storable +import GHC.Clock (getMonotonicTimeNSec) +import GHC.Generics (Generic) +import Torsor #ifdef mingw32_HOST_OS import System.Win32.Time (SYSTEMTIME(..)) @@ -380,54 +414,54 @@ import Chronos.Internal.CTimespec (getPosixNanoseconds) import qualified Data.Aeson.Key as AK #endif --- $setup --- >>> import Test.QuickCheck hiding (within) --- >>> import Test.QuickCheck.Gen --- >>> import Data.Maybe (isJust) --- >>> :set -XStandaloneDeriving --- >>> :set -XGeneralizedNewtypeDeriving --- >>> :set -XScopedTypeVariables --- --- >>> deriving instance Arbitrary Time --- >>> :{ --- instance Arbitrary TimeInterval where --- arbitrary = do --- t0 <- arbitrary --- t1 <- suchThat arbitrary (>= t0) --- pure (TimeInterval t0 t1) --- instance Arbitrary TimeOfDay where --- arbitrary = TimeOfDay --- <$> choose (0,23) --- <*> choose (0,59) --- <*> choose (0, 60000000000 - 1) --- instance Arbitrary Date where --- arbitrary = Date --- <$> fmap Year (choose (1800,2100)) --- <*> fmap Month (choose (0,11)) --- <*> fmap DayOfMonth (choose (1,28)) --- instance Arbitrary Datetime where --- arbitrary = Datetime <$> arbitrary <*> arbitrary --- instance Arbitrary OffsetDatetime where --- arbitrary = OffsetDatetime <$> arbitrary <*> arbitrary --- instance Arbitrary DatetimeFormat where --- arbitrary = DatetimeFormat --- <$> arbitrary --- <*> elements [ Nothing, Just '/', Just ':', Just '-'] --- <*> arbitrary --- instance Arbitrary OffsetFormat where --- arbitrary = arbitraryBoundedEnum --- shrink = genericShrink --- instance Arbitrary Offset where --- arbitrary = fmap Offset (choose ((-24) * 60, 24 * 60)) --- instance Arbitrary SubsecondPrecision where --- arbitrary = frequency --- [ (1, pure SubsecondPrecisionAuto) --- , (1, SubsecondPrecisionFixed <$> choose (0,9)) --- ] --- instance Arbitrary Day where --- arbitrary = fmap Day (choose (0,50000)) --- :} --- +{- $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 @@ -449,30 +483,34 @@ day = Timespan 86400000000000 week :: Timespan week = Timespan 604800000000000 --- | Convert 'Time' to 'Datetime'. --- --- prop> \(t :: Time) -> (datetimeToTime (timeToDatetime t)) == t +{- | 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 +{- | 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 +{- | 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 +{- | 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' @@ -487,7 +525,7 @@ dateToDayOfWeek (Date year month date) = 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 + 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 @@ -497,8 +535,9 @@ timeToOffsetDatetime offset = utcTimeToOffsetDatetime offset . toUtc offsetDatetimeToTime :: OffsetDatetime -> Time offsetDatetimeToTime = fromUtc . offsetDatetimeToUtcTime --- | Convert 'Time' to 'Day'. This function is lossy; consequently, it --- does not roundtrip with 'dayToTimeMidnight'. +{- | 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) @@ -506,80 +545,104 @@ timeToDayTruncate (Time i) = Day (fromIntegral (div i 86400000000000) + 40587) dayToTimeMidnight :: Day -> Time dayToTimeMidnight (Day d) = Time (fromIntegral (d - 40587) * 86400000000000) --- | Convert 'Day' to a 'Date'. --- --- prop> \(d :: Day) -> dateToDay (dayToDate d) == d +{- | Convert 'Day' to a 'Date'. + + prop> \(d :: Day) -> dateToDay (dayToDate d) == d +-} dayToDate :: Day -> Date dayToDate theDay = Date year month dayOfMonth - where + 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 +{- | 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)) +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 +{- | 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 +{- | 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}} +{- | 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 0 + -- | 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} +{- | 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 + -- | 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. +{- | Gets the current 'Day'. This does not take the user\'s + time zone into account. +-} today :: IO Day today = fmap timeToDayTruncate now @@ -617,8 +680,9 @@ now = fmap Time getPosixNanoseconds -- | Convert from 'Time' to 'DayOfWeek'. timeToDayOfWeek :: Time -> DayOfWeek -timeToDayOfWeek (Time time) = DayOfWeek $ - (fromIntegral @Int64 @Int ((time `div` 86400000000000) + 4) `mod` 7) +timeToDayOfWeek (Time time) = + DayOfWeek $ + (fromIntegral @Int64 @Int ((time `div` 86400000000000) + 4) `mod` 7) -- | Get the current 'DayOfWeek' from the system clock. todayDayOfWeek :: IO DayOfWeek @@ -638,9 +702,10 @@ tomorrowDayOfWeek = 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. +{- | 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 @@ -648,9 +713,10 @@ stopwatch action = do 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. +{- | 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 @@ -659,19 +725,25 @@ stopwatch_ action = do pure (Timespan (fromIntegral (end - start))) -- UtcTime. Used internally only. -data UtcTime = UtcTime - {-# UNPACK #-} !Day -- day - {-# UNPACK #-} !Int64 -- nanoseconds +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) +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' +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 @@ -687,69 +759,75 @@ nanosecondsInMinute = 60000000000 -- | All UTC time offsets. See . 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 +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 +{- | 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. +{- | 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, TimeOfDay h'' m'' s) + where (!dayAdjustment, !h'') = divMod h' 24 (!hourAdjustment, !m'') = divMod m' 60 m' = m + offset @@ -760,10 +838,10 @@ nanosecondsSinceMidnightToTimeOfDay ns = if ns >= dayLengthInt64 then TimeOfDay 23 59 (nanosecondsInMinute + (ns - dayLengthInt64)) else TimeOfDay h' m' ns' - where - (!mInt64,!ns') = quotRem ns nanosecondsInMinute + where + (!mInt64, !ns') = quotRem ns nanosecondsInMinute !m = fromIntegral mInt64 - (!h',!m') = quotRem m 60 + (!h', !m') = quotRem m 60 timeOfDayToNanosecondsSinceMidnight :: TimeOfDay -> Int64 timeOfDayToNanosecondsSinceMidnight (TimeOfDay h m ns) = @@ -774,7 +852,7 @@ timeOfDayToNanosecondsSinceMidnight (TimeOfDay h m ns) = utcTimeToOffsetDatetime :: Offset -> UtcTime -> OffsetDatetime utcTimeToOffsetDatetime offset (UtcTime (Day d) nanoseconds) = - let (!dayAdjustment,!tod) = offsetTimeOfDay offset (nanosecondsSinceMidnightToTimeOfDay nanoseconds) + let (!dayAdjustment, !tod) = offsetTimeOfDay offset (nanosecondsSinceMidnightToTimeOfDay nanoseconds) !date = dayToDate (Day (d + dayAdjustment)) in OffsetDatetime (Datetime date tod) offset @@ -790,7 +868,7 @@ datetimeToUtcTime (Datetime date timeOfDay) = offsetDatetimeToUtcTime :: OffsetDatetime -> UtcTime offsetDatetimeToUtcTime (OffsetDatetime (Datetime date timeOfDay) (Offset off)) = - let (!dayAdjustment,!tod) = offsetTimeOfDay (Offset $ negate off) timeOfDay + let (!dayAdjustment, !tod) = offsetTimeOfDay (Offset $ negate off) timeOfDay !(Day !theDay) = dateToDay date in UtcTime (Day (theDay + dayAdjustment)) @@ -798,43 +876,50 @@ offsetDatetimeToUtcTime (OffsetDatetime (Datetime date timeOfDay) (Offset off)) -- | Convert a 'MonthDate' to a 'DayOfYear'. monthDateToDayOfYear :: - Bool -- ^ Is it a leap year? - -> MonthDate - -> DayOfYear + -- | 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 + 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 +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) - ) + 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 + + (div y 4) + - (div y 100) + + (div y 400) + - 678576 --- | Is the 'Year' a leap year? --- --- >>> isLeapYear (Year 1996) --- True --- --- >>> isLeapYear (Year 2019) --- False +{- | 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 + -- | Is it a leap year? + Bool -> + DayOfYear -> + MonthDate dayOfYearToMonthDay isLeap dayOfYear = - let (!doyUpperBound,!monthTable,!dayTable) = + let (!doyUpperBound, !monthTable, !dayTable) = if isLeap then (DayOfYear 366, leapYearDayOfYearMonthTable, leapYearDayOfYearDayOfMonthTable) else (DayOfYear 365, normalYearDayOfYearMonthTable, normalYearDayOfYearDayOfMonthTable) @@ -846,7 +931,8 @@ dayOfYearToMonthDay isLeap dayOfYear = -- | Convert a 'Day' to an 'OrdinalDate'. dayToOrdinalDate :: Day -> OrdinalDate -dayToOrdinalDate (Day mjd) = OrdinalDate (Year $ fromIntegral year) (DayOfYear $ fromIntegral yd) where +dayToOrdinalDate (Day mjd) = OrdinalDate (Year $ fromIntegral year) (DayOfYear $ fromIntegral yd) + where a = (fromIntegral mjd :: Int64) + 678575 quadcent = div a 146097 b = mod a 146097 @@ -863,56 +949,62 @@ dayToOrdinalDate (Day mjd) = OrdinalDate (Year $ fromIntegral year) (DayOfYear $ 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)) +{- | 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)) +{- | 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)) +{- | 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)) +{- | 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 + -- | 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 @@ -921,148 +1013,167 @@ 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) - ] +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) - ] +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) - ] +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) - ] +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]) + 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 :: (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]) + 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 :: (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]) + 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. +{- | 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" + 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 +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. +{- | 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" + 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 +encode_Dmy msep = LT.toStrict . TB.toLazyText . builder_Dmy msep --- | Parse a Year\/Month\/Day-encoded 'Date' that uses the --- given separator. +{- | 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 @@ -1074,8 +1185,9 @@ parser_Ymd msep = do 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. +{- | 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 @@ -1090,8 +1202,9 @@ parser_Ymd_lenient = do (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. +{- | 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 @@ -1103,8 +1216,9 @@ parser_Mdy msep = do 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. +{- | 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 @@ -1119,8 +1233,9 @@ parser_Mdy_lenient = do (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. +{- | 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 @@ -1132,8 +1247,9 @@ parser_Dmy msep = do 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. +{- | 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 @@ -1148,23 +1264,26 @@ parser_Dmy_lenient = do (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. +{- | 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. + 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 @@ -1176,49 +1295,56 @@ parserUtf8_Ymd msep = do 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. +{- | 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 + 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. +{- | 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 + 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. +{- | 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 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 + 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 +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. +{- | 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 @@ -1233,8 +1359,9 @@ parser_HMS msep = do 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. +{- | 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 @@ -1246,14 +1373,15 @@ parser_HMS_lenient = do 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. +{- | 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 @@ -1265,31 +1393,34 @@ parser_HMS_opt_S msep = do 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) + 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. + 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 @@ -1314,31 +1445,37 @@ parseSecondsAndNanoseconds = do 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 + ( 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 +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 + Just c -> + if c == '0' + then AT.anyChar *> go (i + 1) + else pure i nanosecondsBuilder :: Int64 -> TB.Builder nanosecondsBuilder w @@ -1376,174 +1513,198 @@ prettyNanosecondsBuilder sp nano = case sp of | 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 + 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'. +{- | 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 + 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 + 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 + 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'. +{- | 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. + 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_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 + 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'. +{- | 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. +{- | 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'. +{- | 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. +{- | 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'. +{- | 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. + 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_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 + 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'. +{- | 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'. +{- | 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" +{- | 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 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 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'. +{- | 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 @@ -1551,14 +1712,15 @@ parser_DmyHMS (DatetimeFormat mdateSep msep mtimeSep) = do 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. +{- | 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 @@ -1566,14 +1728,15 @@ parser_DmyHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do 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 +{- | 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 @@ -1581,16 +1744,17 @@ parser_DmyHMS_lenient = do 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. +{- | 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 @@ -1598,54 +1762,58 @@ parser_DmyHMS_opt_S_lenient = do 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 +{- | 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 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 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 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'. +{- | 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 @@ -1653,9 +1821,10 @@ parser_MdyHMS (DatetimeFormat mdateSep msep mtimeSep) = do 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. +{- | 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 @@ -1663,15 +1832,16 @@ parser_MdyHMS_lenient = do 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. +{- | 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 @@ -1679,15 +1849,16 @@ parser_MdyHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do 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. +{- | 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 @@ -1695,47 +1866,52 @@ parser_MdyHMS_opt_S_lenient = do 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 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 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 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. +{- | 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'. +{- | 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 @@ -1743,9 +1919,10 @@ parser_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do 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. +{- | 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 @@ -1753,16 +1930,17 @@ parser_YmdHMS_lenient = do 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. +{- | 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 @@ -1770,16 +1948,17 @@ parser_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do 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. +{- | 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 @@ -1787,56 +1966,61 @@ parser_YmdHMS_opt_S_lenient = do 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 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 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 +{- | 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. +{- | 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 --------------- @@ -1844,40 +2028,45 @@ decode_lenient = -- | 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 + 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. +{- | 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 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 + 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 +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 + 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. +{- | 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 @@ -1889,14 +2078,15 @@ parserUtf8_HMS msep = do 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. +{- | 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 @@ -1908,21 +2098,23 @@ parserUtf8_HMS_opt_S msep = do 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) + 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) + 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 @@ -1931,31 +2123,37 @@ parseSecondsAndNanosecondsUtf8 = do -- 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 + ( 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 +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 + Just c -> + if c == '0' + then AB.anyChar *> go (i + 1) + else pure i nanosecondsBuilderUtf8 :: Int64 -> BB.Builder nanosecondsBuilderUtf8 w @@ -1993,108 +2191,123 @@ prettyNanosecondsBuilderUtf8 sp nano = case sp of | 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'. + 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'. +{- | 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 + 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 + 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 + 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'. +{- | 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. +{- | 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'. +{- | 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. + 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 + 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'. +{- | 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 + 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'. +{- | 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'. +{- | 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'. +{- | 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 @@ -2102,14 +2315,15 @@ parserUtf8_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do 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. +{- | 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 @@ -2117,102 +2331,116 @@ parserUtf8_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do 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. +{- | 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'. +{- | 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 + 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'. +{- | 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'. +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'. + 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 + 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'. +{- | 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 + 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'. +{- | 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'. +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'. + 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 + LT.toStrict . TB.toLazyText . builder_DmyHMSz offsetFormat sp datetimeFormat --- | Construct a 'Text' 'TB.Builder' corresponding to the w3c-formatting --- of the given 'OffsetDatetime'. +{- | 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 ':')) +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'. +{- | 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 @@ -2220,8 +2448,9 @@ builderOffset x = case x of OffsetFormatSecondsPrecision -> builderOffset_z2 OffsetFormatColonAuto -> builderOffset_z3 --- | Decode an 'Offset' from 'Text' that was encoded --- using the given 'OffsetFormat'. +{- | 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) @@ -2240,9 +2469,10 @@ parseSignedness = do c <- AT.anyChar if c == '-' then pure False - else if c == '+' - then pure True - else fail "while parsing offset, expected [+] or [-]" + else + if c == '+' + then pure True + else fail "while parsing offset, expected [+] or [-]" parserOffset_z :: Parser Offset parserOffset_z = do @@ -2250,9 +2480,10 @@ parserOffset_z = do h <- parseFixedDigits 2 m <- parseFixedDigits 2 let !res = h * 60 + m - pure . Offset $ if pos - then res - else negate res + pure . Offset $ + if pos + then res + else negate res parserOffset_z1 :: Parser Offset parserOffset_z1 = do @@ -2261,9 +2492,10 @@ parserOffset_z1 = do _ <- AT.char ':' m <- parseFixedDigits 2 let !res = h * 60 + m - pure . Offset $ if pos - then res - else negate res + pure . Offset $ + if pos + then res + else negate res parserOffset_z2 :: AT.Parser Offset parserOffset_z2 = do @@ -2273,13 +2505,15 @@ parserOffset_z2 = do 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. + 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 @@ -2290,98 +2524,111 @@ parserOffset_z3 = 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) + 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 + let (!a, !b) = divMod (abs i) 60 !prefix = if signum i == (-1) then "-" else "+" in prefix - <> indexTwoDigitTextBuilder a - <> indexTwoDigitTextBuilder b + <> indexTwoDigitTextBuilder a + <> indexTwoDigitTextBuilder b builderOffset_z1 :: Offset -> TB.Builder builderOffset_z1 (Offset i) = - let (!a,!b) = divMod (abs i) 60 + let (!a, !b) = divMod (abs i) 60 !prefix = if signum i == (-1) then "-" else "+" in prefix - <> indexTwoDigitTextBuilder a - <> ":" - <> indexTwoDigitTextBuilder b + <> indexTwoDigitTextBuilder a + <> ":" + <> indexTwoDigitTextBuilder b builderOffset_z2 :: Offset -> TB.Builder builderOffset_z2 (Offset i) = - let (!a,!b) = divMod (abs i) 60 + let (!a, !b) = divMod (abs i) 60 !prefix = if signum i == (-1) then "-" else "+" in prefix - <> indexTwoDigitTextBuilder a - <> ":" - <> indexTwoDigitTextBuilder b - <> ":00" + <> indexTwoDigitTextBuilder a + <> ":" + <> indexTwoDigitTextBuilder b + <> ":00" builderOffset_z3 :: Offset -> TB.Builder builderOffset_z3 (Offset i) = - let (!a,!b) = divMod (abs i) 60 + 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'. + 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 + 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'. +{- | 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'. +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 + builderUtf8_YmdIMS_p meridiemLocale sp datetimeFormat datetime + <> " " + <> builderOffsetUtf8 offsetFormat offset --- | Construct a 'ByteString' 'BB.Builder' corresponding to the W3C --- encoding of the given 'Datetime'. +{- | 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 ':')) +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'. +{- | 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'. +{- | 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 @@ -2389,8 +2636,9 @@ builderOffsetUtf8 x = case x of OffsetFormatSecondsPrecision -> builderOffsetUtf8_z2 OffsetFormatColonAuto -> builderOffsetUtf8_z3 --- | Parse an 'Offset' that was encoded using the given --- 'OffsetFormat'. +{- | Parse an 'Offset' that was encoded using the given + 'OffsetFormat'. +-} parserOffsetUtf8 :: OffsetFormat -> AB.Parser Offset parserOffsetUtf8 x = case x of OffsetFormatColonOff -> parserOffsetUtf8_z @@ -2404,9 +2652,10 @@ parseSignednessUtf8 = do c <- AB.anyChar if c == '-' then pure False - else if c == '+' - then pure True - else fail "while parsing offset, expected [+] or [-]" + else + if c == '+' + then pure True + else fail "while parsing offset, expected [+] or [-]" parserOffsetUtf8_z :: AB.Parser Offset parserOffsetUtf8_z = do @@ -2414,9 +2663,10 @@ parserOffsetUtf8_z = do h <- parseFixedDigitsIntBS 2 m <- parseFixedDigitsIntBS 2 let !res = h * 60 + m - pure . Offset $ if pos - then res - else negate res + pure . Offset $ + if pos + then res + else negate res parserOffsetUtf8_z1 :: AB.Parser Offset parserOffsetUtf8_z1 = do @@ -2425,9 +2675,10 @@ parserOffsetUtf8_z1 = do _ <- AB.char ':' m <- parseFixedDigitsIntBS 2 let !res = h * 60 + m - pure . Offset $ if pos - then res - else negate res + pure . Offset $ + if pos + then res + else negate res parserOffsetUtf8_z2 :: AB.Parser Offset parserOffsetUtf8_z2 = do @@ -2437,13 +2688,15 @@ parserOffsetUtf8_z2 = do 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. + 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 @@ -2454,56 +2707,62 @@ parserOffsetUtf8_z3 = 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) + 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 + let (!a, !b) = divMod (abs i) 60 !prefix = if signum i == (-1) then "-" else "+" in prefix - <> indexTwoDigitByteStringBuilder a - <> indexTwoDigitByteStringBuilder b + <> indexTwoDigitByteStringBuilder a + <> indexTwoDigitByteStringBuilder b builderOffsetUtf8_z1 :: Offset -> BB.Builder builderOffsetUtf8_z1 (Offset i) = - let (!a,!b) = divMod (abs i) 60 + let (!a, !b) = divMod (abs i) 60 !prefix = if signum i == (-1) then "-" else "+" in prefix - <> indexTwoDigitByteStringBuilder a - <> ":" - <> indexTwoDigitByteStringBuilder b + <> indexTwoDigitByteStringBuilder a + <> ":" + <> indexTwoDigitByteStringBuilder b builderOffsetUtf8_z2 :: Offset -> BB.Builder builderOffsetUtf8_z2 (Offset i) = - let (!a,!b) = divMod (abs i) 60 + let (!a, !b) = divMod (abs i) 60 !prefix = if signum i == (-1) then "-" else "+" in prefix - <> indexTwoDigitByteStringBuilder a - <> ":" - <> indexTwoDigitByteStringBuilder b - <> ":00" + <> indexTwoDigitByteStringBuilder a + <> ":" + <> indexTwoDigitByteStringBuilder b + <> ":00" builderOffsetUtf8_z3 :: Offset -> BB.Builder builderOffsetUtf8_z3 (Offset i) = - let (!a,!b) = divMod (abs i) 60 + 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 + then + prefix + <> indexTwoDigitByteStringBuilder a + else + prefix + <> indexTwoDigitByteStringBuilder a + <> ":" + <> indexTwoDigitByteStringBuilder b -- Zepto parsers --- | Parse a 'Datetime' that was encoded using the --- given 'DatetimeFormat'. +{- | 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 @@ -2517,8 +2776,9 @@ zeptoCountZeroes = do bs <- Z.takeWhile (0x30 ==) pure $! BC.length bs --- | Parse a 'Date' that was encoded using --- the given separator. +{- | Parse a 'Date' that was encoded using + the given separator. +-} zeptoUtf8_Ymd :: Maybe Char -> Z.Parser Date zeptoUtf8_Ymd msep' = do y <- zeptoFixedDigitsIntBS 4 @@ -2531,8 +2791,9 @@ zeptoUtf8_Ymd msep' = do 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. +{- | Parse a 'TimeOfDay' that was encoded using + the given separator. +-} zeptoUtf8_HMS :: Maybe Char -> Z.Parser TimeOfDay zeptoUtf8_HMS msep' = do h <- zeptoFixedDigitsIntBS 2 @@ -2550,9 +2811,10 @@ 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)" + 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 @@ -2560,17 +2822,21 @@ zeptoSecondsAndNanosecondsUtf8 = do 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 + ( 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 @@ -2578,7 +2844,7 @@ zdecimal = do digits <- Z.takeWhile wordIsDigit case BC.readInt digits of Nothing -> fail "somehow this didn't work" - Just (i,_) -> pure $! fromIntegral i + Just (i, _) -> pure $! fromIntegral i wordIsDigit :: Word8 -> Bool wordIsDigit a = 0x30 <= a && a <= 0x39 @@ -2662,28 +2928,33 @@ 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 + | 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 @@ -2695,62 +2966,159 @@ 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" + 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)" + 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 +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 +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 +twoDigitByteStringBuilder = + Vector.fromList $ + map (BB.byteString . BC.pack) twoDigitStrings {-# NOINLINE twoDigitByteStringBuilder #-} twoDigitTextBuilder :: Vector TB.Builder -twoDigitTextBuilder = Vector.fromList - $ map (TB.fromText . Text.pack) twoDigitStrings +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" + [ "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 +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] +tenRaisedToSmallPowers = UVector.fromList $ map (10 ^) [0 :: Int .. 15] yearToZeroPaddedDigit :: Year -> TB.Builder yearToZeroPaddedDigit (Year x) @@ -2788,9 +3156,10 @@ t `within` (TimeInterval t0 t1) = t >= t0 && t <= t1 timeIntervalToTimespan :: TimeInterval -> Timespan timeIntervalToTimespan = width --- | The 'TimeInterval' that covers the entire range of 'Time's that Chronos supports. --- --- prop> \(t :: Time) -> within t whole +{- | 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 @@ -2810,9 +3179,10 @@ upperBound (TimeInterval _ t1) = t1 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@. +{- | 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 @@ -2824,60 +3194,63 @@ infix 3 ... (...) :: 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) +{- | 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 :: (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) +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 :: (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) +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 :: (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) +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 :: (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) +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 :: (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" + 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) @@ -2885,57 +3258,62 @@ 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) +{- | 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 :: (Functor f) => (Int -> f Int) -> Year -> f Year _getYear f = fmap Year . f . getYear -- | A in minutes. -newtype Offset = Offset { getOffset :: Int } - deriving (Show,Read,Eq,Ord,Enum,NFData) +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 :: (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) +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 :: (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 } +{- | 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 } +{- | 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 } +{- | 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 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 :: (Functor f) => (Int64 -> f Int64) -> Timespan -> f Timespan _getTimespan f = fmap Timespan . f . getTimespan instance Semigroup Timespan where @@ -2958,197 +3336,215 @@ instance Torsor Offset Int where -- | 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 + = -- | 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 + { dateYear :: {-# UNPACK #-} !Year , dateMonth :: {-# UNPACK #-} !Month - , dateDay :: {-# UNPACK #-} !DayOfMonth - } deriving (Show,Read,Eq,Ord) + , 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 +_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 +_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 +_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. +{- | 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) + } + 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 +_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 :: (Functor f) => (DayOfYear -> f DayOfYear) -> OrdinalDate -> f OrdinalDate _ordinalDateDayOfYear f date = - fmap (\d -> date{ordinalDateDayOfYear = d}) . f . ordinalDateDayOfYear $ 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. +{- | 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) + } + 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 +_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. +_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) + } + 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 +_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 +_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) + } + 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 :: + (Functor f) => (Datetime -> f Datetime) -> OffsetDatetime -> f OffsetDatetime _offsetDatetimeDatetime f date = - fmap (\d -> date{offsetDatetimeDatetime = d}) . f . offsetDatetimeDatetime $ 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 :: + (Functor f) => (Offset -> f Offset) -> OffsetDatetime -> f OffsetDatetime _offsetDatetimeOffset f date = - fmap (\y -> date{offsetDatetimeOffset = y}) . f . offsetDatetimeOffset $ 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) + } + 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 :: + (Functor f) => (Int -> f Int) -> TimeOfDay -> f TimeOfDay _timeOfDayHour f time = - fmap (\h -> time{timeOfDayHour = h}) . f . timeOfDayHour $ 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 :: + (Functor f) => (Int -> f Int) -> TimeOfDay -> f TimeOfDay _timeOfDayMinute f time = - fmap (\m -> time{timeOfDayMinute = m}) . f . timeOfDayMinute $ 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 :: + (Functor f) => (Int64 -> f Int64) -> TimeOfDay -> f TimeOfDay _timeOfDayNanoseconds f time = - fmap (\n -> time{timeOfDayNanoseconds = n}) . f . timeOfDayNanoseconds $ 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. +{- | 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 + -- ^ Separator in the date , datetimeFormatSeparator :: !(Maybe Char) - -- ^ Separator between date and time + -- ^ Separator between date and time , datetimeFormatTimeSeparator :: !(Maybe Char) - -- ^ Separator in the time - } deriving (Show,Read,Eq,Ord) + -- ^ 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 - = 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) + = -- | @%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@. +{- | 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 + -- ^ full weekdays starting with Sunday, 7 elements , datetimeLocaleDaysOfWeekAbbreviated :: !(DayOfWeekMatch a) - -- ^ abbreviated weekdays starting with Sunday, 7 elements + -- ^ abbreviated weekdays starting with Sunday, 7 elements , datetimeLocaleMonthsFull :: !(MonthMatch a) - -- ^ full months starting with January, 12 elements + -- ^ full months starting with January, 12 elements , datetimeLocaleMonthsAbbreviated :: !(MonthMatch a) - -- ^ abbreviated months starting with January, 12 elements + -- ^ abbreviated months starting with January, 12 elements } -instance NFData a => NFData (DatetimeLocale a) where +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). +{- | 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) + deriving (Read, Show, Eq, Ord, Bounded) instance NFData TimeInterval where rnf (TimeInterval t1 t2) = t1 `deepseq` t2 `deepseq` () @@ -3157,9 +3553,10 @@ instance NFData TimeInterval where data MeridiemLocale a = MeridiemLocale { meridiemLocaleAm :: !a , meridiemLocalePm :: !a - } deriving (Read,Show,Eq,Ord) + } + deriving (Read, Show, Eq, Ord) -instance NFData a => NFData (MeridiemLocale a) where +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) @@ -3327,10 +3724,11 @@ 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 + 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 @@ -3345,17 +3743,24 @@ 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. +{- | 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 + { 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 + , 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) @@ -3372,51 +3777,61 @@ timeParts 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@. + 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@. +-} decodeShortTextIso8601Zulu :: ShortText -> Maybe Chronos.Datetime -decodeShortTextIso8601Zulu !t = BVP.parseBytesMaybe - ( 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 () - ) (Bytes.fromShortByteString (TS.toShortByteString t)) - --- | Decode an ISO-8601-encode datetime. The encoded time must not be suffixed --- by an offset. Any offset (e.g. @-05:00@, @+00:00@, @Z@) will cause a decode --- failure. +decodeShortTextIso8601Zulu !t = + BVP.parseBytesMaybe + ( 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 () + ) + (Bytes.fromShortByteString (TS.toShortByteString t)) + +{- | Decode an ISO-8601-encode datetime. The encoded time must not be suffixed +by an offset. Any offset (e.g. @-05:00@, @+00:00@, @Z@) will cause a decode +failure. +-} decodeShortTextIso8601Zoneless :: ShortText -> Maybe Chronos.Datetime -decodeShortTextIso8601Zoneless !t = decodeUtf8BytesIso8601Zoneless - (Bytes.fromShortByteString (TS.toShortByteString t)) +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@). +{- | 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)) +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@. +{- | 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 @@ -3426,7 +3841,7 @@ decodeUtf8BytesIso8601 !b = BVP.parseBytesMaybe (parserUtf8BytesIso8601 <* BVP.endOfInput ()) b parserUtf8BytesIso8601Zoneless :: Char -> BVP.Parser () s Chronos.Datetime -{-# noinline parserUtf8BytesIso8601Zoneless #-} +{-# NOINLINE parserUtf8BytesIso8601Zoneless #-} parserUtf8BytesIso8601Zoneless !sep = do year <- Latin.decWord () Latin.char () '-' @@ -3436,10 +3851,11 @@ parserUtf8BytesIso8601Zoneless !sep = do 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)) + 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 ()) @@ -3449,41 +3865,45 @@ parserUtf8BytesIso8601Zoneless !sep = do 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)) + !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 +{- | 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 #-} +{-# NOINLINE parserUtf8BytesIso8601 #-} parserUtf8BytesIso8601 = do dt <- parserUtf8BytesIso8601Zoneless 'T' - off <- Latin.any () >>= \case - 'Z' -> pure 0 - '+' -> parserBytesOffset - '-' -> do - !off <- parserBytesOffset - pure (negate off) - _ -> BVP.fail () + 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 @@ -3497,75 +3917,68 @@ parserBytesOffset = do pure r encodeShortTextIso8601Zulu :: Datetime -> ShortText -{-# noinline encodeShortTextIso8601Zulu #-} +{-# NOINLINE encodeShortTextIso8601Zulu #-} encodeShortTextIso8601Zulu !dt = - let !(ByteArray x) = Bounded.run Nat.constant - ( boundedBuilderUtf8BytesIso8601Zoneless dt - `Bounded.append` - Bounded.ascii 'Z' - ) + 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 #-} +{-# NOINLINE encodeShortTextIso8601Zoneless #-} encodeShortTextIso8601Zoneless !dt = - let !(ByteArray x) = Bounded.run Nat.constant - (boundedBuilderUtf8BytesIso8601Zoneless dt) + let !(ByteArray x) = + Bounded.run + Nat.constant + (boundedBuilderUtf8BytesIso8601Zoneless dt) in TS.fromShortByteStringUnsafe (SBS.SBS x) encodeShortTextIso8601 :: OffsetDatetime -> ShortText -{-# noinline encodeShortTextIso8601 #-} +{-# NOINLINE encodeShortTextIso8601 #-} encodeShortTextIso8601 offdt = - let !(ByteArray x) = Bounded.run Nat.constant - (boundedBuilderUtf8BytesIso8601 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 + `Bounded.append` boundedBuilderOffset off ) --- | Encode a datetime with ISO-8601. The result does not include any --- indication of a time zone. If the subsecond part is zero, it is suppressed. --- Examples of output: --- --- > 2021-01-05T23:00:51 --- > 2021-01-05T23:00:52.123000000 --- > 2021-01-05T23:00:53.674094347 +{- | Encode a datetime with ISO-8601. The result does not include any +indication of a time zone. If the subsecond part is zero, it is suppressed. +Examples of output: + +> 2021-01-05T23:00:51 +> 2021-01-05T23:00:52.123000000 +> 2021-01-05T23:00:53.674094347 +-} boundedBuilderUtf8BytesIso8601Zoneless :: Datetime -> Bounded.Builder 44 boundedBuilderUtf8BytesIso8601Zoneless (Datetime (Date (Year y) (Month mth) (DayOfMonth d)) (TimeOfDay h mt sns)) = - let (s,ns) = quotRem sns 1_000_000_000 in - Bounded.wordDec (fromIntegral y) - `Bounded.append` - Bounded.ascii '-' - `Bounded.append` - Bounded.wordPaddedDec2 (fromIntegral (mth + 1)) - `Bounded.append` - Bounded.ascii '-' - `Bounded.append` - Bounded.wordPaddedDec2 (fromIntegral d) - `Bounded.append` - Bounded.ascii 'T' - `Bounded.append` - Bounded.wordPaddedDec2 (fromIntegral h) - `Bounded.append` - Bounded.ascii ':' - `Bounded.append` - Bounded.wordPaddedDec2 (fromIntegral mt) - `Bounded.append` - Bounded.ascii ':' - `Bounded.append` - Bounded.wordPaddedDec2 (fromIntegral s) - `Bounded.append` - (case ns of - 0 -> Bounded.weaken @0 @10 Lte.constant Bounded.empty - _ -> - Bounded.ascii '.' - `Bounded.append` - Bounded.wordPaddedDec9 (fromIntegral ns) - ) + let (s, ns) = quotRem sns 1_000_000_000 + in Bounded.wordDec (fromIntegral y) + `Bounded.append` Bounded.ascii '-' + `Bounded.append` Bounded.wordPaddedDec2 (fromIntegral (mth + 1)) + `Bounded.append` Bounded.ascii '-' + `Bounded.append` Bounded.wordPaddedDec2 (fromIntegral d) + `Bounded.append` Bounded.ascii 'T' + `Bounded.append` Bounded.wordPaddedDec2 (fromIntegral h) + `Bounded.append` Bounded.ascii ':' + `Bounded.append` Bounded.wordPaddedDec2 (fromIntegral mt) + `Bounded.append` Bounded.ascii ':' + `Bounded.append` Bounded.wordPaddedDec2 (fromIntegral s) + `Bounded.append` ( case ns of + 0 -> Bounded.weaken @0 @10 Lte.constant Bounded.empty + _ -> + Bounded.ascii '.' + `Bounded.append` Bounded.wordPaddedDec9 (fromIntegral ns) + ) boundedBuilderOffset :: Offset -> Bounded.Builder 6 boundedBuilderOffset (Offset mins) = case mins of @@ -3575,9 +3988,6 @@ boundedBuilderOffset (Offset mins) = case mins of !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 + `Bounded.append` Bounded.wordPaddedDec2 absHrs + `Bounded.append` Bounded.ascii ':' + `Bounded.append` Bounded.wordPaddedDec2 absMinutes diff --git a/src/Chronos/Locale/English.hs b/src/Chronos/Locale/English.hs index cce0df9..5ab7ea3 100644 --- a/src/Chronos/Locale/English.hs +++ b/src/Chronos/Locale/English.hs @@ -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,10 +18,11 @@ import Chronos (buildMonthMatch) 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 @@ -40,28 +40,50 @@ lowerDots = MeridiemLocale "a.m." "p.m." 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" diff --git a/src/Chronos/Types.hs b/src/Chronos/Types.hs index 8563ae3..882256e 100644 --- a/src/Chronos/Types.hs +++ b/src/Chronos/Types.hs @@ -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 diff --git a/stack.ghcjs.yaml b/stack.ghcjs.yaml deleted file mode 100644 index ce1ec7c..0000000 --- a/stack.ghcjs.yaml +++ /dev/null @@ -1,18 +0,0 @@ -resolver: lts-5.8 -compiler: ghcjs-0.2.0.20160414_ghc-7.10.3 -compiler-check: match-exact -setup-info: - ghcjs: - source: - ghcjs-0.2.0.20160414_ghc-7.10.3: - url: https://s3.amazonaws.com/ghcjs/ghcjs-0.2.0.20160414_ghc-7.10.3.tar.gz - sha1: 6d6f307503be9e94e0c96ef1308c7cf224d06be3 - -# Local packages, usually specified by relative directory name -packages: - - '.' - -extra-deps: [] -flags: {} -extra-package-dbs: [] - diff --git a/test/Spec.hs b/test/Spec.hs index 6fc736f..fef7e4e 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,34 +1,33 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} {-# 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 Data.ByteString (ByteString) -import Data.Int (Int64) -import Data.Text (Text) -import Data.Text.Lazy.Builder (Builder) -import Test.Framework (defaultMainWithOpts,testGroup,Test) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.HUnit (Assertion,(@?=),assertBool) -import Test.QuickCheck (Arbitrary(..),discard,genericShrink,elements,suchThat) -import Test.QuickCheck (choose,chooseInt,arbitraryBoundedEnum) -import Test.QuickCheck.Property (failed,succeeded,Result(..)) -import qualified Chronos as C import qualified Data.Attoparsec.ByteString as AttoBS 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 @@ -39,569 +38,762 @@ import qualified Torsor as T -- 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 - } - } +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 + "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 "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 + "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 "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 + "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 "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 + "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 "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 + "Posix Time" + [ PH.testCase "Get now" $ do + now <- C.now + assertBool "Current time is the beginning of the epoch." (now /= C.epoch) ] - , 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 + "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 "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 + "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 "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 + "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 "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 + "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 "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) + , 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)) ) - , 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) + , 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 ] - , 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 - } +failure msg = + failed + { reason = msg + , theException = Nothing + } -propEncodeDecodeFullIso :: (Eq a,Show a,Show b) => (a -> b) -> (b -> a) -> a -> Result +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 + 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 :: + (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" - ] + 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 +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 +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 + @?= Right expected bsTimeOfDayParse :: Maybe Char -> ByteString -> TimeOfDay -> Assertion bsTimeOfDayParse m t expected = AttoBS.parseOnly (C.parserUtf8_HMS m <* AttoBS.endOfInput) t - @?= Right expected + @?= 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 + @?= expected bsTimeOfDayBuilder :: SubsecondPrecision -> Maybe Char -> Text -> TimeOfDay -> Assertion bsTimeOfDayBuilder sp m expected tod = LText.toStrict (Builder.toLazyText (C.builder_HMS sp m tod)) - @?= expected + @?= expected dateParse :: Atto.Parser Date -> Text -> Date -> Assertion dateParse p t expected = Atto.parseOnly (p <* Atto.endOfInput) t - @?= Right expected + @?= Right expected ---dateParseFail :: Atto.Parser Date -> Text -> String -> Assertion ---dateParseFail p t 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 + @?= Right expected datetimeParseFail :: Atto.Parser Datetime -> Text -> String -> Assertion datetimeParseFail p t expected = Atto.parseOnly (p <* Atto.endOfInput) t - @?= Left expected + @?= Left expected dateBuilder :: Maybe Char -> Text -> Date -> Assertion dateBuilder m expected tod = LText.toStrict (Builder.toLazyText (C.builder_Ymd m tod)) - @?= expected + @?= expected matchBuilder :: Text -> Builder -> Assertion matchBuilder a b = LText.toStrict (Builder.toLazyText b) @?= a @@ -615,72 +807,75 @@ propWithinOutsideInterval (RelatedTimes t ti@(TimeInterval t0 t1)) | t == t1 = discard | t1 <= t0 = discard | t0 < (Time 0) = discard - | t < (Time 0) = discard + | t < (Time 0) = discard | otherwise = - let - span' = C.timeIntervalToTimespan ti - tm = T.add span' t - in - not $ C.within tm ti + 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 + 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 + in ti == te propWidthVerifyBounds :: TimeInterval -> Bool propWidthVerifyBounds ti@(TimeInterval (Time lower) (Time upper)) = let tiWidth = (getTimespan . C.width) ti - in + in T.add lower tiWidth == upper && T.difference upper tiWidth == lower propTimeIntervalBuilder :: Time -> Time -> Bool -propTimeIntervalBuilder t0 t1 = +propTimeIntervalBuilder t0 t1 = let (TimeInterval ti te) = (C.timeIntervalBuilder t0 t1) - in + 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) - ) - ) + 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)) + 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 @@ -691,15 +886,17 @@ instance Arbitrary Datetime where -- <*> choose (0,24 * 60 * 60 * 1000000000 - 1) instance Arbitrary OffsetDatetime where - arbitrary = OffsetDatetime - <$> arbitrary - <*> arbitrary + 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 '-'] + 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 ':')] @@ -721,9 +918,9 @@ data RelatedTimes = RelatedTimes Time TimeInterval instance Arbitrary RelatedTimes where arbitrary = do - ti@(TimeInterval t0 t1) <- arbitrary - tm <- fmap Time (choose (getTime t0, getTime t1)) - pure $ RelatedTimes tm ti + 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))