Merge pull request #146 from proda-ai/fix-all-handling-of-1900-dates

Be Excel-compatible when handling pre 1900-03-01 dates

CHANGELOG.markdown

@@ -1,3 +1,7 @@
+0.8.5
+------------
+* Treat 1900 as a leap year like Excel does
+
 0.8.4
 ------------
 * dropped support for GHC 8.0.* and 8.2.* and added support for GHC 8.10.* and 9.0.*

src/Codec/Xlsx/Types/Common.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Codec.Xlsx.Types.Common
   ( CellRef(..)
   , singleCellRef
@@ -251,23 +252,45 @@ baseDate :: DateBase -> Day
 baseDate DateBase1900 = fromGregorian 1899 12 30
 baseDate DateBase1904 = fromGregorian 1904 1 1
 
--- | Convertts serial value into datetime according to the specified
--- date base
+-- | Converts serial value into datetime according to the specified
+-- date base. Because Excel treats 1900 as a leap year even though it isn't,
+-- this function converts any numbers that represent some time in /1900-02-29/
+-- in Excel to `UTCTime` /1900-03-01 00:00/.
+-- See https://docs.microsoft.com/en-gb/office/troubleshoot/excel/wrongly-assumes-1900-is-leap-year for details.
 --
 -- > show (dateFromNumber DateBase1900 42929.75) == "2017-07-13 18:00:00 UTC"
-dateFromNumber :: RealFrac t => DateBase -> t -> UTCTime
-dateFromNumber b d = UTCTime day diffTime
+-- > show (dateFromNumber DateBase1900 60) == "1900-03-01 00:00:00 UTC"
+-- > show (dateFromNumber DateBase1900 61) == "1900-03-01 00:00:00 UTC"
+dateFromNumber :: forall t. RealFrac t => DateBase -> t -> UTCTime
+dateFromNumber b d
+  -- 60 is Excel's 2020-02-29 00:00 and 61 is Excel's 2020-03-01
+  | b == DateBase1900 && d < 60            = getUTCTime (d + 1)
+  | b == DateBase1900 && d >= 60 && d < 61 = getUTCTime (61 :: t)
+  | otherwise                              = getUTCTime d
   where
-    (numberOfDays, fractionOfOneDay) = properFraction d
-    day = addDays numberOfDays $ baseDate b
-    diffTime = picosecondsToDiffTime (round (fractionOfOneDay * 24*60*60*1E12))
-
--- | Converts datetime into serial value
+    getUTCTime n =
+      let
+        (numberOfDays, fractionOfOneDay) = properFraction n
+        day = addDays numberOfDays $ baseDate b
+        diffTime = picosecondsToDiffTime (round (fractionOfOneDay * 24*60*60*1E12))
+      in
+        UTCTime day diffTime
+
+-- | Converts datetime into serial value.
+-- Because Excel treats 1900 as a leap year even though it isn't,
+-- the numbers that represent times in /1900-02-29/ in Excel, in the range /[60, 61[/,
+-- are never generated by this function for `DateBase1900`. This means that
+-- under those conditions this is not an inverse of `dateFromNumber`.
+-- See https://docs.microsoft.com/en-gb/office/troubleshoot/excel/wrongly-assumes-1900-is-leap-year for details.
 dateToNumber :: Fractional a => DateBase -> UTCTime -> a
 dateToNumber b (UTCTime day diffTime) = numberOfDays + fractionOfOneDay
   where
-    numberOfDays = fromIntegral (diffDays day $ baseDate b)
+    numberOfDays = fromIntegral (diffDays excel1900CorrectedDay $ baseDate b)
     fractionOfOneDay = realToFrac diffTime / (24 * 60 * 60)
+    marchFirst1900              = fromGregorian 1900 3 1
+    excel1900CorrectedDay = if day < marchFirst1900
+      then addDays (-1) day
+      else day
 
 {-------------------------------------------------------------------------------
   Parsing

test/CommonTests.hs

@@ -7,6 +7,8 @@ module CommonTests
   ) where
 
 import Data.Fixed (Pico, Fixed(..), E12)
+import Data.Time.Calendar (fromGregorian)
+import Data.Time.Clock (UTCTime(..))
 import Test.Tasty.SmallCheck (testProperty)
 import Test.SmallCheck.Series
        (Positive(..), Serial(..), newtypeCons, cons0, (\/))
@@ -22,18 +24,31 @@ tests =
     [ testProperty "col2int . int2col == id" $
         \(Positive i) -> i == col2int (int2col i)
     , testCase "date conversions" $ do
-        dateFromNumber DateBase1900 (- 2338.0) @?= read "1893-08-05 00:00:00 UTC"
-        dateFromNumber DateBase1900 2.0 @?= read "1900-01-01 00:00:00 UTC"
+        dateFromNumber DateBase1900 (- 2338.0) @?= read "1893-08-06 00:00:00 UTC"
+        dateFromNumber DateBase1900 2.0 @?= read "1900-01-02 00:00:00 UTC"
         dateFromNumber DateBase1900 3687.0 @?= read "1910-02-03 00:00:00 UTC"
         dateFromNumber DateBase1900 38749.0 @?= read "2006-02-01 00:00:00 UTC"
         dateFromNumber DateBase1900 2958465.0 @?= read "9999-12-31 00:00:00 UTC"
+        dateFromNumber DateBase1900 59.0 @?= read "1900-02-28 00:00:00 UTC"
+        dateFromNumber DateBase1900 59.5 @?= read "1900-02-28 12:00:00 UTC"
+        dateFromNumber DateBase1900 60.0 @?= read "1900-03-01 00:00:00 UTC"
+        dateFromNumber DateBase1900 60.5 @?= read "1900-03-01 00:00:00 UTC"
+        dateFromNumber DateBase1900 61 @?= read "1900-03-01 00:00:00 UTC"
+        dateFromNumber DateBase1900 61.5 @?= read "1900-03-01 12:00:00 UTC"
+        dateFromNumber DateBase1900 62 @?= read "1900-03-02 00:00:00 UTC"
         dateFromNumber DateBase1904 (-3800.0) @?= read "1893-08-05 00:00:00 UTC"
         dateFromNumber DateBase1904 0.0 @?= read "1904-01-01 00:00:00 UTC"
         dateFromNumber DateBase1904 2225.0 @?= read "1910-02-03 00:00:00 UTC"
         dateFromNumber DateBase1904 37287.0 @?= read "2006-02-01 00:00:00 UTC"
         dateFromNumber DateBase1904 2957003.0 @?= read "9999-12-31 00:00:00 UTC"
+     , testCase "Converting dates in the vicinity of 1900-03-01 to numbers" $ do
+        -- Note how the fact that 1900-02-29 exists for Excel forces us to skip 60
+        dateToNumber DateBase1900 (UTCTime (fromGregorian 1900 2 28) 0) @?= (59 :: Double)
+        dateToNumber DateBase1900 (UTCTime (fromGregorian 1900 3 1) 0) @?= (61 :: Double)
      , testProperty "dateToNumber . dateFromNumber == id" $
-       \b (n :: Pico) -> n == dateToNumber b (dateFromNumber b $ n)
+       -- Because excel treats 1900 as a leap year, dateToNumber and dateFromNumber
+       -- aren't inverses of each other in the range n E [60, 61[ for DateBase1900
+       \b (n :: Pico) -> (n >= 60 && n < 61 && b == DateBase1900) || n == dateToNumber b (dateFromNumber b $ n)
     ]
 
 instance Monad m => Serial m (Fixed E12) where