Use text-iso8601 to FromJSON time types

Author: phadej

aeson.cabal

@@ -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

src/Data/Aeson/Parser/Time.hs

@@ -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 #-}

src/Data/Aeson/Types/FromJSON.hs

@@ -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
@@ -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