From 1c9e358b504ac4e66fa1ed4e392cddbce0247182 Mon Sep 17 00:00:00 2001 From: sternenseemann Date: Mon, 22 Jun 2020 13:11:39 +0200 Subject: [PATCH] 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