Skip to content

Commit 5b32124

Browse files
bergmarkbergmark
authored
Merge pull request #530 from bos/iso8601
Create iso8601-attoparsec package
2 parents 22064e4 + 20cb732 commit 5b32124

File tree

13 files changed

+351
-150
lines changed

13 files changed

+351
-150
lines changed

‎Data/Aeson/Internal/Time.hs

Lines changed: 1 addition & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -17,45 +17,4 @@ module Data.Aeson.Internal.Time
1717
, toTimeOfDay64
1818
) where
1919

20-
import Prelude ()
21-
import Prelude.Compat
22-
23-
import Data.Int (Int64)
24-
import Data.Time
25-
import Unsafe.Coerce (unsafeCoerce)
26-
27-
#if MIN_VERSION_base(4,7,0)
28-
29-
import Data.Fixed (Pico, Fixed(MkFixed))
30-
31-
toPico :: Integer -> Pico
32-
toPico = MkFixed
33-
34-
fromPico :: Pico -> Integer
35-
fromPico (MkFixed i) = i
36-
37-
#else
38-
39-
import Data.Fixed (Pico)
40-
41-
toPico :: Integer -> Pico
42-
toPico = unsafeCoerce
43-
44-
fromPico :: Pico -> Integer
45-
fromPico = unsafeCoerce
46-
47-
#endif
48-
49-
-- | Like TimeOfDay, but using a fixed-width integer for seconds.
50-
data TimeOfDay64 = TOD {-# UNPACK #-} !Int
51-
{-# UNPACK #-} !Int
52-
{-# UNPACK #-} !Int64
53-
54-
diffTimeOfDay64 :: DiffTime -> TimeOfDay64
55-
diffTimeOfDay64 t = TOD (fromIntegral h) (fromIntegral m) s
56-
where (h,mp) = fromIntegral pico `quotRem` 3600000000000000
57-
(m,s) = mp `quotRem` 60000000000000
58-
pico = unsafeCoerce t :: Integer
59-
60-
toTimeOfDay64 :: TimeOfDay -> TimeOfDay64
61-
toTimeOfDay64 (TimeOfDay h m s) = TOD h m (fromIntegral (fromPico s))
20+
import Data.Attoparsec.Time.Internal

‎Data/Aeson/Parser/Time.hs

Lines changed: 17 additions & 103 deletions
Original file line numberDiff line numberDiff line change
@@ -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 <[email protected]>
9-
-- Stability: experimental
10-
-- Portability: portable
11-
--
12-
-- Parsers for parsing dates and times.
13-
141
module Data.Aeson.Parser.Time
152
(
163
run
@@ -25,120 +12,49 @@ module Data.Aeson.Parser.Time
2512
import Prelude ()
2613
import 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)
3716
import Data.Text (Text)
38-
import Data.Time.Calendar (Day, fromGregorianValid)
17+
import Data.Time.Calendar (Day)
3918
import Data.Time.Clock (UTCTime(..))
4019
import 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
4222
import qualified Data.Time.LocalTime as Local
4323

4424
-- | Run an attoparsec parser as an aeson parser.
4525
run :: 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@.
5131
day :: 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]]@.
6836
timeOfDay :: 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.)
9942
timeZone :: 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.
12849
localTime :: 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.
13455
utcTime :: 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.
15470
zonedTime :: 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 #-}

‎aeson.cabal

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -80,7 +80,7 @@ flag cffi
8080

8181
library
8282
default-language: Haskell2010
83-
hs-source-dirs: .
83+
hs-source-dirs: . attoparsec-iso8601/
8484

8585
exposed-modules:
8686
Data.Aeson
@@ -109,6 +109,8 @@ library
109109
Data.Aeson.Types.ToJSON
110110
Data.Aeson.Types.Class
111111
Data.Aeson.Types.Internal
112+
Data.Attoparsec.Time
113+
Data.Attoparsec.Time.Internal
112114

113115
build-depends:
114116
attoparsec >= 0.13.0.1,

‎attoparsec-iso8601/Data/Attoparsec/Time.hs

