Skip to content

Commit

Permalink
Merge pull request #1032 from haskell/text-iso8601
Browse files Browse the repository at this point in the history
Text iso8601
  • Loading branch information
phadej authored Jun 9, 2023
2 parents 212c324 + f0be72f commit 3e6cee2
Show file tree
Hide file tree
Showing 16 changed files with 1,004 additions and 111 deletions.
9 changes: 8 additions & 1 deletion .github/workflows/haskell-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -213,6 +213,7 @@ jobs:
touch cabal.project
echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
echo "packages: $GITHUB_WORKSPACE/source/attoparsec-iso8601" >> cabal.project
echo "packages: $GITHUB_WORKSPACE/source/text-iso8601" >> cabal.project
echo "packages: $GITHUB_WORKSPACE/source/examples" >> cabal.project
echo "packages: $GITHUB_WORKSPACE/source/benchmarks" >> cabal.project
cat cabal.project
Expand All @@ -230,6 +231,8 @@ jobs:
echo "PKGDIR_aeson=${PKGDIR_aeson}" >> "$GITHUB_ENV"
PKGDIR_attoparsec_iso8601="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/attoparsec-iso8601-[0-9.]*')"
echo "PKGDIR_attoparsec_iso8601=${PKGDIR_attoparsec_iso8601}" >> "$GITHUB_ENV"
PKGDIR_text_iso8601="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/text-iso8601-[0-9.]*')"
echo "PKGDIR_text_iso8601=${PKGDIR_text_iso8601}" >> "$GITHUB_ENV"
PKGDIR_aeson_examples="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/aeson-examples-[0-9.]*')"
echo "PKGDIR_aeson_examples=${PKGDIR_aeson_examples}" >> "$GITHUB_ENV"
PKGDIR_aeson_benchmarks="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/aeson-benchmarks-[0-9.]*')"
Expand All @@ -239,20 +242,23 @@ jobs:
touch cabal.project.local
echo "packages: ${PKGDIR_aeson}" >> cabal.project
echo "packages: ${PKGDIR_attoparsec_iso8601}" >> cabal.project
echo "packages: ${PKGDIR_text_iso8601}" >> cabal.project
echo "packages: ${PKGDIR_aeson_examples}" >> cabal.project
echo "packages: ${PKGDIR_aeson_benchmarks}" >> cabal.project
echo "package aeson" >> cabal.project
echo " ghc-options: -Werror=missing-methods" >> cabal.project
echo "package attoparsec-iso8601" >> cabal.project
echo " ghc-options: -Werror=missing-methods" >> cabal.project
echo "package text-iso8601" >> cabal.project
echo " ghc-options: -Werror=missing-methods" >> cabal.project
echo "package aeson-examples" >> cabal.project
echo " ghc-options: -Werror=missing-methods" >> cabal.project
echo "package aeson-benchmarks" >> cabal.project
echo " ghc-options: -Werror=missing-methods" >> cabal.project
cat >> cabal.project <<EOF
allow-newer: hermes-json:attoparsec-iso8601
EOF
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(aeson|aeson-benchmarks|aeson-examples|attoparsec-iso8601)$/; }' >> cabal.project.local
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(aeson|aeson-benchmarks|aeson-examples|attoparsec-iso8601|text-iso8601)$/; }' >> cabal.project.local
cat cabal.project
cat cabal.project.local
- name: dump install plan
Expand Down Expand Up @@ -282,6 +288,7 @@ jobs:
run: |
if [ $((HCNUMVER >= 90200 && HCNUMVER < 90400)) -ne 0 ] ; then (cd ${PKGDIR_aeson} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 src attoparsec-iso8601/src src-pure) ; fi
if [ $((HCNUMVER >= 90200 && HCNUMVER < 90400)) -ne 0 ] ; then (cd ${PKGDIR_attoparsec_iso8601} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 src) ; fi
if [ $((HCNUMVER >= 90200 && HCNUMVER < 90400)) -ne 0 ] ; then (cd ${PKGDIR_text_iso8601} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 src) ; fi
if [ $((HCNUMVER >= 90200 && HCNUMVER < 90400)) -ne 0 ] ; then (cd ${PKGDIR_aeson_examples} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 src/) ; fi
if [ $((HCNUMVER >= 90200 && HCNUMVER < 90400)) -ne 0 ] ; then (cd ${PKGDIR_aeson_benchmarks} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 .) ; fi
if [ $((HCNUMVER >= 90200 && HCNUMVER < 90400)) -ne 0 ] ; then (cd ${PKGDIR_aeson_benchmarks} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 bench examples/src) ; fi
Expand Down
8 changes: 8 additions & 0 deletions .hlint.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,14 @@
name: "Use <=<"
within:
- Data.Aeson.Types.FromJSON
- ignore:
name: "Avoid lambda"
within:
- Data.Time.FromText
- ignore:
name: "Use isDigit"
within:
- Data.Time.FromText

