git.iko.soy/typeable/aeson
on master help sign in
Switch to my date/time parsers
commit0a1ad3f4d6f6618faf379f976d5c9236fbd00c26 authorBryan O'Sullivan <bos@serpentine.com> dateFri 17 Jul 2015, 22:55 (11 years ago) parent9cf51f9
2 files changed+59−165
compare with master
unifiedsplit
Data/Aeson/Parser/Time.hs+54−73 Data/Aeson/Types/Instances.hs+5−92
Data/Aeson/Parser/Time.hs+54−73
@@ -1,8 +1,9 @@
1−{-# LANGUAGE CPP, ScopedTypeVariables #-}
1+{-# LANGUAGE ScopedTypeVariables #-}
22
33module Data.Aeson.Parser.Time
44 (
5− day
5+ run
6+ , day
67 , timeOfDay
78 , timeZone
89 , utcTime
@@ -11,104 +12,84 @@ module Data.Aeson.Parser.Time
1112
1213import Control.Applicative ((<$>), (<|>), empty)
1314import Control.Monad (when, void)
14−import qualified Data.Aeson.Types.Internal as Aeson
1515import Data.Attoparsec.Text as A
16−import Data.Char (isDigit)
16+import Data.Bits ((.&.))
17+import Data.Char (ord)
1718import Data.Fixed (Pico)
19+import Data.Int (Int64)
1820import Data.Text (Text)
1921import Data.Time.Calendar (Day, fromGregorianValid)
2022import Data.Time.Clock (UTCTime)
21−import Data.Time.Format (parseTime)
22−import qualified Data.Time.LocalTime as Local
23+import qualified Data.Aeson.Types.Internal as Aeson
2324import qualified Data.Text as T
24−import qualified Data.Text.Read as T
25+import qualified Data.Time.LocalTime as Local
2526
26−#if MIN_VERSION_time(1,5,0)
27−import Data.Time.Format (defaultTimeLocale, dateTimeFmt)
28−#else
29−import System.Locale (defaultTimeLocale, dateTimeFmt)
30−#endif
27+run :: Parser a -> Text -> Aeson.Parser a
28+run p t = case A.parseOnly (p <* endOfInput) t of
29+ Left err -> fail $ "could not parse date: " ++ err
30+ Right r -> return r
3131
32−day :: A.Parser Day
32+day :: Parser Day
3333day = do
3434 y <- decimal <* char '-'
35− m <- decimal <* char '-'
36− d <- decimal
35+ m <- twoDigits <* char '-'
36+ d <- twoDigits
3737 maybe (fail "invalid date") return (fromGregorianValid y m d)
3838
39−timeOfDay :: A.Parser Local.TimeOfDay
39+c2d :: Char -> Int
40+c2d c = ord c .&. 15
41+
42+twoDigits :: Parser Int
43+twoDigits = do
44+ a <- digit
45+ b <- digit
46+ return $! c2d a * 10 + c2d b
47+
48+timeOfDay :: Parser Local.TimeOfDay
4049timeOfDay = do
41− h <- decimal <* char ':'
42− m <- decimal <* char ':'
43− s <- (fromRational . toRational) <$> double
44− maybe (fail "invalid time") return (Local.makeTimeOfDayValid h m s)
50+ h <- twoDigits <* char ':'
51+ m <- twoDigits <* char ':'
52+ s <- pico
53+ if h < 24 && m < 60 && s < 61
54+ then return (Local.TimeOfDay h m s)
55+ else fail "invalid time"
4556
46−pico :: A.Parser Pico
57+pico :: Parser Pico
4758pico = do
48− (w :: Int) <- decimal
59+ w <- twoDigits
4960 mc <- peekChar
5061 case mc of
5162 Just '.' -> do
52− fs <- A.takeWhile isDigit
53− let e = negate (T.length (T.takeWhile (=='0') fs)) - 1
54− case T.decimal fs of
55− Right (f :: Int, _) -> return (fromIntegral w + fromIntegral f * 10 ^ e)
56− _ -> fail "invalid number"
57− _ -> fail "invalid number"
63+ (t,f :: Int64) <- anyChar *> match decimal
64+ return $! fromIntegral w + fromIntegral f / 10 ^ T.length t
65+ _ -> return $! fromIntegral w
5866
59−timeZone :: A.Parser Local.TimeZone
67+timeZone :: Parser Local.TimeZone
6068timeZone = do
61− skipSpace
69+ let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar)
70+ maybeSkip ' '
6271 ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
6372 if ch == 'Z'
6473 then return Local.utc
6574 else do
66− let dec f s = case f T.decimal s of
67− Right (n, r) | T.null r -> return n
68− _ -> fail "invalid time zone"
69− h <- dec T.signed =<< T.cons ch <$> A.take 2
70− c <- peekChar'
71− when (c == ':') $ void anyChar
72− m <- dec id =<< A.take 2
73− let off = h * 60 + m
75+ h0 <- twoDigits
76+ m <- maybeSkip ':' *> twoDigits
77+ let h | ch == '-' = negate h0
78+ | otherwise = h0
79+ off = h * 60 + m
7480 if off < -720 || off > 840 || m > 59
7581 then fail "invalid time zone offset"
76− else return (Local.minutesToTimeZone off)
82+ else return $! Local.minutesToTimeZone off
83+
84+localTime :: Parser Local.LocalTime
85+localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay
86+ where daySep = satisfy (\c -> c == 'T' || c == ' ')
7787
78−utcTime :: A.Parser UTCTime
88+utcTime :: Parser UTCTime
7989utcTime = do
80− let daySep = satisfy (\c -> c == 'T' || c == ' ')
81− lt <- Local.LocalTime <$> day <* daySep <*> timeOfDay
90+ lt <- localTime
8291 tz <- timeZone
83− return (Local.localTimeToUTC tz lt)
92+ return $! Local.localTimeToUTC tz lt
8493
85−zonedTime :: Text -> Aeson.Parser Local.ZonedTime
86−zonedTime t =
87− tryFormats alternateFormats
88− <|> fail "could not parse ECMA-262 ISO-8601 date"
89− where
90− tryFormat f =
91− case parseTime defaultTimeLocale f (T.unpack t) of
92− Just d -> pure d
93− Nothing -> empty
94− tryFormats = foldr1 (<|>) . map tryFormat
95− alternateFormats =
96− "%FT%T%QZ" : -- (javascript new Date().toISOString())
97− "%F %T%Q%z" : -- (postgres)
98− "%F %T%Q %Z" : -- (time's Show format)
99− "%FT%T%Q%z" :
100− "%Y-%mT%T%Q" :
101− "%Y-%mT%R" :
102− "%Y-%mT%T" :
103− "%Y-%mT%T%QZ" :
104− "%Y-%mT%T%Q%z" :
105− "%YT%T%Q" :
106− "%YT%R" :
107− "%YT%T" :
108− "%YT%T%QZ" :
109− "%YT%T%Q%z" :
110− "%FT%T%Q" :
111− "%FT%R" :
112− "%FT%T" :
113− dateTimeFmt defaultTimeLocale :
114− []
94+zonedTime :: Parser Local.ZonedTime
95+zonedTime = Local.ZonedTime <$> localTime <*> timeZone
Data/Aeson/Types/Instances.hs+5−92
@@ -56,11 +56,9 @@ module Data.Aeson.Types.Instances
5656 ) where
5757
5858import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)
59−import Control.Monad (when)
6059import qualified Data.Aeson.Encode.Builder as E
6160import qualified Data.ByteString.Builder as B
6261import Data.Aeson.Functions
63−import Data.Bits ((.&.))
6462import Data.Monoid ((<>), mempty)
6563import Data.Aeson.Encode.Functions (brackets, builder, foldable, list)
6664import qualified Data.Aeson.Parser.Time as Time
@@ -69,8 +67,6 @@ import Data.Aeson.Types.Internal
6967import Data.Scientific (Scientific)
7068import qualified Data.Scientific as Scientific (coefficient, base10Exponent, fromFloatDigits, toRealFloat)
7169import Data.Attoparsec.Number (Number(..))
72−import qualified Data.Attoparsec.Text as A
73−import Data.Char (isDigit, ord)
7470import Data.Fixed
7571import Data.Foldable (Foldable, toList)
7672import Data.Functor.Identity (Identity(..))
@@ -80,10 +76,8 @@ import Data.Maybe (fromMaybe)
8076import Data.Monoid (Dual(..), First(..), Last(..))
8177import Data.Ratio (Ratio, (%), numerator, denominator)
8278import Data.Text (Text, pack, unpack)
83−import Data.Time (UTCTime(..), ZonedTime(..), TimeZone(..), Day, utc)
84−import Data.Time.Calendar (fromGregorianValid, addDays)
79+import Data.Time (UTCTime(..), ZonedTime(..), TimeZone(..))
8580import Data.Time.Format (FormatTime, formatTime, parseTime)
86−import Data.Time.LocalTime (TimeOfDay, makeTimeOfDayValid, minutesToTimeZone, timeOfDayToTime, localToUTCTimeOfDay)
8781import Data.Traversable as Tr (sequence, traverse)
8882import Data.Vector (Vector)
8983import Data.Word (Word, Word8, Word16, Word32, Word64)
@@ -107,9 +101,9 @@ import qualified Data.Vector.Unboxed as VU
107101import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )
108102
109103#if MIN_VERSION_time(1,5,0)
110−import Data.Time.Format (defaultTimeLocale, dateTimeFmt)
104+import Data.Time.Format (defaultTimeLocale)
111105#else
112−import System.Locale (defaultTimeLocale, dateTimeFmt)
106+import System.Locale (defaultTimeLocale)
113107#endif
114108
115109parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a
@@ -734,9 +728,7 @@ formatSubseconds :: (FormatTime t) => t -> String
734728formatSubseconds = formatTime defaultTimeLocale "%q"
735729
736730instance FromJSON ZonedTime where
737− parseJSON (String t) = Time.zonedTime t
738−
739− parseJSON v = typeMismatch "ZonedTime" v
731+ parseJSON = withText "ZonedTime" (Time.run Time.zonedTime)
740732
741733instance ToJSON UTCTime where
742734 toJSON = toJSON . utcTime
@@ -747,87 +739,8 @@ utcTime :: UTCTime -> String
747739utcTime t = formatTime defaultTimeLocale format t
748740 where format = "%FT%T." ++ formatSubseconds t ++ "Z"
749741
750−getDay :: A.Parser Day
751−getDay = do
752− yearStr <- A.takeWhile isDigit
753− when (T.length yearStr < 4) (fail "year must consist of at least 4 digits")
754−
755− let !year = toNum yearStr
756− _ <- A.char '-'
757− month <- digits "month"
758− _ <- A.char '-'
759− day <- digits "day"
760−
761− case fromGregorianValid year month day of
762− Nothing -> fail "invalid date"
763− Just x -> return $! x
764−
765−toNum :: Num n => T.Text -> n
766−toNum = T.foldl' (\a c -> 10*a + digit c) 0
767−{-# INLINE toNum #-}
768−
769−digit :: Num n => Char -> n
770−digit c = fromIntegral (ord c .&. 0x0f)
771−{-# INLINE digit #-}
772−
773−digits :: Num n => String -> A.Parser n
774−digits msg = do
775− x <- A.anyChar
776− y <- A.anyChar
777− if isDigit x && isDigit y
778− then return $! (10 * digit x + digit y)
779− else fail (msg ++ " is not 2 digits")
780−{-# INLINE digits #-}
781−
782−decimal :: Fractional a => T.Text -> a
783−decimal str = toNum str / 10^(T.length str)
784−{-# INLINE decimal #-}
785−
786−getTimeOfDay :: A.Parser TimeOfDay
787−getTimeOfDay = do
788− hour <- digits "hours"
789− _ <- A.char ':'
790− minute <- digits "minutes"
791− -- Allow omission of seconds. If seconds is omitted, don't try to
792− -- parse the sub-second part.
793− (sec,subsec)
794− <- ((,) <$> (A.char ':' *> digits "seconds") <*> fract) <|> pure (0,0)
795−
796− let !picos' = sec + subsec
797−
798− case makeTimeOfDayValid hour minute picos' of
799− Nothing -> fail "invalid time of day"
800− Just x -> return $! x
801−
802− where
803− fract =
804− (A.char '.' *> (decimal <$> A.takeWhile1 isDigit)) <|> pure 0
805−
806−getTimeZone :: A.Parser TimeZone
807−getTimeZone = do
808− sign <- A.satisfy (\c -> c == '+' || c == '-')
809− hours <- digits "timezone"
810− mins <- (A.char ':' *> digits "timezone minutes") <|> pure 0
811− let !absset = 60 * hours + mins
812− !offset = if sign == '+' then absset else -absset
813− return $! minutesToTimeZone offset
814−
815−getUTCTime :: A.Parser UTCTime
816−getUTCTime = do
817− day <- getDay
818− _ <- A.char ' ' <|> A.char 'T'
819− time <- getTimeOfDay
820− zone <- getTimeZone <|> (A.char 'Z' *> pure utc)
821− let (!dayDelta,!time') = localToUTCTimeOfDay zone time
822− let !day' = addDays dayDelta day
823− let !time'' = timeOfDayToTime time'
824− return (UTCTime day' time'')
825−
826742instance FromJSON UTCTime where
827− parseJSON = withText "UTCTime" $ \t ->
828− case A.parseOnly (getUTCTime <* A.endOfInput) t of
829− Right d -> pure d
830− Left msg -> fail ("could not parse ISO-8601 date: " ++ msg)
743+ parseJSON = withText "UTCTime" (Time.run Time.utcTime)
831744
832745parseJSONElemAtIndex :: FromJSON a => Int -> Vector Value -> Parser a
833746parseJSONElemAtIndex idx ary = parseJSON (V.unsafeIndex ary idx) <?> Index idx