Skip to content

Commit

Permalink
Merge pull request #530 from bos/iso8601
Browse files Browse the repository at this point in the history
Create iso8601-attoparsec package
  • Loading branch information
bergmark committed Apr 7, 2017
2 parents 22064e4 + 20cb732 commit 5b32124
Show file tree
Hide file tree
Showing 13 changed files with 351 additions and 150 deletions.
43 changes: 1 addition & 42 deletions Data/Aeson/Internal/Time.hs
Expand Up @@ -17,45 +17,4 @@ module Data.Aeson.Internal.Time
, toTimeOfDay64
) where

import Prelude ()
import Prelude.Compat

import Data.Int (Int64)
import Data.Time
import Unsafe.Coerce (unsafeCoerce)

#if MIN_VERSION_base(4,7,0)

import Data.Fixed (Pico, Fixed(MkFixed))

toPico :: Integer -> Pico
toPico = MkFixed

fromPico :: Pico -> Integer
fromPico (MkFixed i) = i

#else

import Data.Fixed (Pico)

toPico :: Integer -> Pico
toPico = unsafeCoerce

fromPico :: Pico -> Integer
fromPico = unsafeCoerce

#endif

-- | Like TimeOfDay, but using a fixed-width integer for seconds.
data TimeOfDay64 = TOD {-# UNPACK #-} !Int
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int64

diffTimeOfDay64 :: DiffTime -> TimeOfDay64
diffTimeOfDay64 t = TOD (fromIntegral h) (fromIntegral m) s
where (h,mp) = fromIntegral pico `quotRem` 3600000000000000
(m,s) = mp `quotRem` 60000000000000
pico = unsafeCoerce t :: Integer

toTimeOfDay64 :: TimeOfDay -> TimeOfDay64
toTimeOfDay64 (TimeOfDay h m s) = TOD h m (fromIntegral (fromPico s))
import Data.Attoparsec.Time.Internal
120 changes: 17 additions & 103 deletions Data/Aeson/Parser/Time.hs
@@ -1,16 +1,3 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module: Data.Aeson.Parser.Time
-- Copyright: (c) 2015-2016 Bryan O'Sullivan
-- License: BSD3
-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
-- Stability: experimental
-- Portability: portable
--
-- Parsers for parsing dates and times.

module Data.Aeson.Parser.Time
(
run
Expand All @@ -25,120 +12,49 @@ module Data.Aeson.Parser.Time
import Prelude ()
import Prelude.Compat

import Control.Applicative ((<|>))
import Control.Monad (void, when)
import Data.Aeson.Internal.Time (toPico)
import Data.Attoparsec.Text as A
import Data.Bits ((.&.))
import Data.Char (isDigit, ord)
import Data.Fixed (Pico)
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Attoparsec.Text (Parser)
import Data.Text (Text)
import Data.Time.Calendar (Day, fromGregorianValid)
import Data.Time.Calendar (Day)
import Data.Time.Clock (UTCTime(..))
import qualified Data.Aeson.Types.Internal as Aeson
import qualified Data.Text as T
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 <* endOfInput) t of
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 = do
absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id
y <- decimal <* char '-'
m <- twoDigits <* char '-'
d <- twoDigits
maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d)