# CPP confuses
- ignore:
Expand Down
2 changes: 1 addition & 1 deletion Makefile
Original file line number Diff line number Diff line change
@@ -1,2 +1,2 @@
lint:
./run-hlint.sh --cpp-include include/ src/ attoparsec-iso8601/ benchmarks/ examples/ src-pure/ tests/
./run-hlint.sh --cpp-include include/ src/ attoparsec-iso8601/ benchmarks/ examples/ src-pure/ tests/ text-iso8601/src text-iso8601/tests
3 changes: 2 additions & 1 deletion aeson.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ tested-with:
|| ==9.6.2

synopsis: Fast JSON parsing and encoding
cabal-version: >=1.10
cabal-version: 1.12
homepage: https://github.com/haskell/aeson
bug-reports: https://github.com/haskell/aeson/issues
build-type: Simple
Expand Down Expand Up @@ -126,6 +126,7 @@ library
, semialign >=1.3 && <1.4
, strict >=0.5 && <0.6
, tagged >=0.8.7 && <0.9
, text-iso8601 >=0.1 && <0.2
, text-short >=0.1.5 && <0.2
, th-abstraction >=0.5.0.0 && <0.6
, these >=1.2 && <1.3
Expand Down
2 changes: 1 addition & 1 deletion attoparsec-iso8601/attoparsec-iso8601.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ copyright:
author: Bryan O'Sullivan <[email protected]>
maintainer: Adam Bergmark <[email protected]>
stability: experimental
cabal-version: >=1.10
cabal-version: 1.12
homepage: https://github.com/haskell/aeson
bug-reports: https://github.com/haskell/aeson/issues
build-type: Simple
Expand Down
4 changes: 4 additions & 0 deletions attoparsec-iso8601/src/Data/Attoparsec/Time.hs
Original file line number Diff line number Diff line change
Expand Up @@ -133,6 +133,9 @@ seconds = do

-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
-- zero. (This makes some speedups possible.)
--
-- The accepted formats are @Z@, @+HH@, @+HHMM@, or @+HH:MM@.
--
timeZone :: Parser (Maybe Local.TimeZone)
timeZone = do
ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
Expand Down Expand Up @@ -175,6 +178,7 @@ utcTime = do
in return (UTCTime d tt)
Just tz -> return $! Local.localTimeToUTC tz lt


-- | Parse a date with time zone info. Acceptable formats:
--
-- @YYYY-MM-DD HH:MM Z@
Expand Down
1 change: 1 addition & 0 deletions cabal.project
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
with-compiler: ghc
packages: .
packages: attoparsec-iso8601
packages: text-iso8601
packages: examples
packages: benchmarks
tests: true
Expand Down
100 changes: 20 additions & 80 deletions src/Data/Aeson/Parser/Time.hs
Original file line number Diff line number Diff line change
@@ -1,85 +1,25 @@
module Data.Aeson.Parser.Time
(
run
, day
, month
, quarter
, localTime
, timeOfDay
, timeZone
, utcTime
, zonedTime
) where
module Data.Aeson.Parser.Time (
run,
FT.parseDay,
FT.parseMonth,
FT.parseQuarter,
FT.parseQuarterOfYear,
FT.parseLocalTime,
FT.parseTimeOfDay,
FT.parseUTCTime,
FT.parseZonedTime,
) where

