text-iso8601-0.1.1/0000755000000000000000000000000007346545000011775 5ustar0000000000000000text-iso8601-0.1.1/LICENSE0000644000000000000000000000266407346545000013012 0ustar0000000000000000Copyright (c) 2023 Oleg Grenrus 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. text-iso8601-0.1.1/bench/0000755000000000000000000000000007346545000013054 5ustar0000000000000000text-iso8601-0.1.1/bench/text-iso8601-bench.hs0000644000000000000000000000107007346545000016556 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main (main) where import Data.Text (Text) import Test.Tasty.Bench (defaultMain, bench, nf) import qualified Data.Attoparsec.Text as A import qualified Data.Attoparsec.Time as A import Data.Time.FromText (parseUTCTime) main :: IO () main = defaultMain [ bench "text" $ nf parseUTCTime input1 , bench "atto" $ nf (runAtto A.utcTime) input1 ] input1 :: Text input1 = "2023-06-09T16:53:55Z" {-# NOINLINE input1 #-} runAtto :: A.Parser a -> Text -> Either String a runAtto p t = A.parseOnly (p <* A.endOfInput) t text-iso8601-0.1.1/changelog.md0000644000000000000000000000007607346545000014251 0ustar0000000000000000# 0.1.1 - Support GHC-8.6.5...9.10.1 # 0.1 Initial release text-iso8601-0.1.1/src/Data/Time/0000755000000000000000000000000007346545000014333 5ustar0000000000000000text-iso8601-0.1.1/src/Data/Time/FromText.hs0000644000000000000000000004676307346545000016457 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} -- {-# OPTIONS_GHC -ddump-simpl -dsuppress-all -ddump-to-file #-} -- | -- -- The [RFC3339 grammar](https://datatracker.ietf.org/doc/html/rfc3339#section-5.6) is below -- -- @ -- date-fullyear = 4DIGIT -- date-month = 2DIGIT ; 01-12 -- date-mday = 2DIGIT ; 01-28, 01-29, 01-30, 01-31 based on month/year -- time-hour = 2DIGIT ; 00-23 -- time-minute = 2DIGIT ; 00-59 -- time-second = 2DIGIT ; 00-58, 00-59, 00-60 based on leap second rules -- time-secfrac = "." 1*DIGIT -- time-numoffset = ("+" / "-") time-hour ":" time-minute -- time-offset = \"Z" / time-numoffset -- -- partial-time = time-hour ":" time-minute ":" time-second [time-secfrac] -- full-date = date-fullyear "-" date-month "-" date-mday -- full-time = partial-time time-offset -- -- date-time = full-date \"T" full-time -- @ -- -- The parsers are a bit more lenient: -- -- * We also accept space instead of @T@ date-time separator. (Allowed by RFC3339, forbidden by ISO8601) -- -- * Seconds are optional (allowed by ISO8601) -- -- * numerical timezone offset can be just @("+" / "-") time-hour@ or without a colon: @("+" / "-") time-hour time-minute@ (allowed by ISO8601). -- However we require colons in between hours, minutes and seconds in the time (@partial-time@) production, and dashes in @full-date@ production. -- -- * We allow over 4 digits in the year part (and that is a reason to require dashes). -- -- * We allow @-00:00@ time offset. (Allowed by RFC3339, forbidden by ISO8601) -- -- * We always allow time with 60 seconds, we don't consult any leap second database. -- module Data.Time.FromText ( parseDay, parseLocalTime, parseTimeOfDay, parseTimeZone, parseUTCTime, parseZonedTime, parseYear, parseMonth, parseQuarter, parseQuarterOfYear, ) where import Data.Bits ((.&.)) import Data.Char (ord, chr) import Data.Fixed (Fixed (..), Pico) import Data.Integer.Conversion (textToInteger) import Data.Text.Array (Array) import Data.Text.Internal (Text (..)) import GHC.Exts (inline) import Data.Time.Calendar (Day, fromGregorianValid) import Data.Time.Calendar.Compat (Year) import Data.Time.Calendar.Month.Compat (Month, fromYearMonthValid) import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..), fromYearQuarter) import Data.Time.Clock (UTCTime (..)) import qualified Data.Text as T import qualified Data.Text.Array as A import qualified Data.Time.LocalTime as Local -- The parsing functions here are written in continuation passing style -- with everything marked INLINE and continuation called with GHC.Exts.inline -- to try to enforce that whole CPS-business goes away (with slight code-duplication). -- -- Using staging would be a nicer way to enforce what we want here, -- but that would require TemplateHaskell. ------------------------------------------------------------------------------- -- Public functions ------------------------------------------------------------------------------- -- | 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. -- parseDay :: Text -> Either String Day parseDay = parseDay_ expectingEOF -- | Parse a month of the form @[+-]YYYY-MM@. -- -- See also 'parseDay' for details about the year format. parseMonth :: Text -> Either String Month parseMonth = parseMonth_ $ \y m t -> case fromYearMonthValid y m of Nothing -> Left $ "invalid month:" ++ show (y, m) Just !month -> expectingEOF month t -- | Parse a year @[+-]YYYY@, with at least 4 digits. Can include a sign. -- -- See also 'parseDay' for details about the year format. -- -- Note: 'Year' is a type synonym for 'Integer'. parseYear :: Text -> Either String Year parseYear = parseYear_ Right $ \_ c _ -> unexpectedChar c "end-of-input" -- | Parse a quarter of the form @[+-]YYYY-QN@. -- -- See also 'parseDay' for details about the year format. -- parseQuarter :: Text -> Either String Quarter parseQuarter = parseQuarter_ $ \y q t -> let !quarter = fromYearQuarter y q in expectingEOF quarter t -- | Parse a quarter of year of the form @QN@ or @qN@. parseQuarterOfYear :: Text -> Either String QuarterOfYear parseQuarterOfYear = parseQuarterOfYear_ expectingEOF -- | Parse a time of the form @HH:MM[:SS[.SSS]]@. parseTimeOfDay :: Text -> Either String Local.TimeOfDay parseTimeOfDay = parseTimeOfDay_ kontEOF $ \_ _ _ c _ -> unexpectedChar c "end-of-input" where kontEOF h m s = makeTimeOfDay h m s Right -- | Parse a time zone. -- -- The accepted formats are @Z@, @+HH@, @+HHMM@, or @+HH:MM@. (@+@ can be @-@). -- -- Accepts @-23:59..23:59@ range, i.e. @HH < 24@ and @MM < 59@. -- (This is consistent with grammar, and with what Python, Clojure, joda-time do). -- parseTimeZone :: Text -> Either String Local.TimeZone parseTimeZone = parseTimeZone_ Right -- | 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. parseLocalTime :: Text -> Either String Local.LocalTime parseLocalTime = parseLocalTime_ Right $ \_ c _ -> unexpectedChar c "end-of-input" -- | Behaves as 'zonedTime', but converts any time zone offset into a -- UTC time. parseUTCTime :: Text -> Either String UTCTime parseUTCTime = parseUTCTime_ Right -- | Parse a date with time zone info. Acceptable formats: -- -- @ -- YYYY-MM-DD HH:MMZ -- YYYY-MM-DD HH:MM:SSZ -- YYYY-MM-DD HH:MM:SS.SSSZ -- @ -- -- 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. parseZonedTime :: Text -> Either String Local.ZonedTime parseZonedTime = parseZonedTime_ Right ------------------------------------------------------------------------------- -- Uncons ------------------------------------------------------------------------------- -- As all characters in the time format are ASCII -- we can use slightly more efficient (or at least smaller) uncons. {-# INLINE unconsAscii_ #-} unconsAscii_ :: Array -> Int -> Int -> Either String r -- ^ EOF continuation -> (Char -> Int -> Int -> Either String r) -- ^ character continuation -> Either String r unconsAscii_ arr off len kontEOF kontC | len <= 0 = inline kontEOF | c < 0x80 = inline kontC (chr (fromIntegral c)) (off + 1) (len - 1) | otherwise = Left "Non-ASCII character" where c = A.unsafeIndex arr off {-# INLINE unconsAscii #-} unconsAscii :: Either String r -> (Char -> Text -> Either String r) -> Text -> Either String r unconsAscii kontEOF kontC (Text arr off len) = unconsAscii_ arr off len kontEOF $ \c off' len' -> inline kontC c (Text arr off' len') ------------------------------------------------------------------------------- -- Expecting errors ------------------------------------------------------------------------------- expectingEOF :: r -> Text -> Either String r expectingEOF = expectingEOF_ Right {-# INLINE expectingEOF #-} expectingEOF_ :: (a -> Either String r) -> a -> Text -> Either String r expectingEOF_ kont a t = case T.uncons t of Nothing -> inline kont a Just (c, _) -> unexpectedChar c "end-of-input" {-# INLINE expectingEOF_ #-} unexpectedEOF :: String -> Either String r unexpectedEOF expected = Left $ "Unexpected end-of-input, expecting " ++ expected unexpectedChar :: Char -> String -> Either String r unexpectedChar c expected = Left $ "Unexpected '" ++ c : "', expecting " ++ expected ------------------------------------------------------------------------------- -- Helpers ------------------------------------------------------------------------------- {-# INLINE fromChar #-} fromChar :: Char -> Int fromChar c = ord c .&. 0xf {-# INLINE twoDigits #-} twoDigits :: (Int -> Text -> Either String r) -> Text -> Either String r twoDigits kont = unconsAscii (unexpectedEOF "a digit") $ \c1 -> if | '0' <= c1, c1 <= '9' -> unconsAscii (unexpectedEOF "a digit") $ \c2 -> if | '0' <= c2, c2 <= '9' -> inline kont (fromChar c1 * 10 + fromChar c2) | otherwise -> \_ -> unexpectedChar c2 "a digit" | otherwise -> \_ -> unexpectedChar c1 "a digit" {-# INLINE munchDigits #-} munchDigits :: (Text -> Either String r) -> (Text -> Char -> Text -> Either String r) -> Text -> Either String r munchDigits kontEOF kontC (Text arr off len) = munchDigits_ kontEOF kontC arr off off len {-# INLINE munchDigits_ #-} munchDigits_ :: (Text -> Either String r) -> (Text -> Char -> Text -> Either String r) -> Array -> Int -> Int -> Int -> Either String r munchDigits_ kontEOF kontC arr = loop where loop off0 off len = unconsAscii_ arr off len (inline kontEOF (Text arr off0 (off - off0))) $ \c off' len' -> if | '0' <= c, c <= '9' -> loop off0 off' len' | otherwise -> inline kontC (Text arr off0 (off - off0)) c (Text arr off' len') utcTimeZone :: Local.TimeZone utcTimeZone = Local.TimeZone 0 False "" ------------------------------------------------------------------------------- -- Implementation: Dates ------------------------------------------------------------------------------- -- parse year: @[+-]YYYY@. -- Two continuations as we look at the following character. {-# INLINE parseYear_ #-} parseYear_ :: forall r. (Year -> Either String r) -> (Year -> Char -> Text -> Either String r) -> Text -> Either String r parseYear_ kontEOF kontC (Text arr offS lenS) = start offS lenS where start :: Int -> Int -> Either String r start !off !len = unconsAscii_ arr off len (unexpectedEOF "-, +, or a digit") $ \c off' len' -> case c of '-' -> loop negate off' off' len' '+' -> loop id off' off' len' _ | '0' <= c, c <= '9' -> loop id off off' len' | otherwise -> Left $ "Unexpected '" ++ show c ++ ", expecting -, +, or a digit" loop :: (Integer -> Integer) -> Int -> Int -> Int -> Either String r loop !posNeg !off0 !off !len = unconsAscii_ arr off len (finishEOF posNeg off0 off) $ \c off' len' -> if | '0' <= c, c <= '9' -> loop posNeg off0 off' len' | otherwise -> finishC posNeg c off0 off off' len' finishEOF :: (Integer -> Integer) -> Int -> Int -> Either String r finishEOF !posNeg !off0 !off | len0 >= 4 = year `seq` kontEOF year | otherwise = Left "expected year with at least 4 digits" where len0 = off - off0 year = posNeg (textToInteger (Text arr off0 len0)) {-# INLINE finishEOF #-} finishC :: (Integer -> Integer) -> Char -> Int -> Int -> Int -> Int-> Either String r finishC !posNeg c !off0 !off !off' !len' | len0 >= 4 = year `seq` kontC year c (Text arr off' len') | otherwise = Left "expected year with at least 4 digits" where len0 = off - off0 year = posNeg (textToInteger (Text arr off0 len0)) {-# INLINE finishC #-} {-# INLINE parseYear__ #-} -- parse year and the following dash: @[+-]YYYY-@ parseYear__ :: forall r. (Year -> Text -> Either String r) -> Text -> Either String r parseYear__ kont = parseYear_ (\_ -> unexpectedEOF "a dash after a year part") $ \ !y c t -> if c == '-' then kont y t else unexpectedChar c "a dash after a year part" -- parse month: @[-+]YYYY-MM@ {-# INLINE parseMonth_ #-} parseMonth_ :: forall r. (Year -> Int -> Text -> Either String r) -> Text -> Either String r parseMonth_ kont = parseYear__ $ \ !y -> twoDigits $ \ !m -> kont y m -- parse day: @[-+]YYYY-MM-DD@ {-# INLINE parseDay_ #-} parseDay_ :: forall r. (Day -> Text -> Either String r) -> Text -> Either String r parseDay_ kont = parseMonth_ $ \y m -> skipDash $ twoDigits $ \d -> case fromGregorianValid y m d of Nothing -> \_ -> Left $ "invalid day:" ++ show (y, m, d) Just !day -> inline kont day -- parse quarter: @[+-]YYYY-QN@ {-# INLINE parseQuarter_ #-} parseQuarter_ :: forall r. (Year -> QuarterOfYear -> Text -> Either String r) -> Text -> Either String r parseQuarter_ kont = parseYear__ $ \y -> parseQuarterOfYear_ $ \q -> inline kont y q {-# INLINE parseQuarterOfYear_ #-} parseQuarterOfYear_ :: forall r. (QuarterOfYear -> Text -> Either String r) -> Text -> Either String r parseQuarterOfYear_ kont = unconsAscii (unexpectedEOF "QuarterOfYear") $ \c -> if | 'Q' == c || 'q' == c -> unconsAscii (unexpectedEOF "Quarter digit") $ \c' -> case c' of '1' -> inline kont Q1 '2' -> inline kont Q2 '3' -> inline kont Q3 '4' -> inline kont Q4 _ -> \_ -> unexpectedChar c' "QuarterOfYear digit" | otherwise -> \_ -> unexpectedChar c "QuarterOfYear" {-# INLINE skipDash #-} skipDash :: forall r. (Text -> Either String r) -> Text -> Either String r skipDash kont = unconsAscii (unexpectedEOF "a dash, -") $ \c -> if c == '-' then inline kont else \_ -> unexpectedChar c "a dash, -" ------------------------------------------------------------------------------- -- Implementation: Time ------------------------------------------------------------------------------- -- Parse time of day : @HH:MM[:SS[.SSS]]@ {-# INLINE parseTimeOfDay_ #-} parseTimeOfDay_ :: (Int -> Int -> Pico -> Either String r) -> (Int -> Int -> Pico -> Char -> Text -> Either String r) -> Text -> Either String r parseTimeOfDay_ kontEOF kontC = twoDigits $ \h -> skipColon $ twoDigits $ \m -> unconsAscii (inline kontEOF h m 0) $ \ c -> if c == ':' then parseSeconds_ (inline kontEOF h m) (inline kontC h m) else inline kontC h m 0 c {-# INLINE parseTimeOfDay__ #-} parseTimeOfDay__ :: (Local.TimeOfDay -> Either String r) -> (Local.TimeOfDay -> Char -> Text -> Either String r) -> Text -> Either String r parseTimeOfDay__ kontEOF kontC = parseTimeOfDay_ (\h m s -> makeTimeOfDay h m s kontEOF) (\h m s c t -> makeTimeOfDay h m s $ \l -> inline kontC l c t) {-# INLINE makeTimeOfDay #-} makeTimeOfDay :: Int -> Int -> Pico -> (Local.TimeOfDay -> Either String r) -> Either String r makeTimeOfDay h m s kont = if h < 24 && m < 60 && s < 61 then inline kont (Local.TimeOfDay h m s) else Left $ "Invalid time of day:" ++ show (h,m,s) -- Parse seconds: @SS.SSS@. -- {-# INLINE parseSeconds_ #-} parseSeconds_ :: (Pico -> Either String r) -> (Pico -> Char -> Text -> Either String r) -> Text -> Either String r parseSeconds_ kontEOF kontC = twoDigits $ \real -> unconsAscii (inline kontEOF (fromIntegral real)) $ \c -> if c == '.' then munchDigits (\i -> makeSeconds real kontEOF i) (\i c' t -> makeSeconds real (\j -> inline kontC j c' t) i) else kontC (MkFixed $ toInteger real * pico) c {-# INLINE makeSeconds #-} makeSeconds :: Int -> (Pico -> Either String r) -> Text -> Either String r makeSeconds real kont t@(Text _arr _off len) | len == 0 = Left "Expecting at least one decimal after a dot" | len > 12 = Left "Unexpectedly over twelve decimals" | otherwise = inline kont (MkFixed (toInteger real * pico + textToInteger t * 10 ^ expo)) where expo = 12 - len {-# INLINE parseTimeZone_ #-} parseTimeZone_ :: (Local.TimeZone -> Either String r) -> Text -> Either String r parseTimeZone_ kont = inline unconsAscii (unexpectedEOF "timezone: Z, +HH:MM or -HH:MM") $ \c t -> parseTimeZone__ () (\_ -> inline kont) c t pico :: Integer pico = 1000000000000 -- 12 zeros {-# INLINE parseTimeZone__ #-} parseTimeZone__ :: a -- "extra bit of state" -> (a -> Local.TimeZone -> Either String r) -> Char -> Text -> Either String r parseTimeZone__ x kont c t0 = case c of '-' -> hhmm x negate t0 '+' -> hhmm x id t0 'Z' -> expectingEOF_ (inline kont x) utcTimeZone t0 _ -> unexpectedChar c "timezone: Z, +HH:MM or -HH:MM" where hhmm y posNeg = twoDigits $ \hh -> unconsAscii (withResult posNeg hh 0 (kont y)) $ \c1 -> case c1 of ':' -> twoDigits $ \mm -> expectingEOF_ (\mm' -> withResult posNeg hh mm' (kont y)) mm _ | '0' <= c1, c1 <= '9' -> unconsAscii (unexpectedEOF "a digit") $ \c2 -> if '0' <= c2 && c2 <= '9' then expectingEOF_ (\mm' -> withResult posNeg hh mm' (kont y)) (fromChar c1 * 10 + fromChar c2) else \_ -> unexpectedChar c2 "a digit" _ -> \_ -> unexpectedChar c1 "colon or a digit" withResult :: (Int -> Int) -> Int -> Int -> (Local.TimeZone -> Either String b) -> Either String b withResult posNeg hh mm kontR = -- we accept hours <24 and minutes <60 -- this is how grammar implies, and also how python, joda-time -- and clojure #inst literals seem to work. -- Java's java.time seems to restrict to -18..18: https://docs.oracle.com/javase/8/docs/api/java/time/ZoneOffset.html -- but that seems more arbitrary. if hh < 24 && mm < 60 then kontR (Local.minutesToTimeZone (posNeg (hh * 60 + mm))) else Left $ "Invalid TimeZone:" ++ show (hh, mm) {-# INLINE parseLocalTime_ #-} parseLocalTime_ :: (Local.LocalTime -> Either String r) -> (Local.LocalTime -> Char -> Text -> Either String r) -> Text -> Either String r parseLocalTime_ kontEOF kontC = parseDay_ $ \d -> skipDaySeparator $ parseTimeOfDay__ (\l -> inline kontEOF (Local.LocalTime d l)) (\l c t -> inline kontC (Local.LocalTime d l) c t) {-# INLINE parseUTCTime_ #-} parseUTCTime_ :: (UTCTime -> Either String r) -> Text -> Either String r parseUTCTime_ kont = parseZonedTime_ $ \zt -> inline kont (Local.zonedTimeToUTC zt) {-# INLINE parseZonedTime_ #-} parseZonedTime_ :: (Local.ZonedTime -> Either String r) -> Text -> Either String r parseZonedTime_ kont = parseLocalTime_ (\_ -> unexpectedEOF "timezone") $ \lt c -> parseZT kont lt c {-# INLINE parseZT #-} parseZT :: (Local.ZonedTime -> Either String r) -> Local.LocalTime -> Char -> Text -> Either String r parseZT kont lt = parseTimeZone__ lt $ \lt' tz -> inline kont (Local.ZonedTime lt' tz) {-# INLINE skipColon #-} skipColon :: (Text -> Either String r) -> Text -> Either String r skipColon kont = unconsAscii (unexpectedEOF "a colon, :") $ \c -> if c == ':' then inline kont else \_ -> unexpectedChar c "a colon, :" {-# INLINE skipDaySeparator #-} skipDaySeparator :: (Text -> Either String r) -> Text -> Either String r skipDaySeparator kont = unconsAscii (unexpectedEOF "a day separator, T or space") $ \c -> if c == 'T' || c == ' ' then inline kont else \_ -> unexpectedChar c "a day separator, T or space" text-iso8601-0.1.1/src/Data/Time/ToText.hs0000644000000000000000000001111207346545000016112 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} module Data.Time.ToText ( buildDay, buildLocalTime, buildTimeOfDay, buildTimeZone, buildUTCTime, buildZonedTime, buildYear, buildMonth, buildQuarter, buildQuarterOfYear, ) where import Data.Char (chr) import Data.Fixed (Fixed (..)) import Data.Int (Int64) import Data.Text.Lazy.Builder (Builder) import Data.Time (TimeOfDay (..)) import Data.Time.Calendar (Day, toGregorian) import Data.Time.Calendar.Compat (Year) import Data.Time.Calendar.Month.Compat (Month, toYearMonth) import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..), toYearQuarter) import Data.Time.Clock (UTCTime (..)) import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder.Int as B (decimal) import qualified Data.Time.LocalTime as Local #if !MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>)) #endif buildDay :: Day -> Builder buildDay dd = buildYear yr <> char7 '-' <> digits2 m <> char7 '-' <> digits2 d where (yr,m,d) = toGregorian dd {-# INLINE buildDay #-} buildMonth :: Month -> Builder buildMonth mm = buildYear yr <> char7 '-' <> digits2 m where (yr,m) = toYearMonth mm {-# INLINE buildMonth #-} buildQuarter :: Quarter -> Builder buildQuarter qq = buildYear yr <> char7 '-' <> buildQuarterOfYear q where (yr,q) = toYearQuarter qq {-# INLINE buildQuarter #-} buildQuarterOfYear :: QuarterOfYear -> Builder buildQuarterOfYear q = char7 'q' <> case q of Q1 -> char7 '1' Q2 -> char7 '2' Q3 -> char7 '3' Q4 -> char7 '4' -- | Used in encoding day, month, quarter buildYear :: Year -> Builder buildYear y | y >= 1000 = B.decimal y | y >= 0 = padYear y | y >= -999 = char7 '-' <> padYear (negate y) | otherwise = B.decimal y where padYear y' = let (ab,c) = fromIntegral y' `quotRem` 10 (a,b) = ab `quotRem` 10 in char7 '0' <> digit a <> digit b <> digit c {-# INLINE buildYear #-} buildTimeOfDay :: TimeOfDay -> Builder buildTimeOfDay (TimeOfDay h m (MkFixed s)) = digits2 h <> char7 ':' <> digits2 m <> char7 ':' <> digits2 (fromInteger real) <> buildFrac (fromInteger frac) where (real,frac) = s `quotRem` pico buildFrac :: Int64 -> Builder buildFrac 0 = mempty buildFrac i = char7 '.' <> case i `quotRem` micro of (hi, 0) -> buildFrac6 hi (hi, lo) -> digits6 hi <> buildFrac6 lo buildFrac6 :: Int64 -> Builder buildFrac6 i = case i `quotRem` milli of (hi, 0) -> digits3 hi (hi, lo) -> digits3 hi <> digits3 lo digits6 i = case i `quotRem` milli of (hi, lo) -> digits3 hi <> digits3 lo digits3 i = digit64 a <> digit64 b <> digit64 c where (ab, c) = i `quotRem` 10 (a, b) = ab `quotRem` 10 pico = 1000000000000 -- number of picoseconds in 1 second micro = 1000000 -- number of microseconds in 1 second milli = 1000 -- number of milliseconds in 1 second {-# INLINE buildTimeOfDay #-} buildTimeZone :: Local.TimeZone -> Builder buildTimeZone (Local.TimeZone off _ _) | off == 0 = char7 'Z' | otherwise = char7 s <> digits2 h <> char7 ':' <> digits2 m where !s = if off < 0 then '-' else '+' (h,m) = abs off `quotRem` 60 {-# INLINE buildTimeZone #-} dayTime :: Day -> TimeOfDay -> Builder dayTime d t = buildDay d <> char7 'T' <> buildTimeOfDay t {-# INLINE dayTime #-} buildUTCTime :: UTCTime -> B.Builder buildUTCTime (UTCTime d s) = dayTime d (Local.timeToTimeOfDay s) <> char7 'Z' {-# INLINE buildUTCTime #-} buildLocalTime :: Local.LocalTime -> Builder buildLocalTime (Local.LocalTime d t) = dayTime d t {-# INLINE buildLocalTime #-} buildZonedTime :: Local.ZonedTime -> Builder buildZonedTime (Local.ZonedTime t z) = buildLocalTime t <> buildTimeZone z {-# INLINE buildZonedTime #-} ------------------------------------------------------------------------------- -- Utilities ------------------------------------------------------------------------------- digits2 :: Int -> Builder digits2 a = digit hi <> digit lo where (hi,lo) = a `quotRem` 10 digit :: Int -> Builder digit x = char7 (chr (x + 48)) digit64 :: Int64 -> Builder digit64 = digit . fromIntegral char7 :: Char -> Builder char7 = B.singleton text-iso8601-0.1.1/tests/0000755000000000000000000000000007346545000013137 5ustar0000000000000000text-iso8601-0.1.1/tests/text-iso8601-tests.hs0000644000000000000000000001120207346545000016722 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Main (main) where import Data.Functor.Classes (liftEq) import Data.Proxy (Proxy (..)) import Data.Text (Text) import Data.Text.Lazy.Builder (Builder, toLazyText) import Data.Time.LocalTime.Compat (TimeZone (..), ZonedTime (..)) import Data.Typeable (Typeable, typeRep) import Test.QuickCheck (Arbitrary, counterexample, property) import Test.QuickCheck.Instances () import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertFailure, testCase) import Test.Tasty.QuickCheck (testProperty) import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Time.FromText as T import qualified Data.Time.ToText as T main :: IO () main = defaultMain $ testGroup "text-iso8601" [ testGroup "roundtrip" [ roundtrip (==) T.buildDay T.parseDay , roundtrip (==) T.buildLocalTime T.parseLocalTime , roundtrip eqTZ T.buildTimeZone T.parseTimeZone , roundtrip (==) T.buildUTCTime T.parseUTCTime , roundtrip eqZT T.buildZonedTime T.parseZonedTime , roundtrip (==) T.buildTimeOfDay T.parseTimeOfDay , roundtrip (==) T.buildYear T.parseYear , roundtrip (==) T.buildMonth T.parseMonth , roundtrip (==) T.buildQuarter T.parseQuarter , roundtrip (==) T.buildQuarterOfYear T.parseQuarterOfYear ] , testGroup "accepts" -- we accept space instead of T -- RFC3339 has a note suggesting allowing this. [ accepts T.parseUTCTime "2023-06-09 02:35:33Z" -- 60 second is always accepted , accepts T.parseUTCTime "2023-06-09T02:35:60Z" -- examples from RFC3339 , accepts T.parseUTCTime "1985-04-12T23:20:50.52Z" , accepts T.parseUTCTime "1996-12-19T16:39:57-08:00" , accepts T.parseUTCTime "1990-12-31T23:59:60Z" , accepts T.parseUTCTime "1990-12-31T15:59:60-08:00" , accepts T.parseUTCTime "1937-01-01T12:00:27.87+00:20" -- we accept time without seconds , accepts T.parseUTCTime "1937-01-01 12:00Z" , accepts T.parseLocalTime "1937-01-01 12:00" -- ISO8601 allows various offsets, while RFC3339 only +-HH:MM , accepts T.parseUTCTime "1990-12-31T15:59:60-0800" -- no colon , accepts T.parseUTCTime "1990-12-31T15:59:60-08" -- just hour -- accepts +23:59 , accepts T.parseUTCTime "1937-01-01T12:00:00+23:59" , accepts T.parseUTCTime "1937-01-01T12:00:00-23:59" ] , testGroup "rejected" -- https://github.com/haskell/aeson/issues/1033 [ rejects T.parseUTCTime "2023-06-09T02:35:33 Z" -- Y2K years , rejects T.parseDay "99-12-12" -- we don't accept lowercase T or Z -- RFC3339 says we MAY limit, i.e. requiring they should be uppercase. , rejects T.parseUTCTime "2023-06-09T02:35:33z" , rejects T.parseUTCTime "2023-06-09t02:35:33Z" -- accepts +23:59, but not 24 or 60 , rejects T.parseUTCTime "1937-01-01T12:00:00+24:59" , rejects T.parseUTCTime "1937-01-01T12:00:00-23:60" ] ] eqTZ :: TimeZone -> TimeZone -> Bool eqTZ a b = timeZoneMinutes a == timeZoneMinutes b eqZT :: ZonedTime -> ZonedTime -> Bool eqZT (ZonedTime lt tz) (ZonedTime lt' tz') = lt == lt' && eqTZ tz tz' roundtrip :: forall a. (Typeable a, Arbitrary a, Show a) => (a -> a -> Bool) -> (a -> Builder) -> (Text -> Either String a) -> TestTree roundtrip eq build parse = testProperty (show (typeRep (Proxy :: Proxy a))) $ \x -> let lt = toLazyText (build x) y = parse (LT.toStrict lt) in counterexample (LT.unpack lt) $ counterexample (show y) $ property (liftEq eq y (Right x)) rejects :: forall a. (Typeable a, Show a) => (Text -> Either String a) -> String -> TestTree rejects parse inp = testCase (show (typeRep (Proxy :: Proxy a)) ++ " rejects " ++ show inp) $ do case parse (T.pack inp) of Left _ -> return () Right a -> assertFailure $ "Unexpectedly accepted: " ++ show a accepts :: forall a. (Typeable a, Show a) => (Text -> Either String a) -> String -> TestTree accepts parse inp = testCase (show (typeRep (Proxy :: Proxy a)) ++ " accepts " ++ show inp) $ do case parse (T.pack inp) of Left err -> assertFailure $ "Unexpectedly rejected: " ++ err Right _ -> return () text-iso8601-0.1.1/text-iso8601.cabal0000644000000000000000000000450607346545000015061 0ustar0000000000000000cabal-version: 1.12 name: text-iso8601 version: 0.1.1 synopsis: Converting time to and from ISO 8601 text. description: Converting time to and from IS0 8601 text. Specifically the [RFC3339](https://datatracker.ietf.org/doc/html/rfc3339) profile. license: BSD3 license-file: LICENSE category: Parsing copyright: Oleg Grenrus author: Oleg Grenrus maintainer: Oleg Grenrus 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 source-repository head type: git location: git://github.com/haskell/aeson.git subdir: text-iso8601 library default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall exposed-modules: Data.Time.FromText Data.Time.ToText build-depends: 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 test-suite text-iso8601-tests default-language: Haskell2010 hs-source-dirs: tests type: exitcode-stdio-1.0 main-is: text-iso8601-tests.hs ghc-options: -Wall build-depends: base , text , text-iso8601 , time-compat -- test dependencies build-depends: QuickCheck >=2.14.3 && <2.16 , quickcheck-instances >=0.3.29.1 && <0.4 , tasty >=1.4.3 && <1.6 , tasty-hunit >=0.10.0.3 && <0.11 , tasty-quickcheck >=0.10.2 && <0.11 benchmark text-iso8601-bench default-language: Haskell2010 hs-source-dirs: bench type: exitcode-stdio-1.0 main-is: text-iso8601-bench.hs ghc-options: -Wall build-depends: base , text , text-iso8601 , time-compat -- bench dependencies build-depends: attoparsec >=0.14.4 && <0.15 , attoparsec-iso8601 >=1.1.0.1 && <1.2 , tasty-bench >=0.3.4 && <0.4