From 1c9e358b504ac4e66fa1ed4e392cddbce0247182 Mon Sep 17 00:00:00 2001 From: sternenseemann Date: Mon, 22 Jun 2020 13:11:39 +0200 Subject: [PATCH 1/4] Fix addSecondFractions failing when subtracting whole multiples of 1.0 Also adds a test case for this: addSecondFractions (-1.0) should exactly behave like addSeconds (-1). Resolves #12. --- Data/UTC/Class/IsTime.hs | 1 + tests/Test.hs | 2 ++ 2 files changed, 3 insertions(+) diff --git a/Data/UTC/Class/IsTime.hs b/Data/UTC/Class/IsTime.hs index 08e16e8..71c355d 100644 --- a/Data/UTC/Class/IsTime.hs +++ b/Data/UTC/Class/IsTime.hs @@ -82,6 +82,7 @@ class IsTime t where addSecondFractions f t | f == 0 = return t | f >= 0 = setSecondFraction frcs t >>= addSeconds secs + | frcs == 0 = setSecondFraction 0 t >>= addSeconds secs | otherwise = setSecondFraction (frcs + 1.0) t >>= addSeconds (secs - 1) where f' = f + (secondFraction t) diff --git a/tests/Test.hs b/tests/Test.hs index 5ee3151..d67d1cc 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -105,6 +105,8 @@ testTimeInstance t (addSecondFractions (-0.001) t >>= return . minute) == Just 59 && (addSecondFractions (-0.001) t >>= return . second) == Just 59 && (addSecondFractions (-0.001) t >>= return . secondFraction) == Just 0.999 + , testProperty ("Subtracting 1.0s as fraction should result in -1 seconds") + $ (addSecondFractions (-1.0) t == addSeconds (-1) t `asTypeOf` Just t) ] ] where From 6e63bec1fd52098c10c0e875a6baffd155452df8 Mon Sep 17 00:00:00 2001 From: sternenseemann Date: Fri, 19 Jun 2020 20:01:32 +0200 Subject: [PATCH 2/4] Interpret offset as seconds instead of minutes in renderRfc3339 Previously renderRfc3339 would interpret the offset of a Local time as minutes instead of seconds contrary to parseRfc3339 and the documented semantics of that type. This lead to the time zone offset being off by a factor of 60 when using renderRfc3339. Fixes #9. --- Data/UTC/Format/Rfc3339/Builder.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Data/UTC/Format/Rfc3339/Builder.hs b/Data/UTC/Format/Rfc3339/Builder.hs index 154c8b0..b24ace9 100644 --- a/Data/UTC/Format/Rfc3339/Builder.hs +++ b/Data/UTC/Format/Rfc3339/Builder.hs @@ -52,10 +52,10 @@ rfc3339Builder (Local os t) , case os of Nothing -> BS.string7 "-00:00" Just 0 -> BS.char7 'Z' - Just o -> let oh1 = fromIntegral $ abs (truncate o `quot` 600 `rem` 10 :: Integer) - oh0 = fromIntegral $ abs (truncate o `quot` 60 `rem` 10 :: Integer) - om1 = fromIntegral $ abs (truncate o `rem` 60 `quot` 10 `rem` 10 :: Integer) - om0 = fromIntegral $ abs (truncate o `rem` 60 `rem` 10 :: Integer) + Just o -> let oh1 = fromIntegral $ abs (truncate o `quot` 36000 `rem` 10 :: Integer) + oh0 = fromIntegral $ abs (truncate o `quot` 3600 `rem` 10 :: Integer) + om1 = fromIntegral $ abs (truncate o `rem` 3600 `quot` 600 `rem` 10 :: Integer) + om0 = fromIntegral $ abs (truncate o `rem` 3600 `quot` 60 `rem` 10 :: Integer) in mconcat [ if o < 0 then BS.char7 '-' From 2b145b162dd84e02ad011b9dd394349e06b0f2c8 Mon Sep 17 00:00:00 2001 From: sternenseemann Date: Fri, 19 Jun 2020 22:03:17 +0200 Subject: [PATCH 3/4] Generate an error if offset is too accurate in renderRfc3339 RFC3339 only supports offsets as accurate as a minute, but Local provides the offset in seconds. This means that the rendering of RFC3339 strings in utc is lossy, i. e. a value rendered and could be different when parsed, as the RFC3339 string wouldn't be able to represent it accurate enough. To prevent this we now refuse to render Local values that would result in data loss by throwing an UtcException. --- Data/UTC/Format/Rfc3339/Builder.hs | 117 +++++++++++++++-------------- 1 file changed, 61 insertions(+), 56 deletions(-) diff --git a/Data/UTC/Format/Rfc3339/Builder.hs b/Data/UTC/Format/Rfc3339/Builder.hs index b24ace9..88a8df6 100644 --- a/Data/UTC/Format/Rfc3339/Builder.hs +++ b/Data/UTC/Format/Rfc3339/Builder.hs @@ -3,65 +3,70 @@ module Data.UTC.Format.Rfc3339.Builder ( rfc3339Builder ) where -import Data.Monoid +import Control.Monad.Catch import Data.ByteString.Builder as BS +import Data.UTC.Type.Exception import Data.UTC.Type.Local import Data.UTC.Class.IsDate import Data.UTC.Class.IsTime -rfc3339Builder :: (Monad m, IsDate t, IsTime t) => Local t -> m BS.Builder -rfc3339Builder (Local os t) - = do -- calculate the single digits - let y3 = fromIntegral $ year t `div` 1000 `mod` 10 - y2 = fromIntegral $ year t `div` 100 `mod` 10 - y1 = fromIntegral $ year t `div` 10 `mod` 10 - y0 = fromIntegral $ year t `div` 1 `mod` 10 - m1 = fromIntegral $ month t `div` 10 `mod` 10 - m0 = fromIntegral $ month t `div` 1 `mod` 10 - d1 = fromIntegral $ day t `div` 10 `mod` 10 - d0 = fromIntegral $ day t `div` 1 `mod` 10 - h1 = fromIntegral $ hour t `div` 10 `mod` 10 - h0 = fromIntegral $ hour t `div` 1 `mod` 10 - n1 = fromIntegral $ minute t `div` 10 `mod` 10 - n0 = fromIntegral $ minute t `div` 1 `mod` 10 - s1 = fromIntegral $ second t `div` 10 `mod` 10 - s0 = fromIntegral $ second t `div` 1 `mod` 10 - f2 = truncate (secondFraction t * 10) `mod` 10 - f1 = truncate (secondFraction t * 100) `mod` 10 - f0 = truncate (secondFraction t * 1000) `mod` 10 - return $ mconcat - [ BS.word16HexFixed (y3*16*16*16 + y2*16*16 + y1*16 + y0) - , BS.char7 '-' - , BS.word8HexFixed (m1*16 + m0) - , BS.char7 '-' - , BS.word8HexFixed (d1*16 + d0) - , BS.char7 'T' - , BS.word8HexFixed (h1*16 + h0) - , BS.char7 ':' - , BS.word8HexFixed (n1*16 + n0) - , BS.char7 ':' - , BS.word8HexFixed (s1*16 + s0) - , if f0 == 0 - then if f1 == 0 - then if f2 == 0 - then mempty - else BS.char7 '.' `mappend` BS.intDec f2 - else BS.char7 '.' `mappend` BS.intDec f2 `mappend` BS.intDec f1 - else BS.char7 '.' `mappend` BS.intDec f2 `mappend` BS.intDec f1 `mappend` BS.intDec f0 - , case os of - Nothing -> BS.string7 "-00:00" - Just 0 -> BS.char7 'Z' - Just o -> let oh1 = fromIntegral $ abs (truncate o `quot` 36000 `rem` 10 :: Integer) - oh0 = fromIntegral $ abs (truncate o `quot` 3600 `rem` 10 :: Integer) - om1 = fromIntegral $ abs (truncate o `rem` 3600 `quot` 600 `rem` 10 :: Integer) - om0 = fromIntegral $ abs (truncate o `rem` 3600 `quot` 60 `rem` 10 :: Integer) - in mconcat - [ if o < 0 - then BS.char7 '-' - else BS.char7 '+' - , BS.word8HexFixed (oh1*16 + oh0) - , BS.char7 ':' - , BS.word8HexFixed (om1*16 + om0) - ] - ] +rfc3339Builder :: (MonadThrow m, IsDate t, IsTime t) => Local t -> m BS.Builder +rfc3339Builder (Local os t) = + -- calculate the single digits + let y3 = fromIntegral $ year t `div` 1000 `mod` 10 + y2 = fromIntegral $ year t `div` 100 `mod` 10 + y1 = fromIntegral $ year t `div` 10 `mod` 10 + y0 = fromIntegral $ year t `div` 1 `mod` 10 + m1 = fromIntegral $ month t `div` 10 `mod` 10 + m0 = fromIntegral $ month t `div` 1 `mod` 10 + d1 = fromIntegral $ day t `div` 10 `mod` 10 + d0 = fromIntegral $ day t `div` 1 `mod` 10 + h1 = fromIntegral $ hour t `div` 10 `mod` 10 + h0 = fromIntegral $ hour t `div` 1 `mod` 10 + n1 = fromIntegral $ minute t `div` 10 `mod` 10 + n0 = fromIntegral $ minute t `div` 1 `mod` 10 + s1 = fromIntegral $ second t `div` 10 `mod` 10 + s0 = fromIntegral $ second t `div` 1 `mod` 10 + f2 = truncate (secondFraction t * 10) `mod` 10 + f1 = truncate (secondFraction t * 100) `mod` 10 + f0 = truncate (secondFraction t * 1000) `mod` 10 + dateTime = mconcat + [ BS.word16HexFixed (y3*16*16*16 + y2*16*16 + y1*16 + y0) + , BS.char7 '-' + , BS.word8HexFixed (m1*16 + m0) + , BS.char7 '-' + , BS.word8HexFixed (d1*16 + d0) + , BS.char7 'T' + , BS.word8HexFixed (h1*16 + h0) + , BS.char7 ':' + , BS.word8HexFixed (n1*16 + n0) + , BS.char7 ':' + , BS.word8HexFixed (s1*16 + s0) + , if f0 == 0 + then if f1 == 0 + then if f2 == 0 + then mempty + else BS.char7 '.' `mappend` BS.intDec f2 + else BS.char7 '.' `mappend` BS.intDec f2 `mappend` BS.intDec f1 + else BS.char7 '.' `mappend` BS.intDec f2 `mappend` BS.intDec f1 `mappend` BS.intDec f0 + ] + -- prepend dateTime part of the string to the timezone part which might fail + in fmap (dateTime <>) $ + case os of + Nothing -> return $ BS.string7 "-00:00" + Just 0 -> return $ BS.char7 'Z' + Just o -> if ((abs (truncate o)) `rem` 60 :: Integer) /= 0 + then throwM $ UtcException $ "Offset " ++ show o ++ " more accurate than a minute (unsupported by RFC3339)" + else let oh1 = fromIntegral $ abs (truncate o `quot` 36000 `rem` 10 :: Integer) + oh0 = fromIntegral $ abs (truncate o `quot` 3600 `rem` 10 :: Integer) + om1 = fromIntegral $ abs (truncate o `rem` 3600 `quot` 600 `rem` 10 :: Integer) + om0 = fromIntegral $ abs (truncate o `rem` 3600 `quot` 60 `rem` 10 :: Integer) + in return $ mconcat + [ if o < 0 + then BS.char7 '-' + else BS.char7 '+' + , BS.word8HexFixed (oh1*16 + oh0) + , BS.char7 ':' + , BS.word8HexFixed (om1*16 + om0) + ] From 4f643f5f0184db31f9c2b2eed952b80beb82f5ff Mon Sep 17 00:00:00 2001 From: sternenseemann Date: Sat, 27 Jun 2020 23:55:16 +0200 Subject: [PATCH 4/4] Interpret RFC3339 datetime as local time Contrary to the specification of RFC3339 as a local date time plus a offset from UTC, renderRfc3339 and parseRfc3339 will now interpret RFC3339 times as local times if an offset is given. Resolves #11. --- Data/UTC/Format/Rfc3339.hs | 3 ++- Data/UTC/Format/Rfc3339/Builder.hs | 7 ++++--- Data/UTC/Format/Rfc3339/Parser.hs | 3 +++ 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/Data/UTC/Format/Rfc3339.hs b/Data/UTC/Format/Rfc3339.hs index b5a6426..8e9d078 100644 --- a/Data/UTC/Format/Rfc3339.hs +++ b/Data/UTC/Format/Rfc3339.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} module Data.UTC.Format.Rfc3339 ( -- * Parsing @@ -61,7 +62,7 @@ instance Rfc3339Parser [Char] where -- > >>= renderRfc3339 :: Maybe String -- > > Just "1987-07-10T12:04:00Z" class Rfc3339Renderer string where - renderRfc3339 :: (MonadThrow m, IsDate t, IsTime t, Epoch t) => Local t -> m string + renderRfc3339 :: (MonadThrow m, IsDate (Local t), IsTime (Local t)) => Local t -> m string instance Rfc3339Renderer BS.ByteString where renderRfc3339 t diff --git a/Data/UTC/Format/Rfc3339/Builder.hs b/Data/UTC/Format/Rfc3339/Builder.hs index 88a8df6..93193b7 100644 --- a/Data/UTC/Format/Rfc3339/Builder.hs +++ b/Data/UTC/Format/Rfc3339/Builder.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Safe #-} module Data.UTC.Format.Rfc3339.Builder ( rfc3339Builder @@ -11,8 +12,8 @@ import Data.UTC.Type.Local import Data.UTC.Class.IsDate import Data.UTC.Class.IsTime -rfc3339Builder :: (MonadThrow m, IsDate t, IsTime t) => Local t -> m BS.Builder -rfc3339Builder (Local os t) = +rfc3339Builder :: (MonadThrow m, IsDate (Local t), IsTime (Local t)) => Local t -> m BS.Builder +rfc3339Builder t = -- calculate the single digits let y3 = fromIntegral $ year t `div` 1000 `mod` 10 y2 = fromIntegral $ year t `div` 100 `mod` 10 @@ -53,7 +54,7 @@ rfc3339Builder (Local os t) = ] -- prepend dateTime part of the string to the timezone part which might fail in fmap (dateTime <>) $ - case os of + case offset t of Nothing -> return $ BS.string7 "-00:00" Just 0 -> return $ BS.char7 'Z' Just o -> if ((abs (truncate o)) `rem` 60 :: Integer) /= 0 diff --git a/Data/UTC/Format/Rfc3339/Parser.hs b/Data/UTC/Format/Rfc3339/Parser.hs index c9f8070..108709e 100644 --- a/Data/UTC/Format/Rfc3339/Parser.hs +++ b/Data/UTC/Format/Rfc3339/Parser.hs @@ -9,6 +9,8 @@ import Data.Ratio import Data.Attoparsec.ByteString ( Parser, skipWhile, choice, option, satisfy ) import Data.Attoparsec.ByteString.Char8 ( char, isDigit_w8 ) +import Data.Maybe (fromMaybe) + import Data.UTC.Class.Epoch import Data.UTC.Class.IsDate import Data.UTC.Class.IsTime @@ -37,6 +39,7 @@ rfc3339Parser >>= setMinute minute' >>= setSecond second' >>= setSecondFraction secfrac' + >>= addSecondFractions (-1 * fromMaybe 0 offset') return (Local offset' datetime) where dateFullYear