Merge pull request #668 from adamschoenemann/master

Handle leap seconds corretly (Fixes #557)

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

@@ -23,10 +23,31 @@ import Data.Int (Int64)
 import Data.Time
 import Unsafe.Coerce (unsafeCoerce)
 
+#if MIN_VERSION_time(1,6,0)
+
+import Data.Time.Clock (diffTimeToPicoseconds)
+
+#endif
+
 #if MIN_VERSION_base(4,7,0)
 
 import Data.Fixed (Pico, Fixed(MkFixed))
 
+#else
+
+import Data.Fixed (Pico)
+
+#endif
+
+#if !MIN_VERSION_time(1,6,0)
+
+diffTimeToPicoseconds :: DiffTime -> Integer
+diffTimeToPicoseconds = unsafeCoerce
+
+#endif
+
+#if MIN_VERSION_base(4,7,0)
+
 toPico :: Integer -> Pico
 toPico = MkFixed
 
@@ -35,8 +56,6 @@ fromPico (MkFixed i) = i
 
 #else
 
-import Data.Fixed (Pico)
-
 toPico :: Integer -> Pico
 toPico = unsafeCoerce
 
@@ -50,11 +69,16 @@ data TimeOfDay64 = TOD {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int64
 
+posixDayLength :: DiffTime
+posixDayLength = 86400
+
 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
+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 s) = TOD h m (fromIntegral (fromPico s))

stack-lts6.yaml

@@ -3,7 +3,6 @@ packages:
 - '.'
 - attoparsec-iso8601
 extra-deps:
-- integer-logarithms-1
 - semigroups-0.18.2
 - tagged-0.8.5
 - transformers-compat-0.5.1.4
@@ -13,6 +12,7 @@ extra-deps:
 - integer-logarithms-1
 - quickcheck-instances-0.3.16
 - th-abstraction-0.2.2.0
+- text-1.2.3.0
 flags:
 flags:
   aeson:

stack-lts7.yaml

@@ -9,6 +9,7 @@ extra-deps:
 - integer-logarithms-1
 - quickcheck-instances-0.3.16
 - th-abstraction-0.2.2.0
+- text-1.2.3.0
 flags:
   aeson:
     fast: true

tests/UnitTests.hs

@@ -199,6 +199,14 @@ utcTimeGood = do
   assertEqual "utctime" (parseWithRead "%F %H:%MZ" ts11) t11
   assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t12
 
+  -- leap seconds are included correctly
+  let ts13 = "2015-08-23T23:59:60.128+00" :: LT.Text
+  let (Just (t13 ::  UTCTime)) = parseWithAeson ts13
+  assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-08-23T23:59:60.128Z") t13
+  let ts14 = "2015-08-23T23:59:60.999999999999+00" :: LT.Text
+  let (Just (t14 ::  UTCTime)) = parseWithAeson ts14
+  assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-08-23T23:59:60.999999999999Z") t14
+
   where
     parseWithRead :: String -> LT.Text -> UTCTime
     parseWithRead f s =
@@ -218,6 +226,7 @@ utcTimeBad = do
   verifyFailParse "2015-01-01T12:30:00.00+00:00Z" -- no Zulu if offset given
   verifyFailParse "2015-01-03 12:13:00.Z" -- decimal at the end but no digits
   verifyFailParse "2015-01-03 12:13.000Z" -- decimal at the end, but no seconds
+  verifyFailParse "2015-01-03 23:59:61Z"  -- exceeds allowed seconds per day
   where
     verifyFailParse (s :: LT.Text) =
       let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""] in