diff --git a/src/Codec/Xlsx/Parser.hs b/src/Codec/Xlsx/Parser.hs index 7409c533..91f6c7b4 100644 --- a/src/Codec/Xlsx/Parser.hs +++ b/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" diff --git a/src/Codec/Xlsx/Parser/Internal.hs b/src/Codec/Xlsx/Parser/Internal.hs index 3484fb04..cd073335 100644 --- a/src/Codec/Xlsx/Parser/Internal.hs +++ b/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 diff --git a/src/Codec/Xlsx/Parser/Internal/Fast.hs b/src/Codec/Xlsx/Parser/Internal/Fast.hs index 85b3f9ce..07f6854e 100644 --- a/src/Codec/Xlsx/Parser/Internal/Fast.hs +++ b/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 diff --git a/src/Codec/Xlsx/Parser/Internal/PivotTable.hs b/src/Codec/Xlsx/Parser/Internal/PivotTable.hs index dbbba83a..5063de2e 100644 --- a/src/Codec/Xlsx/Parser/Internal/PivotTable.hs +++ b/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 diff --git a/src/Codec/Xlsx/Parser/Internal/Util.hs b/src/Codec/Xlsx/Parser/Internal/Util.hs index 70bb3585..5c95be9b 100644 --- a/src/Codec/Xlsx/Parser/Internal/Util.hs +++ b/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 diff --git a/src/Codec/Xlsx/Parser/Stream.hs b/src/Codec/Xlsx/Parser/Stream.hs index 58e89fe2..b52e9282 100644 --- a/src/Codec/Xlsx/Parser/Stream.hs +++ b/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 diff --git a/src/Codec/Xlsx/Types/Common.hs b/src/Codec/Xlsx/Types/Common.hs index 1ad8208e..68f84cd6 100644 --- a/src/Codec/Xlsx/Types/Common.hs +++ b/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,21 @@ 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) +{-# COMPLETE CellText, CellDecimal, CellBool, CellRich, CellError #-} +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) +{-# COMPLETE CellText, CellDouble, CellBool, CellRich, CellError #-} instance NFData CellValue @@ -677,9 +690,17 @@ _CellText CellText y1_a1ZQx -> Right y1_a1ZQx _ -> Left x_a1ZQw) {-# INLINE _CellText #-} +_CellDecimal :: Prism' CellValue Scientific +_CellDecimal + = (prism (\ x1_a1ZQy -> CellDecimal x1_a1ZQy)) + (\ x_a1ZQz + -> case x_a1ZQz of + CellDecimal y1_a1ZQA -> Right y1_a1ZQA + _ -> Left x_a1ZQz) +{-# INLINE _CellDecimal #-} _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 diff --git a/src/Codec/Xlsx/Types/PivotTable/Internal.hs b/src/Codec/Xlsx/Types/PivotTable/Internal.hs index 7f6d8dae..b68d95fa 100644 --- a/src/Codec/Xlsx/Types/PivotTable/Internal.hs +++ b/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 diff --git a/test/Main.hs b/test/Main.hs index 41ebc225..71a2a167 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -117,10 +117,10 @@ floatsParsingTests parser = do let xlsx = parser bs parsedCells = maybe mempty (_wsCells . snd) $ listToMaybe $ xlsx ^. xlSheets expectedCells = M.fromList - [ ((1,1), def & cellValue ?~ CellDouble 12.0) - , ((2,1), def & cellValue ?~ CellDouble 13.0) - , ((3,1), def & cellValue ?~ CellDouble 14.0 & cellStyle ?~ 1) - , ((4,1), def & cellValue ?~ CellDouble 15.0) + [ ((1,1), def & cellValue ?~ CellDecimal 12.0) + , ((2,1), def & cellValue ?~ CellDecimal 13.0) + , ((3,1), def & cellValue ?~ CellDecimal 14.0 & cellStyle ?~ 1) + , ((4,1), def & cellValue ?~ CellDecimal 15.0) ] expectedCells @==? parsedCells diff --git a/test/PivotTableTests.hs b/test/PivotTableTests.hs index 974f965c..5bddf0e0 100644 --- a/test/PivotTableTests.hs +++ b/test/PivotTableTests.hs @@ -106,10 +106,10 @@ testPivotSrcCells = where cellMap = [ [CellText "Color", CellText "Year", CellText "Price", CellText "Count"] - , [CellText "green", CellDouble 2012, CellDouble 12.23, CellDouble 17] - , [CellText "white", CellDouble 2011, CellDouble 73.99, CellDouble 21] - , [CellText "red", CellDouble 2012, CellDouble 10.19, CellDouble 172] - , [CellText "white", CellDouble 2012, CellDouble 34.99, CellDouble 49] + , [CellText "green", CellDecimal 2012, CellDecimal 12.23, CellDecimal 17] + , [CellText "white", CellDecimal 2011, CellDecimal 73.99, CellDecimal 21] + , [CellText "red", CellDecimal 2012, CellDecimal 10.19, CellDecimal 172] + , [CellText "white", CellDecimal 2012, CellDecimal 34.99, CellDecimal 49] ] testPivotCacheFields :: [CacheField] @@ -117,13 +117,13 @@ testPivotCacheFields = [ CacheField (PivotFieldName "Color") [CellText "green", CellText "white", CellText "red"] - , CacheField (PivotFieldName "Year") [CellDouble 2012, CellDouble 2011] + , CacheField (PivotFieldName "Year") [CellDecimal 2012, CellDecimal 2011] , CacheField (PivotFieldName "Price") - [CellDouble 12.23, CellDouble 73.99, CellDouble 10.19, CellDouble 34.99] + [CellDecimal 12.23, CellDecimal 73.99, CellDecimal 10.19, CellDecimal 34.99] , CacheField (PivotFieldName "Count") - [CellDouble 17, CellDouble 21, CellDouble 172, CellDouble 49] + [CellDecimal 17, CellDecimal 21, CellDecimal 172, CellDecimal 49] ] testPivotTableDefinition :: ByteString diff --git a/test/StreamTests.hs b/test/StreamTests.hs index aad1268d..d88bb319 100644 --- a/test/StreamTests.hs +++ b/test/StreamTests.hs @@ -160,7 +160,7 @@ smallWorkbook = def & atSheet "Sheet1" ?~ sheet [((row,1), a1) , ((row,2), def & cellValue ?~ CellText ("text at B"<> tshow row <> " Sheet1")) , ((row,3), def & cellValue ?~ CellText "text at C1 Sheet1") - , ((row,4), def & cellValue ?~ CellDouble (0.2 + 0.1)) + , ((row,4), def & cellValue ?~ CellDecimal (0.2 + 0.1)) , ((row,5), def & cellValue ?~ CellBool False) ] -- sheets = [("Sheet1" , toWs $ [1..2] >>= \row -> @@ -170,7 +170,7 @@ smallWorkbook = def & atSheet "Sheet1" ?~ sheet -- , ((RowIndex row, ColumnIndex 3), -- def & cellValue ?~ CellText "text at C1 Sheet1") -- , ((RowIndex row, ColumnIndex 4), --- def & cellValue ?~ CellDouble (0.2 + 0.1)) +-- def & cellValue ?~ CellDecimal (0.2 + 0.1)) -- , ((RowIndex row, ColumnIndex 5), -- def & cellValue ?~ CellBool False) -- ] @@ -224,13 +224,13 @@ untypedCellsAreParsedAsFloats = do -- as numbers explicitly in `t` attribute. items <- runXlsxM "data/floats.xlsx" $ collectItems $ makeIndex 1 let expected = - [ IM.fromList [ (1, def & cellValue ?~ CellDouble 12.0) ] - , IM.fromList [ (1, def & cellValue ?~ CellDouble 13.0) ] + [ IM.fromList [ (1, def & cellValue ?~ CellDecimal 12.0) ] + , IM.fromList [ (1, def & cellValue ?~ CellDecimal 13.0) ] -- cell below has explicit `Numeric` type, while others are all `General`, -- but sometimes excel does not add a `t="n"` attr even to numeric cells -- but it should be default as number in any cases if `t` is missing - , IM.fromList [ (1, def & cellValue ?~ CellDouble 14.0 & cellStyle ?~ 1 ) ] - , IM.fromList [ (1, def & cellValue ?~ CellDouble 15.0) ] + , IM.fromList [ (1, def & cellValue ?~ CellDecimal 14.0 & cellStyle ?~ 1 ) ] + , IM.fromList [ (1, def & cellValue ?~ CellDecimal 15.0) ] ] expected @==? (_ri_cell_row . _si_row <$> items) diff --git a/test/TestXlsx.hs b/test/TestXlsx.hs index 1ca4bb77..e029311b 100644 --- a/test/TestXlsx.hs +++ b/test/TestXlsx.hs @@ -146,16 +146,16 @@ testCellMap1 = M.fromList [ ((1, 2), cd1_2), ((1, 5), cd1_5), ((1, 10), cd1_10) where cd v = def {_cellValue=Just v} cd1_2 = cd (CellText "just a text, fließen, русский <> и & \"in quotes\"") - cd1_5 = cd (CellDouble 42.4567) + cd1_5 = cd (CellDecimal 42.4567) cd1_10 = cd (CellText "") cd3_1 = cd (CellText "another text") cd3_2 = def -- shouldn't it be skipped? cd3_3 = def & cellValue ?~ CellError ErrorDiv0 & cellFormula ?~ simpleCellFormula "1/0" cd3_7 = cd (CellBool True) - cd4_1 = cd (CellDouble 1) - cd4_2 = cd (CellDouble 123456789012345) - cd4_3 = (cd (CellDouble (1+2))) { _cellFormula = + cd4_1 = cd (CellDecimal 1) + cd4_2 = cd (CellDecimal 123456789012345) + cd4_3 = (cd (CellDecimal (1+2))) { _cellFormula = Just $ simpleCellFormula "A4+B4<>11" } cd5_1 = def & cellFormula ?~ sharedFormulaByIndex (SharedFormulaIndex 0) @@ -169,16 +169,16 @@ cellRangeDvSourceMap = M.fromList [ ((1, 1), def & cellValue ?~ CellText "A-A-A" , ((2, 1), def & cellValue ?~ CellText "B-B-B") , ((1, 2), def & cellValue ?~ CellText "C-C-C") , ((2, 2), def & cellValue ?~ CellText "D-D-D") - , ((1, 3), def & cellValue ?~ CellDouble 6) - , ((2, 3), def & cellValue ?~ CellDouble 7) - , ((3, 1), def & cellValue ?~ CellDouble 5) + , ((1, 3), def & cellValue ?~ CellDecimal 6) + , ((2, 3), def & cellValue ?~ CellDecimal 7) + , ((3, 1), def & cellValue ?~ CellDecimal 5) , ((3, 2), def & cellValue ?~ CellText "numbers!") - , ((3, 3), def & cellValue ?~ CellDouble 5) + , ((3, 3), def & cellValue ?~ CellDecimal 5) ] testCellMap2 :: CellMap testCellMap2 = M.fromList [ ((1, 2), def & cellValue ?~ CellText "something here") - , ((3, 5), def & cellValue ?~ CellDouble 123.456) + , ((3, 5), def & cellValue ?~ CellDecimal 123.456) , ((2, 4), def & cellValue ?~ CellText "value" & cellComment ?~ comment1 @@ -401,12 +401,12 @@ testFormattedResult = Formatted cm styleSheet merges , _cellFormula = Nothing } cell12 = Cell { _cellStyle = Just 2 - , _cellValue = Just (CellDouble 1.23) + , _cellValue = Just (CellDecimal 1.23) , _cellComment = Nothing , _cellFormula = Nothing } cell25 = Cell { _cellStyle = Just 3 - , _cellValue = Just (CellDouble 1.23456) + , _cellValue = Just (CellDecimal 1.23456) , _cellComment = Nothing , _cellFormula = Nothing } merges = [] @@ -441,10 +441,10 @@ testRunFormatted = formatted formattedCellMap minimalStyleSheet & fontName ?~ "Calibri" at (1, 1) ?= (def & formattedCell . cellValue ?~ CellText "text at A1" & formattedFormat . formatFont ?~ font1) - at (1, 2) ?= (def & formattedCell . cellValue ?~ CellDouble 1.23 + at (1, 2) ?= (def & formattedCell . cellValue ?~ CellDecimal 1.23 & formattedFormat . formatFont . non def . fontItalic ?~ True & formattedFormat . formatNumberFormat ?~ fmtDecimalsZeroes 4) - at (2, 5) ?= (def & formattedCell . cellValue ?~ CellDouble 1.23456 + at (2, 5) ?= (def & formattedCell . cellValue ?~ CellDecimal 1.23456 & formattedFormat . formatNumberFormat ?~ StdNumberFormat Nf2Decimal) testFormatWorkbookResult :: Xlsx @@ -456,7 +456,7 @@ testFormatWorkbookResult = def & xlSheets .~ sheets , _cellComment = Nothing , _cellFormula = Nothing })] cellMap2 = M.fromList [((2, 3), Cell { _cellStyle = Just 1 - , _cellValue = Just (CellDouble 1.23456) + , _cellValue = Just (CellDecimal 1.23456) , _cellComment = Nothing , _cellFormula = Nothing })] sheets = [ ("Sheet1", def & wsCells .~ cellMap1) , ("Sheet2", def & wsCells .~ cellMap2) ] @@ -476,7 +476,7 @@ testFormatWorkbook = formatWorkbook sheets minimalStyleSheet sheetNames = ["Sheet1", "Sheet2"] testFormattedCellMap1 = M.fromList [((1,1), (def & formattedCell . cellValue ?~ CellText "text at A1 Sheet1"))] - testFormattedCellMap2 = M.fromList [((2,3), (def & formattedCell . cellValue ?~ CellDouble 1.23456 + testFormattedCellMap2 = M.fromList [((2,3), (def & formattedCell . cellValue ?~ CellDecimal 1.23456 & formattedFormat . formatNumberFormat ?~ (UserNumberFormat "DD.MM.YYYY")))] sheets = zip sheetNames [testFormattedCellMap1, testFormattedCellMap2] diff --git a/xlsx.cabal b/xlsx.cabal index b256d2ff..c467f59e 100644 --- a/xlsx.cabal +++ b/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