Lines changed: 149 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,149 @@
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 <[email protected]>
9+
-- Stability: experimental
10+
-- Portability: portable
11+
--
12+
-- Parsers for parsing dates and times.
13+
14+
module Data.Attoparsec.Time
15+
(
16+
day
17+
, localTime
18+
, timeOfDay
19+
, timeZone
20+
, utcTime
21+
, zonedTime
22+
) where
23+
24+
import Prelude ()
25+
import Prelude.Compat
26+
27+
import Control.Applicative ((<|>))
28+
import Control.Monad (void, when)
29+
import Data.Attoparsec.Text as A
30+
import Data.Attoparsec.Time.Internal (toPico)
31+
import Data.Bits ((.&.))
32+
import Data.Char (isDigit, ord)
33+
import Data.Fixed (Pico)
34+
import Data.Int (Int64)
35+
import Data.Maybe (fromMaybe)
36+
import Data.Time.Calendar (Day, fromGregorianValid)
37+
import Data.Time.Clock (UTCTime(..))
38+
import qualified Data.Text as T
39+
import qualified Data.Time.LocalTime as Local
40+
41+
-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
42+
day :: Parser Day
43+
day = do
44+
absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id
45+
y <- decimal <* char '-'
46+
m <- twoDigits <* char '-'
47+
d <- twoDigits
48+
maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d)
49+
50+
-- | Parse a two-digit integer (e.g. day of month, hour).
51+
twoDigits :: Parser Int
52+
twoDigits = do
53+
a <- digit
54+
b <- digit
55+
let c2d c = ord c .&. 15
56+
return $! c2d a * 10 + c2d b
57+
58+
-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
59+
timeOfDay :: Parser Local.TimeOfDay
60+
timeOfDay = do
61+
h <- twoDigits
62+
m <- char ':' *> twoDigits
63+
s <- option 0 (char ':' *> seconds)
64+
if h < 24 && m < 60 && s < 61
65+
then return (Local.TimeOfDay h m s)
66+
else fail "invalid time"
67+
68+
data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64
69+
70+
-- | Parse a count of seconds, with the integer part being two digits
71+
-- long.
72+
seconds :: Parser Pico
73+
seconds = do
74+
real <- twoDigits
75+
mc <- peekChar
76+
case mc of
77+
Just '.' -> do
78+
t <- anyChar *> takeWhile1 isDigit
79+
return $! parsePicos real t
80+
_ -> return $! fromIntegral real
81+
where
82+
parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
83+
where T n t' = T.foldl' step (T 12 (fromIntegral a0)) t
84+
step ma@(T m a) c
85+
| m <= 0 = ma
86+
| otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15)
87+
88+
-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
89+
-- zero. (This makes some speedups possible.)
90+
timeZone :: Parser (Maybe Local.TimeZone)
91+
timeZone = do
92+
let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar)
93+
maybeSkip ' '
94+
ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
95+
if ch == 'Z'
96+
then return Nothing
97+
else do
98+
h <- twoDigits
99+
mm <- peekChar
100+
m <- case mm of
101+
Just ':' -> anyChar *> twoDigits
102+
Just d | isDigit d -> twoDigits
103+
_ -> return 0
104+
let off | ch == '-' = negate off0
105+
| otherwise = off0
106+
off0 = h * 60 + m
107+
case undefined of
108+
_ | off == 0 ->
109+
return Nothing
110+
| off < -720 || off > 840 || m > 59 ->
111+
fail "invalid time zone offset"
112+
| otherwise ->
113+
let !tz = Local.minutesToTimeZone off
114+
in return (Just tz)
115+
116+
-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
117+
-- The space may be replaced with a @T@. The number of seconds is optional
118+
-- and may be followed by a fractional component.
119+
localTime :: Parser Local.LocalTime
120+
localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay
121+
where daySep = satisfy (\c -> c == 'T' || c == ' ')
122+
123+
-- | Behaves as 'zonedTime', but converts any time zone offset into a
124+
-- UTC time.
125+
utcTime :: Parser UTCTime
126+
utcTime = do
127+
lt@(Local.LocalTime d t) <- localTime
128+
mtz <- timeZone
129+
case mtz of
130+
Nothing -> let !tt = Local.timeOfDayToTime t
131+
in return (UTCTime d tt)
132+
Just tz -> return $! Local.localTimeToUTC tz lt
133+
134+
-- | Parse a date with time zone info. Acceptable formats:
135+
--
136+
-- @YYYY-MM-DD HH:MM Z@
137+
-- @YYYY-MM-DD HH:MM:SS Z@
138+
-- @YYYY-MM-DD HH:MM:SS.SSS Z@
139+
--
140+
-- The first space may instead be a @T@, and the second space is
141+
-- optional. The @Z@ represents UTC. The @Z@ may be replaced with a
142+
-- time zone offset of the form @+0000@ or @-08:00@, where the first
143+
-- two digits are hours, the @:@ is optional and the second two digits
144+
-- (also optional) are minutes.
145+
zonedTime :: Parser Local.ZonedTime
146+
zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
147+
148+
utc :: Local.TimeZone
149+
utc = Local.TimeZone 0 False ""

0 commit comments

Comments
 (0)