@@ -1,16 +1,3 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3−
4−-- |
5−-- Module: Data.Aeson.Parser.Time
6−-- Copyright: (c) 2015-2016 Bryan O'Sullivan
7−-- License: BSD3
8−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
9−-- Stability: experimental
10−-- Portability: portable
11−--
12−-- Parsers for parsing dates and times.
13−
141module Data.Aeson.Parser.Time
152 (
163 run
@@ -25,120 +12,49 @@ module Data.Aeson.Parser.Time
2512import Prelude ()
2613import Prelude.Compat
2714
28−import Control.Applicative ((<|>))
29−import Control.Monad (void, when)
30−import Data.Aeson.Internal.Time (toPico)
31−import Data.Attoparsec.Text as A
32−import Data.Bits ((.&.))
33−import Data.Char (isDigit, ord)
34−import Data.Fixed (Pico)
35−import Data.Int (Int64)
36−import Data.Maybe (fromMaybe)
15+import Data.Attoparsec.Text (Parser)
3716import Data.Text (Text)
38−import Data.Time.Calendar (Day, fromGregorianValid)
17+import Data.Time.Calendar (Day)
3918import Data.Time.Clock (UTCTime(..))
4019import qualified Data.Aeson.Types.Internal as Aeson
41−import qualified Data.Text as T
20+import qualified Data.Attoparsec.Text as A
21+import qualified Data.Attoparsec.Time as T
4222import qualified Data.Time.LocalTime as Local
4323
4424-- | Run an attoparsec parser as an aeson parser.
4525run :: Parser a -> Text -> Aeson.Parser a
46−run p t = case A.parseOnly (p <* endOfInput) t of
26+run p t = case A.parseOnly (p <* A.endOfInput) t of
4727 Left err -> fail $ "could not parse date: " ++ err
4828 Right r -> return r
4929
5030-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
5131day :: Parser Day
52−day = do
53− absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id
54− y <- decimal <* char '-'
55− m <- twoDigits <* char '-'
56− d <- twoDigits
57− maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d)
58−
59−-- | Parse a two-digit integer (e.g. day of month, hour).
60−twoDigits :: Parser Int
61−twoDigits = do
62− a <- digit
63− b <- digit
64− let c2d c = ord c .&. 15
65− return $! c2d a * 10 + c2d b
32+day = T.day
33+{-# INLINE day #-}
6634
6735-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
6836timeOfDay :: Parser Local.TimeOfDay
69−timeOfDay = do
70− h <- twoDigits
71− m <- char ':' *> twoDigits
72− s <- option 0 (char ':' *> seconds)
73− if h < 24 && m < 60 && s < 61
74− then return (Local.TimeOfDay h m s)
75− else fail "invalid time"
76−
77−data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64
78−
79−-- | Parse a count of seconds, with the integer part being two digits
80−-- long.
81−seconds :: Parser Pico
82−seconds = do
83− real <- twoDigits
84− mc <- peekChar
85− case mc of
86− Just '.' -> do
87− t <- anyChar *> takeWhile1 isDigit
88− return $! parsePicos real t
89− _ -> return $! fromIntegral real
90− where
91− parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
92− where T n t' = T.foldl' step (T 12 (fromIntegral a0)) t
93− step ma@(T m a) c
94− | m <= 0 = ma
95− | otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15)
37+timeOfDay = T.timeOfDay
38+{-# INLINE timeOfDay #-}
9639
9740-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
9841-- zero. (This makes some speedups possible.)
9942timeZone :: Parser (Maybe Local.TimeZone)
100−timeZone = do
101− let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar)
102− maybeSkip ' '
103− ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
104− if ch == 'Z'
105− then return Nothing
106− else do
107− h <- twoDigits
108− mm <- peekChar
109− m <- case mm of
110− Just ':' -> anyChar *> twoDigits
111− Just d | isDigit d -> twoDigits
112− _ -> return 0
113− let off | ch == '-' = negate off0
114− | otherwise = off0
115− off0 = h * 60 + m
116− case undefined of
117− _ | off == 0 ->
118− return Nothing
119− | off < -720 || off > 840 || m > 59 ->
120− fail "invalid time zone offset"
121− | otherwise ->
122− let !tz = Local.minutesToTimeZone off
123− in return (Just tz)
43+timeZone = T.timeZone
44+{-# INLINE timeZone #-}
12445
12546-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
12647-- The space may be replaced with a @T@. The number of seconds is optional
12748-- and may be followed by a fractional component.
12849localTime :: Parser Local.LocalTime
129−localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay
130− where daySep = satisfy (\c -> c == 'T' || c == ' ')
50+localTime = T.localTime
51+{-# INLINE localTime #-}
13152
13253-- | Behaves as 'zonedTime', but converts any time zone offset into a
13354-- UTC time.
13455utcTime :: Parser UTCTime
135−utcTime = do
136− lt@(Local.LocalTime d t) <- localTime
137− mtz <- timeZone
138− case mtz of
139− Nothing -> let !tt = Local.timeOfDayToTime t
140− in return (UTCTime d tt)
141− Just tz -> return $! Local.localTimeToUTC tz lt
56+utcTime = T.utcTime
57+{-# INLINE utcTime #-}
14258
14359-- | Parse a date with time zone info. Acceptable formats:
14460--
@@ -152,7 +68,5 @@ utcTime = do
15268-- two digits are hours, the @:@ is optional and the second two digits
15369-- (also optional) are minutes.
15470zonedTime :: Parser Local.ZonedTime
155−zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
156−
157−utc :: Local.TimeZone
158−utc = Local.TimeZone 0 False ""
71+zonedTime = T.zonedTime
72+{-# INLINE zonedTime #-}