Replace Double in CellValue by Scientific

src/Codec/Xlsx/Parser.hs

@@ -336,7 +336,7 @@ extractSheetFast ar sst contentTypes caches wf = do
               Nothing -> throwError "bad shared string index"
           "inlineStr" -> mapM (fmap xlsxTextToCellValue . fromXenoNode) isNode
           "str" -> fmap CellText <$> vConverted
-          "n" -> fmap CellDouble <$> vConverted
+          "n" -> fmap CellDecimal <$> vConverted
           "b" -> fmap CellBool <$> vConverted
           "e" -> fmap CellError <$> vConverted
           unexpected ->
@@ -514,7 +514,7 @@ extractCellValue sst t cur
   | t == "inlineStr" =
     cur $/ element (n_ "is") >=> fmap xlsxTextToCellValue . fromCursor
   | t == "str" = CellText <$> vConverted "string"
-  | t == "n" = CellDouble <$> vConverted "double"
+  | t == "n" = CellDecimal <$> vConverted "scientific"
   | t == "b" = CellBool <$> vConverted "boolean"
   | t == "e" = CellError <$> vConverted "error"
   | otherwise = fail "bad cell value"

src/Codec/Xlsx/Parser/Internal.hs

@@ -33,6 +33,7 @@ import Data.Maybe
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Read as T
+import Data.Scientific (Scientific)
 import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
 import Text.XML
@@ -68,6 +69,9 @@ instance FromAttrVal Integer where
 instance FromAttrVal Double where
     fromAttrVal = T.rational
 
+instance FromAttrVal Scientific where
+    fromAttrVal = T.rational
+
 instance FromAttrVal Bool where
     fromAttrVal x | x == "1" || x == "true"  = readSuccess True
                   | x == "0" || x == "false" = readSuccess False

src/Codec/Xlsx/Parser/Internal/Fast.hs

@@ -43,6 +43,7 @@ import qualified Data.ByteString.Unsafe as SU
 import Data.Char (chr)
 import Data.Maybe
 import Data.Monoid ((<>))
+import Data.Scientific (Scientific)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -231,6 +232,10 @@ instance FromAttrBs Double where
   -- as for rationals
   fromAttrBs = first T.pack . eitherRational . T.decodeLatin1
 
+instance FromAttrBs Scientific where
+  -- as for rationals
+  fromAttrBs = first T.pack . eitherRational . T.decodeLatin1
+
 instance FromAttrBs Text where
   fromAttrBs = replaceEntititesBs
 

src/Codec/Xlsx/Parser/Internal/PivotTable.hs

@@ -11,6 +11,7 @@ import Control.Applicative
 import Data.ByteString.Lazy (ByteString)
 import Data.List (transpose)
 import Data.Maybe (listToMaybe, mapMaybe, maybeToList)
+import Data.Scientific (fromFloatDigits)
 import Data.Text (Text)
 import Safe (atMay)
 import Text.XML
@@ -105,5 +106,5 @@ fillCacheFieldsFromRecords fields recs =
         then field {cfItems = mapMaybe recToCellValue recVals}
         else field
     recToCellValue (CacheText t) = Just $ CellText t
-    recToCellValue (CacheNumber n) = Just $ CellDouble n
+    recToCellValue (CacheNumber n) = Just $ CellDecimal (fromFloatDigits n)
     recToCellValue (CacheIndex _) = Nothing

src/Codec/Xlsx/Parser/Internal/Util.hs

@@ -24,7 +24,7 @@ eitherDecimal t = case T.signed T.decimal t of
 rational :: (MonadFail m) => Text -> m Double
 rational = fromEither . eitherRational
 
-eitherRational :: Text -> Either String Double
+eitherRational :: Fractional a => Text -> Either String a
 eitherRational t = case T.signed T.rational t of
   Right (r, leftover) | T.null leftover -> Right r
   _ -> Left $ "invalid rational: " ++ show t

