attoparsec-iso8601-1.1.1.0/0000755000000000000000000000000007346545000013315 5ustar0000000000000000attoparsec-iso8601-1.1.1.0/LICENSE0000644000000000000000000000266707346545000014335 0ustar0000000000000000Copyright (c) 2011, MailRank, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. attoparsec-iso8601-1.1.1.0/README.md0000644000000000000000000000122007346545000014567 0ustar0000000000000000Parsing of ISO 8601 dates. This package is used to parse dates in aeson. It is split into a separate package to be shared by other projects that want to parse dates like aeson does. For now, this project is located in the aeson repository and aeson itself uses the source of this package without pulling in the package as a dependency. ## Stability Since aeson depends on this package we want to be very careful about changing the format. There may be breaking changes if we find that the format is incorrectly too lenient. We consider widening of the allowed input a non-breaking addition since all previously valid input will still parse correctly. attoparsec-iso8601-1.1.1.0/attoparsec-iso8601.cabal0000644000000000000000000000265507346545000017565 0ustar0000000000000000name: attoparsec-iso8601 version: 1.1.1.0 synopsis: Parsing of ISO 8601 dates, originally from aeson description: Parsing of ISO 8601 dates, originally from aeson. license: BSD3 license-file: LICENSE category: Parsing copyright: (c) 2011-2016 Bryan O'Sullivan (c) 2011 MailRank, Inc. author: Bryan O'Sullivan maintainer: Adam Bergmark stability: experimental cabal-version: 1.12 homepage: https://github.com/haskell/aeson bug-reports: https://github.com/haskell/aeson/issues build-type: Simple tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1 extra-source-files: changelog.md README.md library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall exposed-modules: Data.Attoparsec.Time Data.Attoparsec.Time.Internal build-depends: attoparsec >=0.14.2 && <0.15 , base >=4.12.0.0 && <5 , integer-conversion >=0.1 && <0.2 , text >=1.2.3.0 && <1.3.0.0 || >=2.0 && <2.2 , time >=1.8.0.2 && <1.13 , time-compat >=1.9.4 && <1.10 source-repository head type: git location: git://github.com/haskell/aeson.git subdir: attoparsec-iso8601 attoparsec-iso8601-1.1.1.0/changelog.md0000644000000000000000000000117007346545000015565 0ustar0000000000000000For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/attoparsec-iso8601/changelog.md](https://github.com/bos/aeson/blob/master/attoparsec-iso8601/changelog.md). ### 1.1.1.0 - Support GHC-8.6.5...9.10.1 ### 1.1.0.0 - Change parsers of types with year (`Day`, `UTCTime`) to require years with at least 4 digits. - Remove `fast` and `developer` package flags ### 1.0.2.1 * Code (re)organization. * Avoid wildcard imports ### 1.0.2.0 * Add `month :: Parser Month` and `quarter :: Parser Quarter` ### 1.0.1.0 * Fixes handling of `UTCTime` wrt. leap seconds , thanks to Adam Schønemann attoparsec-iso8601-1.1.1.0/src/Data/Attoparsec/0000755000000000000000000000000007346545000017062 5ustar0000000000000000attoparsec-iso8601-1.1.1.0/src/Data/Attoparsec/Time.hs0000644000000000000000000001445607346545000020326 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module: Data.Aeson.Parser.Time -- Copyright: (c) 2015-2016 Bryan O'Sullivan -- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable -- -- Parsers for parsing dates and times. module Data.Attoparsec.Time ( day , localTime , timeOfDay , timeZone , utcTime , zonedTime , year , month , quarter ) where import Control.Applicative ((<|>)) import Data.Attoparsec.Text (Parser, char, digit, option, anyChar, peekChar, takeWhile1, satisfy) import Data.Bits ((.&.)) import Data.Char (isDigit, ord) import Data.Fixed (Pico, Fixed (..)) import Data.Int (Int64) import Data.Integer.Conversion (textToInteger) import Data.Maybe (fromMaybe) import Data.Time.Calendar (Day, fromGregorianValid) import Data.Time.Calendar.Compat (Year) import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..), fromYearQuarter) import Data.Time.Calendar.Month.Compat (Month, fromYearMonthValid) 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@. -- -- The year must contain at least 4 digits, to avoid the Y2K problem: -- a two-digit year @YY@ may mean @YY@, @19YY@, or @20YY@, and we make it -- an error to prevent the ambiguity. -- Years from @0000@ to @0999@ must thus be zero-padded. -- The year may have more than 4 digits. day :: Parser Day day = do absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id y <- (year <* char '-') <|> fail "date must be of form [+,-]YYYY-MM-DD" m <- (twoDigits <* char '-') <|> fail "date must be of form [+,-]YYYY-MM-DD" d <- twoDigits <|> fail "date must be of form [+,-]YYYY-MM-DD" maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d) -- | Parse a month of the form @[+,-]YYYY-MM@. -- -- See also 'day' for details about the year format. month :: Parser Month month = do absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id y <- (year <* char '-') <|> fail "month must be of form [+,-]YYYY-MM" m <- twoDigits <|> fail "month must be of form [+,-]YYYY-MM" maybe (fail "invalid month") return (fromYearMonthValid (absOrNeg y) m) -- | Parse a quarter of the form @[+,-]YYYY-QN@. -- -- See also 'day' for details about the year format. quarter :: Parser Quarter quarter = do absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id y <- (year <* char '-') <|> fail "month must be of form [+,-]YYYY-MM" _ <- char 'q' <|> char 'Q' q <- parseQ return $! fromYearQuarter (absOrNeg y) q where parseQ = Q1 <$ char '1' <|> Q2 <$ char '2' <|> Q3 <$ char '3' <|> Q4 <$ char '4' -- | Parse a year @YYYY@, with at least 4 digits. Does not include any sign. -- -- Note: 'Year' is a type synonym for 'Integer'. -- -- @since 1.1.0.0 year :: Parser Year year = do ds <- takeWhile1 isDigit if T.length ds < 4 then fail "expected year with at least 4 digits" else pure (textToInteger ds) -- | 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 = MkFixed (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.) -- -- The accepted formats are @Z@, @+HH@, @+HHMM@, or @+HH:MM@. -- timeZone :: Parser (Maybe Local.TimeZone) timeZone = do 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 "" attoparsec-iso8601-1.1.1.0/src/Data/Attoparsec/Time/0000755000000000000000000000000007346545000017760 5ustar0000000000000000attoparsec-iso8601-1.1.1.0/src/Data/Attoparsec/Time/Internal.hs0000644000000000000000000000262607346545000022076 0ustar0000000000000000-- | -- Module: Data.Aeson.Internal.Time -- Copyright: (c) 2015-2016 Bryan O'Sullivan -- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable module Data.Attoparsec.Time.Internal ( TimeOfDay64(..) , fromPico , toPico , diffTimeOfDay64 , toTimeOfDay64 ) where import Data.Fixed (Fixed(MkFixed), Pico) import Data.Int (Int64) import Data.Time (TimeOfDay(..)) import Data.Time.Clock.Compat (DiffTime, diffTimeToPicoseconds) toPico :: Integer -> Pico toPico = MkFixed {-# DEPRECATED toPico "Use MkFixed" #-} fromPico :: Pico -> Integer fromPico (MkFixed i) = i {-# DEPRECATED fromPico "Use MkFixed" #-} -- | Like TimeOfDay, but using a fixed-width integer for seconds. data TimeOfDay64 = TOD {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int64 posixDayLength :: DiffTime posixDayLength = 86400 diffTimeOfDay64 :: DiffTime -> TimeOfDay64 diffTimeOfDay64 t | t >= posixDayLength = TOD 23 59 (60000000000000 + pico (t - posixDayLength)) | otherwise = TOD (fromIntegral h) (fromIntegral m) s where (h,mp) = pico t `quotRem` 3600000000000000 (m,s) = mp `quotRem` 60000000000000 pico = fromIntegral . diffTimeToPicoseconds toTimeOfDay64 :: TimeOfDay -> TimeOfDay64 toTimeOfDay64 (TimeOfDay h m (MkFixed s)) = TOD h m (fromIntegral s)