-- | Parse a two-digit integer (e.g. day of month, hour).
twoDigits :: Parser Int
twoDigits = do
a <- digit
b <- digit
let c2d c = ord c .&. 15
return $! c2d a * 10 + c2d b
day = T.day
{-# INLINE day #-}

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
timeOfDay :: Parser Local.TimeOfDay
timeOfDay = do
h <- twoDigits
m <- char ':' *> twoDigits
s <- option 0 (char ':' *> seconds)
if h < 24 && m < 60 && s < 61
then return (Local.TimeOfDay h m s)
else fail "invalid time"

data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64

-- | Parse a count of seconds, with the integer part being two digits
-- long.
seconds :: Parser Pico
seconds = do
real <- twoDigits
mc <- peekChar
case mc of
Just '.' -> do
t <- anyChar *> takeWhile1 isDigit
return $! parsePicos real t
_ -> return $! fromIntegral real
where
parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
where T n t' = T.foldl' step (T 12 (fromIntegral a0)) t
step ma@(T m a) c
| m <= 0 = ma
| otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15)
timeOfDay = T.timeOfDay
{-# INLINE timeOfDay #-}

-- | 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 = do
let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar)
maybeSkip ' '
ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
if ch == 'Z'
then return Nothing
else do
h <- twoDigits
mm <- peekChar
m <- case mm of
Just ':' -> anyChar *> twoDigits
Just d | isDigit d -> twoDigits
_ -> return 0
let off | ch == '-' = negate off0
| otherwise = off0
off0 = h * 60 + m
case undefined of
_ | off == 0 ->
return Nothing
| off < -720 || off > 840 || m > 59 ->
fail "invalid time zone offset"
| otherwise ->
let !tz = Local.minutesToTimeZone off
in return (Just tz)
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 = Local.LocalTime <$> day <* daySep <*> timeOfDay
where daySep = satisfy (\c -> c == 'T' || c == ' ')
localTime = T.localTime
{-# INLINE localTime #-}

-- | Behaves as 'zonedTime', but converts any time zone offset into a
-- UTC time.
utcTime :: Parser UTCTime
utcTime = do
lt@(Local.LocalTime d t) <- localTime
mtz <- timeZone
case mtz of
Nothing -> let !tt = Local.timeOfDayToTime t
in return (UTCTime d tt)
Just tz -> return $! Local.localTimeToUTC tz lt
utcTime = T.utcTime
{-# INLINE utcTime #-}

-- | Parse a date with time zone info. Acceptable formats:
--
Expand All @@ -152,7 +68,5 @@ utcTime = do
-- two digits are hours, the @:@ is optional and the second two digits
-- (also optional) are minutes.
zonedTime :: Parser Local.ZonedTime
zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)

utc :: Local.TimeZone
utc = Local.TimeZone 0 False ""
zonedTime = T.zonedTime
{-# INLINE zonedTime #-}
4 changes: 3 additions & 1 deletion aeson.cabal
Expand Up @@ -80,7 +80,7 @@ flag cffi

library
default-language: Haskell2010
hs-source-dirs: .
hs-source-dirs: . attoparsec-iso8601/

exposed-modules:
Data.Aeson
Expand Down Expand Up @@ -109,6 +109,8 @@ library
Data.Aeson.Types.ToJSON
Data.Aeson.Types.Class
Data.Aeson.Types.Internal
Data.Attoparsec.Time
Data.Attoparsec.Time.Internal

build-depends:
attoparsec >= 0.13.0.1,
Expand Down
149 changes: 149 additions & 0 deletions attoparsec-iso8601/Data/Attoparsec/Time.hs
@@ -0,0 +1,149 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module: Data.Aeson.Parser.Time
-- Copyright: (c) 2015-2016 Bryan O'Sullivan
-- License: BSD3
-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
-- Stability: experimental
-- Portability: portable
--
-- Parsers for parsing dates and times.

module Data.Attoparsec.Time
(
day
, localTime
, timeOfDay
, timeZone
, utcTime
, zonedTime
) where

import Prelude ()
import Prelude.Compat

import Control.Applicative ((<|>))
import Control.Monad (void, when)
import Data.Attoparsec.Text as A
import Data.Attoparsec.Time.Internal (toPico)
import Data.Bits ((.&.))
import Data.Char (isDigit, ord)
import Data.Fixed (Pico)
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (Day, fromGregorianValid)
import Data.Time.Clock (UTCTime(..))
import qualified Data.Text as T
import qualified Data.Time.LocalTime as Local

-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
day :: Parser Day
day = do
absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id
y <- decimal <* char '-'
m <- twoDigits <* char '-'
d <- twoDigits
maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d)

-- | Parse a two-digit integer (e.g. day of month, hour).
twoDigits :: Parser Int
twoDigits = do
a <- digit
b <- digit
let c2d c = ord c .&. 15
return $! c2d a * 10 + c2d b

-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
timeOfDay :: Parser Local.TimeOfDay
timeOfDay = do
h <- twoDigits
m <- char ':' *> twoDigits
s <- option 0 (char ':' *> seconds)
if h < 24 && m < 60 && s < 61
then return (Local.TimeOfDay h m s)
else fail "invalid time"

data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64

-- | Parse a count of seconds, with the integer part being two digits
-- long.
seconds :: Parser Pico
seconds = do
real <- twoDigits
mc <- peekChar
case mc of
Just '.' -> do
t <- anyChar *> takeWhile1 isDigit
return $! parsePicos real t
_ -> return $! fromIntegral real
where
parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
where T n t' = T.foldl' step (T 12 (fromIntegral a0)) t
step ma@(T m a) c
| m <= 0 = ma
| otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15)

-- | 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 = do
let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar)
maybeSkip ' '
ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
if ch == 'Z'
then return Nothing
else do
h <- twoDigits
mm <- peekChar
m <- case mm of
Just ':' -> anyChar *> twoDigits
Just d | isDigit d -> twoDigits
_ -> return 0
let off | ch == '-' = negate off0
| otherwise = off0
off0 = h * 60 + m
case undefined of
_ | off == 0 ->
return Nothing
| off < -720 || off > 840 || m > 59 ->
fail "invalid time zone offset"
| otherwise ->
let !tz = Local.minutesToTimeZone off
in return (Just tz)

-- | 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 = Local.LocalTime <$> day <* daySep <*> timeOfDay
where daySep = satisfy (\c -> c == 'T' || c == ' ')

-- | Behaves as 'zonedTime', but converts any time zone offset into a
-- UTC time.
utcTime :: Parser UTCTime
utcTime = do
lt@(Local.LocalTime d t) <- localTime
mtz <- timeZone
case mtz of
Nothing -> let !tt = Local.timeOfDayToTime t
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@
-- @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 = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)

utc :: Local.TimeZone
utc = Local.TimeZone 0 False ""

0 comments on commit 5b32124

Please sign in to comment.