src/Codec/Xlsx/Parser/Stream.hs

@@ -526,7 +526,7 @@ parseValue sstrings txt = \case
     string <- maybe (Left $ SharedStringsNotFound idx sstrings) Right $ {-# SCC "sstrings_lookup_scc" #-}  (sstrings ^? ix idx)
     Right $ CellText string
   TStr -> pure $ CellText txt
-  TN -> bimap (ReadError txt) (CellDouble . fst) $ Read.double txt
+  TN -> bimap (ReadError txt) (CellDecimal . fst) $ Read.rational txt
   TE -> bimap (ReadError txt) (CellError . fst) $ fromAttrVal txt
   TB | txt == "1" -> Right $ CellBool True
      | txt == "0" -> Right $ CellBool False

src/Codec/Xlsx/Types/Common.hs

@@ -6,6 +6,8 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Codec.Xlsx.Types.Common
   ( CellRef(..)
@@ -39,6 +41,7 @@ module Codec.Xlsx.Types.Common
   , xlsxTextToCellValue
   , Formula(..)
   , CellValue(..)
+  , pattern CellDouble
   , ErrorType(..)
   , DateBase(..)
   , dateFromNumber
@@ -51,7 +54,7 @@ module Codec.Xlsx.Types.Common
   , _XlsxText
   , _XlsxRichText
   , _CellText
-  , _CellDouble
+  , _CellDecimal
   , _CellBool
   , _CellRich
   , _CellError
@@ -72,6 +75,7 @@ import Data.Maybe (isJust, fromMaybe)
 import Data.Function ((&))
 import Data.Ix (inRange)
 import qualified Data.Map as Map
+import Data.Scientific (Scientific,toRealFloat,fromFloatDigits)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -411,12 +415,19 @@ instance NFData Formula
 -- - 18.18.11 ST_CellType (Cell Type)
 data CellValue
   = CellText Text
-  | CellDouble Double
+  | CellDecimal Scientific
   | CellBool Bool
   | CellRich [RichTextRun]
   | CellError ErrorType
   deriving (Eq, Ord, Show, Generic)
 
+viewCellDouble :: CellValue -> Maybe Double
+viewCellDouble (CellDecimal s) = Just (toRealFloat s)
+viewCellDouble _ = Nothing 
+
+-- view pattern, since 'CellDecimal' has replaced the old constructor.
+pattern CellDouble :: Double -> CellValue
+pattern CellDouble b <- (viewCellDouble -> Just b)
 
 instance NFData CellValue
 
@@ -679,7 +690,7 @@ _CellText
 {-# INLINE _CellText #-}
 _CellDouble :: Prism' CellValue Double
 _CellDouble
-  = (prism (\ x1_a1ZQy -> CellDouble x1_a1ZQy))
+  = (prism (\ x1_a1ZQy -> CellDecimal (fromFloatDigits x1_a1ZQy)))
       (\ x_a1ZQz
          -> case x_a1ZQz of
               CellDouble y1_a1ZQA -> Right y1_a1ZQA

src/Codec/Xlsx/Types/PivotTable/Internal.hs

@@ -55,7 +55,7 @@ instance FromCursor CacheField where
 cellValueFromNode :: Node -> [CellValue]
 cellValueFromNode n
   | n `nodeElNameIs` (n_ "s") = CellText <$> attributeV
-  | n `nodeElNameIs` (n_ "n") = CellDouble <$> attributeV
+  | n `nodeElNameIs` (n_ "n") = CellDecimal <$> attributeV
   | otherwise = fail "no matching shared item"
   where
     cur = fromNode n

xlsx.cabal

@@ -105,6 +105,7 @@ Library
                    , network-uri
                    , old-locale   >= 1.0.0.5
                    , safe         >= 0.3
+                   , scientific
                    , text         >= 0.11.3.1
                    , time         >= 1.4.0.1
                    , transformers >= 0.3.0.0