import Data.Attoparsec.Text (Parser)
import Data.Text (Text)
import Data.Time.Calendar (Day)
import Data.Time.Calendar.Quarter.Compat (Quarter)
import Data.Time.Calendar.Month.Compat (Month)
import Data.Time.Clock (UTCTime(..))
import qualified Data.Aeson.Types.Internal as Aeson
import qualified Data.Attoparsec.Text as A
import qualified Data.Attoparsec.Time as T
import qualified Data.Time.LocalTime as Local

-- | Run an attoparsec parser as an aeson parser.
run :: Parser a -> Text -> Aeson.Parser a
run p t = case A.parseOnly (p <* A.endOfInput) t of
Left err -> fail $ "could not parse date: " ++ err
Right r -> return r

-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
day :: Parser Day
day = T.day
{-# INLINE day #-}

-- | Parse a date of the form @[+,-]YYYY-MM@.
month :: Parser Month
month = T.month
{-# INLINE month #-}

-- | Parse a date of the form @[+,-]YYYY-QN@.
quarter :: Parser Quarter
quarter = T.quarter
{-# INLINE quarter #-}

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
timeOfDay :: Parser Local.TimeOfDay
timeOfDay = T.timeOfDay
{-# INLINE timeOfDay #-}

-- | Parse a quarter of the form @[+,-]YYYY-QN@.

-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
-- zero. (This makes some speedups possible.)
timeZone :: Parser (Maybe Local.TimeZone)
timeZone = T.timeZone
{-# INLINE timeZone #-}

-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
-- The space may be replaced with a @T@. The number of seconds is optional
-- and may be followed by a fractional component.
localTime :: Parser Local.LocalTime
localTime = T.localTime
{-# INLINE localTime #-}
import qualified Data.Aeson.Types.Internal as Aeson
import qualified Data.Time.FromText as FT

-- | Behaves as 'zonedTime', but converts any time zone offset into a
-- UTC time.
utcTime :: Parser UTCTime
utcTime = T.utcTime
{-# INLINE utcTime #-}
type Parser a = Text -> Either String a

-- | Parse a date with time zone info. Acceptable formats:
--
-- @YYYY-MM-DD HH:MM Z@
-- @YYYY-MM-DD HH:MM:SS Z@
-- @YYYY-MM-DD HH:MM:SS.SSS Z@
--
-- The first space may instead be a @T@, and the second space is
-- optional. The @Z@ represents UTC. The @Z@ may be replaced with a
-- time zone offset of the form @+0000@ or @-08:00@, where the first
-- two digits are hours, the @:@ is optional and the second two digits
-- (also optional) are minutes.
zonedTime :: Parser Local.ZonedTime
zonedTime = T.zonedTime
{-# INLINE zonedTime #-}
-- | Run a @text-iso8601@ parser as an aeson parser.
run :: Parser a -> Text -> Aeson.Parser a
run f t = case f t of
Left err -> fail $ "could not parse date: " ++ err
Right r -> return r
{-# INLINE run #-}
46 changes: 19 additions & 27 deletions src/Data/Aeson/Types/FromJSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2071,49 +2071,49 @@ instance (PM.Prim a,FromJSON a) => FromJSON (PM.PrimArray a) where
-------------------------------------------------------------------------------

instance FromJSON Day where
parseJSON = withText "Day" (Time.run Time.day)
parseJSON = withText "Day" (Time.run Time.parseDay)

instance FromJSONKey Day where
fromJSONKey = FromJSONKeyTextParser (Time.run Time.day)
fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseDay)


instance FromJSON TimeOfDay where
parseJSON = withText "TimeOfDay" (Time.run Time.timeOfDay)
parseJSON = withText "TimeOfDay" (Time.run Time.parseTimeOfDay)

instance FromJSONKey TimeOfDay where
fromJSONKey = FromJSONKeyTextParser (Time.run Time.timeOfDay)
fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseTimeOfDay)


instance FromJSON LocalTime where
parseJSON = withText "LocalTime" (Time.run Time.localTime)
parseJSON = withText "LocalTime" (Time.run Time.parseLocalTime)

instance FromJSONKey LocalTime where
fromJSONKey = FromJSONKeyTextParser (Time.run Time.localTime)
fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseLocalTime)


-- | Supported string formats:
--
-- @YYYY-MM-DD HH:MM Z@
-- @YYYY-MM-DD HH:MM:SS Z@
-- @YYYY-MM-DD HH:MM:SS.SSS Z@
-- @YYYY-MM-DD HH:MMZ@
-- @YYYY-MM-DD HH:MM:SSZ@
-- @YYYY-MM-DD HH:MM:SS.SSSZ@
--
-- The first space may instead be a @T@, and the second space is
-- optional. The @Z@ represents UTC. The @Z@ may be replaced with a
-- time zone offset of the form @+0000@ or @-08:00@, where the first
-- two digits are hours, the @:@ is optional and the second two digits
-- (also optional) are minutes.
instance FromJSON ZonedTime where
parseJSON = withText "ZonedTime" (Time.run Time.zonedTime)
parseJSON = withText "ZonedTime" (Time.run Time.parseZonedTime)

instance FromJSONKey ZonedTime where
fromJSONKey = FromJSONKeyTextParser (Time.run Time.zonedTime)
fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseZonedTime)


instance FromJSON UTCTime where
parseJSON = withText "UTCTime" (Time.run Time.utcTime)
parseJSON = withText "UTCTime" (Time.run Time.parseUTCTime)

instance FromJSONKey UTCTime where
fromJSONKey = FromJSONKeyTextParser (Time.run Time.utcTime)
fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseUTCTime)


-- | This instance includes a bounds check to prevent maliciously
Expand Down Expand Up @@ -2166,30 +2166,22 @@ instance FromJSONKey DayOfWeek where
fromJSONKey = FromJSONKeyTextParser parseDayOfWeek

instance FromJSON QuarterOfYear where
parseJSON = withText "DaysOfWeek" parseQuarterOfYear

parseQuarterOfYear :: T.Text -> Parser QuarterOfYear
parseQuarterOfYear t = case T.toLower t of
"q1" -> return Q1
"q2" -> return Q2
"q3" -> return Q3
"q4" -> return Q4
_ -> fail "Invalid quarter of year"
parseJSON = withText "QuarterOfYear" (Time.run Time.parseQuarterOfYear)

instance FromJSONKey QuarterOfYear where
fromJSONKey = FromJSONKeyTextParser parseQuarterOfYear
fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseQuarterOfYear)

instance FromJSON Quarter where
parseJSON = withText "Quarter" (Time.run Time.quarter)
parseJSON = withText "Quarter" (Time.run Time.parseQuarter)

instance FromJSONKey Quarter where
fromJSONKey = FromJSONKeyTextParser (Time.run Time.quarter)
fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseQuarter)

instance FromJSON Month where
parseJSON = withText "Month" (Time.run Time.month)
parseJSON = withText "Month" (Time.run Time.parseMonth)

instance FromJSONKey Month where
fromJSONKey = FromJSONKeyTextParser (Time.run Time.month)
fromJSONKey = FromJSONKeyTextParser (Time.run Time.parseMonth)

-------------------------------------------------------------------------------
-- base Monoid/Semigroup
Expand Down
30 changes: 30 additions & 0 deletions text-iso8601/LICENSE
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
Copyright (c) 2023 Oleg Grenrus

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

3. Neither the name of the author nor the names of his contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
23 changes: 23 additions & 0 deletions text-iso8601/bench/text-iso8601-bench.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,23 @@
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import Data.Text (Text)
import Test.Tasty.Bench (defaultMain, bench, nf)

import qualified Data.Attoparsec.Text as A
import qualified Data.Attoparsec.Time as A

import Data.Time.FromText (parseUTCTime)

main :: IO ()
main = defaultMain
[ bench "text" $ nf parseUTCTime input1
, bench "atto" $ nf (runAtto A.utcTime) input1
]

input1 :: Text
input1 = "2023-06-09T16:53:55Z"
{-# NOINLINE input1 #-}

runAtto :: A.Parser a -> Text -> Either String a
runAtto p t = A.parseOnly (p <* A.endOfInput) t
3 changes: 3 additions & 0 deletions text-iso8601/changelog.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
# 0.1

Initial release
Loading

0 comments on commit 3e6cee2

Please sign in to comment.