diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,8 @@ +0.7.1 +----- +* improved compatibility with Excel in pivot cache serialization +* added support for character references in fast parsing with `xeno` + 0.7.0 ----- * fixed serialization of large integer values (thanks Radoslav Dorcik diff --git a/src/Codec/Xlsx/Formatted.hs b/src/Codec/Xlsx/Formatted.hs --- a/src/Codec/Xlsx/Formatted.hs +++ b/src/Codec/Xlsx/Formatted.hs @@ -6,6 +6,7 @@ module Codec.Xlsx.Formatted ( FormattedCell(..) , Formatted(..) + , Format(..) , formatted , toFormattedCells , CondFormatted(..) diff --git a/src/Codec/Xlsx/Parser.hs b/src/Codec/Xlsx/Parser.hs --- a/src/Codec/Xlsx/Parser.hs +++ b/src/Codec/Xlsx/Parser.hs @@ -78,9 +78,12 @@ type Parser = Either ParseError -- | Reads `Xlsx' from raw data (lazy bytestring) using @xeno@ library --- using some "cheating" +-- using some "cheating": +-- -- * not doing 100% xml validation --- * replacing only basic XML enttities +-- * replacing only +-- and +-- (without checking codepoint validity) -- * almost not using XML namespaces toXlsxFast :: L.ByteString -> Xlsx toXlsxFast = either (error . show) id . toXlsxEitherFast @@ -639,10 +642,20 @@ path <- lookupRelPath wbPath wbRels rId bs <- note (MissingFile path) $ Zip.fromEntry <$> Zip.findEntryByPath path ar - sources <- + (sheet, ref, fields0, mRecRId) <- note (InconsistentXlsx $ "Bad pivot table cache in " <> T.pack path) $ parseCache bs - return (cacheId, sources) + fields <- case mRecRId of + Just recId -> do + cacheRels <- getRels ar path + recsPath <- lookupRelPath path cacheRels recId + rCur <- xmlCursorRequired ar recsPath + let recs = rCur $/ element (n_ "r") >=> \cur' -> + return $ cur' $/ anyElement >=> recordValueFromNode . node + return $ fillCacheFieldsFromRecords fields0 recs + Nothing -> + return fields0 + return $ (cacheId, (sheet, ref, fields)) let dateBase = bool DateBase1900 DateBase1904 . fromMaybe False . listToMaybe $ cur $/ element (n_ "workbookPr") >=> fromAttribute "date1904" return (sheets, DefinedNames names, caches, dateBase) diff --git a/src/Codec/Xlsx/Parser/Internal/Fast.hs b/src/Codec/Xlsx/Parser/Internal/Fast.hs --- a/src/Codec/Xlsx/Parser/Internal/Fast.hs +++ b/src/Codec/Xlsx/Parser/Internal/Fast.hs @@ -35,9 +35,11 @@ import Control.Arrow (second) import Control.Exception (Exception, throw) import Control.Monad (ap, forM, join, liftM) +import Data.Bits ((.|.), shiftL) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as SU +import Data.Char (chr) import Data.Maybe import Data.Monoid import Data.Text (Text) @@ -277,9 +279,36 @@ && s_index this 2 == 111 -- o && s_index this 3 == 115 -- s -> return 39 -- '\'' + | s_index this 0 == 35 -- '#' + -> + if s_index this 1 == 120 -- 'x' + then toEnum <$> checkHexadecimal (index + 2) (len - 2) + else toEnum <$> checkDecimal (index + 1) (len - 1) | otherwise -> Left $ "Bad entity " <> T.pack (show $ (substring str (index-1) (index+len+1))) where this = BS.drop index str + checkDecimal index len = BS.foldl' go (Right 0) (substring str index (index + len)) + where + go :: Either Text Int -> Word8 -> Either Text Int + go prev c = do + a <- prev + if c >= 48 && c <= 57 + then return $ a * 10 + fromIntegral (c - 48) + else Left $ "Expected decimal digit but encountered " <> T.pack (show (chr $ fromIntegral c)) + checkHexadecimal index len = BS.foldl' go (Right 0) (substring str index (index + len)) + where + go :: Either Text Int -> Word8 -> Either Text Int + go prev c = do + a <- prev + if | c >= 48 && c <= 57 + -> return $ (a `shiftL` 4) .|. fromIntegral (c - 48) + | c >= 97 && c <= 122 + -> return $ (a `shiftL` 4) .|. fromIntegral (c - 87) + | c >= 65 && c <= 90 + -> return $ (a `shiftL` 4) .|. fromIntegral (c - 55) + | otherwise + -> + Left $ "Expected hexadecimal digit but encountered " <> T.pack (show (chr $ fromIntegral c)) ampersand = 38 semicolon = 59 diff --git a/src/Codec/Xlsx/Parser/Internal/PivotTable.hs b/src/Codec/Xlsx/Parser/Internal/PivotTable.hs --- a/src/Codec/Xlsx/Parser/Internal/PivotTable.hs +++ b/src/Codec/Xlsx/Parser/Internal/PivotTable.hs @@ -4,11 +4,13 @@ module Codec.Xlsx.Parser.Internal.PivotTable ( parsePivotTable , parseCache + , fillCacheFieldsFromRecords ) where import Control.Applicative import Data.ByteString.Lazy (ByteString) -import Data.Maybe (listToMaybe, maybeToList) +import Data.List (transpose) +import Data.Maybe (listToMaybe, mapMaybe, maybeToList) import Data.Text (Text) import Safe (atMay) import Text.XML @@ -16,6 +18,8 @@ import Codec.Xlsx.Parser.Internal import Codec.Xlsx.Types.Common +import Codec.Xlsx.Types.Internal +import Codec.Xlsx.Types.Internal.Relationships (odr) import Codec.Xlsx.Types.PivotTable import Codec.Xlsx.Types.PivotTable.Internal @@ -79,14 +83,27 @@ FieldPosition <$> fieldNameList n return PivotTable {..} -parseCache :: ByteString -> Maybe (Text, CellRef, [CacheField]) +parseCache :: ByteString -> Maybe (Text, CellRef, [CacheField], Maybe RefId) parseCache bs = listToMaybe . parse . fromDocument $ parseLBS_ def bs where parse cur = do + refId <- maybeAttribute (odr "id") cur (sheet, ref) <- cur $/ element (n_ "cacheSource") &/ element (n_ "worksheetSource") >=> liftA2 (,) <$> attribute "sheet" <*> fromAttribute "ref" let fields = cur $/ element (n_ "cacheFields") &/ element (n_ "cacheField") >=> fromCursor - return (sheet, ref, fields) + return (sheet, ref, fields, refId) + +fillCacheFieldsFromRecords :: [CacheField] -> [CacheRecord] -> [CacheField] +fillCacheFieldsFromRecords fields recs = + zipWith addValues fields (transpose recs) + where + addValues field recVals = + if null (cfItems field) + then field {cfItems = mapMaybe recToCellValue recVals} + else field + recToCellValue (CacheText t) = Just $ CellText t + recToCellValue (CacheNumber n) = Just $ CellDouble n + recToCellValue (CacheIndex _) = Nothing diff --git a/src/Codec/Xlsx/Types/Internal.hs b/src/Codec/Xlsx/Types/Internal.hs --- a/src/Codec/Xlsx/Types/Internal.hs +++ b/src/Codec/Xlsx/Types/Internal.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Codec.Xlsx.Types.Internal where import Control.Arrow +import Data.Monoid ((<>)) import Data.Text (Text) import GHC.Generics (Generic) @@ -18,3 +20,6 @@ instance FromAttrBs RefId where fromAttrBs = fmap RefId . fromAttrBs + +unsafeRefId :: Int -> RefId +unsafeRefId num = RefId $ "rId" <> txti num diff --git a/src/Codec/Xlsx/Types/PivotTable/Internal.hs b/src/Codec/Xlsx/Types/PivotTable/Internal.hs --- a/src/Codec/Xlsx/Types/PivotTable/Internal.hs +++ b/src/Codec/Xlsx/Types/PivotTable/Internal.hs @@ -4,12 +4,16 @@ module Codec.Xlsx.Types.PivotTable.Internal ( CacheId(..) , CacheField(..) + , CacheRecordValue(..) + , CacheRecord + , recordValueFromNode ) where import GHC.Generics (Generic) import Control.Arrow (first) import Data.Maybe (catMaybes) +import Data.Text (Text) import Text.XML import Text.XML.Cursor @@ -25,6 +29,14 @@ , cfItems :: [CellValue] } deriving (Eq, Show, Generic) +data CacheRecordValue + = CacheText Text + | CacheNumber Double + | CacheIndex Int + deriving (Eq, Show, Generic) + +type CacheRecord = [CacheRecordValue] + {------------------------------------------------------------------------------- Parsing -------------------------------------------------------------------------------} @@ -50,6 +62,17 @@ attributeV :: FromAttrVal a => [a] attributeV = fromAttribute "v" cur +recordValueFromNode :: Node -> [CacheRecordValue] +recordValueFromNode n + | n `nodeElNameIs` (n_ "s") = CacheText <$> attributeV + | n `nodeElNameIs` (n_ "n") = CacheNumber <$> attributeV + | n `nodeElNameIs` (n_ "x") = CacheIndex <$> attributeV + | otherwise = fail "not valid cache record value" + where + cur = fromNode n + attributeV :: FromAttrVal a => [a] + attributeV = fromAttribute "v" cur + {------------------------------------------------------------------------------- Rendering -------------------------------------------------------------------------------} @@ -58,7 +81,9 @@ toElement nm CacheField {..} = elementList nm ["name" .= cfName] [sharedItems] where - sharedItems = elementList "sharedItems" typeAttrs $ map cvToItem cfItems + -- Excel doesn't like embedded integer sharedImes in cache + sharedItems = elementList "sharedItems" typeAttrs $ + if containsString then map cvToItem cfItems else [] cvToItem (CellText t) = leafElement "s" ["v" .= t] cvToItem (CellDouble n) = leafElement "n" ["v" .= n] cvToItem _ = error "Only string and number values are currently supported" diff --git a/src/Codec/Xlsx/Writer.hs b/src/Codec/Xlsx/Writer.hs --- a/src/Codec/Xlsx/Writer.hs +++ b/src/Codec/Xlsx/Writer.hs @@ -156,9 +156,6 @@ modifySTRef' r (+1) return (unsafeRefId num) -unsafeRefId :: Int -> RefId -unsafeRefId num = RefId $ "rId" <> txti num - sheetDataXml :: Cells -> Map Int RowProperties @@ -350,6 +347,20 @@ (smlCT "pivotCacheDefinition") "pivotCacheDefinition" pvtfCacheDefinition + recordsPath = + "xl/pivotCache/pivotCacheRecords" <> cacheIdStr <> ".xml" + recordsFile = + FileData + recordsPath + (smlCT "pivotCacheRecords") + "pivotCacheRecords" + pvtfCacheRecords + cacheRelsFile = + FileData + ("xl/pivotCache/_rels/pivotCacheDefinition" <> cacheIdStr <> ".xml.rels") + relsCT + "relationships" $ + renderRels [refFileDataToRel cachePath (unsafeRefId 1, recordsFile)] renderRels = renderLBS def . toDocument . Relationships.fromList tablePath = "xl/pivotTables/pivotTable" <> cacheIdStr <> ".xml" tableFile = @@ -360,7 +371,7 @@ relsCT "relationships" $ renderRels [refFileDataToRel tablePath (unsafeRefId 1, cacheFile)] - in ((cacheId, cacheFile), tableFile, [tableRels]) + in ((cacheId, cacheFile), tableFile, [tableRels, cacheRelsFile, recordsFile]) genTable :: Table -> Int -> FileData genTable tbl tblId = FileData{..} diff --git a/src/Codec/Xlsx/Writer/Internal.hs b/src/Codec/Xlsx/Writer/Internal.hs --- a/src/Codec/Xlsx/Writer/Internal.hs +++ b/src/Codec/Xlsx/Writer/Internal.hs @@ -38,15 +38,14 @@ , justFalse ) where +import qualified Data.Map as Map +import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder.Int import Data.Text.Lazy.Builder.RealFloat - -import qualified Data.Map as Map -import Data.String (fromString) import Text.XML {------------------------------------------------------------------------------- diff --git a/src/Codec/Xlsx/Writer/Internal/PivotTable.hs b/src/Codec/Xlsx/Writer/Internal/PivotTable.hs --- a/src/Codec/Xlsx/Writer/Internal/PivotTable.hs +++ b/src/Codec/Xlsx/Writer/Internal/PivotTable.hs @@ -7,6 +7,7 @@ ) where import Data.ByteString.Lazy (ByteString) +import Data.List (elemIndex, transpose) import Data.List.Extra (nubOrd) import qualified Data.Map as M import Data.Maybe (catMaybes, fromMaybe, mapMaybe) @@ -17,6 +18,8 @@ import Codec.Xlsx.Types.Cell import Codec.Xlsx.Types.Common +import Codec.Xlsx.Types.Internal +import Codec.Xlsx.Types.Internal.Relationships (odr) import Codec.Xlsx.Types.PivotTable import Codec.Xlsx.Types.PivotTable.Internal import Codec.Xlsx.Writer.Internal @@ -24,6 +27,7 @@ data PivotTableFiles = PivotTableFiles { pvtfTable :: ByteString , pvtfCacheDefinition :: ByteString + , pvtfCacheRecords :: ByteString } deriving (Eq, Show, Generic) data CacheDefinition = CacheDefinition @@ -37,7 +41,9 @@ where pvtfTable = renderLBS def $ ptDefinitionDocument cacheId cache t cache = generateCache cm t - pvtfCacheDefinition = renderLBS def $ toDocument cache + (cacheDoc, cacheRecordsDoc) = writeCache cache + pvtfCacheDefinition = renderLBS def cacheDoc + pvtfCacheRecords = renderLBS def cacheRecordsDoc ptDefinitionDocument :: Int -> CacheDefinition -> PivotTable -> Document ptDefinitionDocument cacheId cache t = @@ -157,15 +163,13 @@ let values = mapMaybe (\r -> getCellValue (r, c)) [(r1 + 1) .. r2] return (PivotFieldName nm, nubOrd values) -instance ToDocument CacheDefinition where - toDocument = - documentFromElement "Pivot cache definition generated by xlsx" . - toElement "pivotCacheDefinition" - -instance ToElement CacheDefinition where - toElement nm CacheDefinition {..} = elementList nm attrs elements +writeCache :: CacheDefinition -> (Document, Document) +writeCache CacheDefinition {..} = (cacheDefDoc, cacheRecordsDoc) where - attrs = ["invalid" .= True, "refreshOnLoad" .= True] + cacheDefDoc = + documentFromElement "Pivot cache definition generated by xlsx" $ + elementList "pivotCacheDefinition" attrs elements + attrs = ["invalid" .= True, "refreshOnLoad" .= True, odr "id" .= unsafeRefId 1] elements = [worksheetSource, cacheFields] worksheetSource = elementList @@ -177,3 +181,24 @@ ] cacheFields = elementListSimple "cacheFields" $ map (toElement "cacheField") cdFields + cacheRecordsDoc = + documentFromElement "Pivot cache records generated by xlsx" . + elementListSimple "pivotCacheRecords" $ + map (elementListSimple "r" . map recordValueToEl) cacheRecords + recordValueToEl (CacheText t) = leafElement "s" ["v" .= t] + recordValueToEl (CacheNumber n) = leafElement "n" ["v" .= n] + recordValueToEl (CacheIndex i) = leafElement "x" ["v" .= i] + cacheRecords = transpose $ map (itemsToRecordValues . cfItems) cdFields + itemsToRecordValues vals = + if all isText vals + then indexes vals + else map itemToRecordValue vals + isText (CellText _) = True + isText _ = False + indexes vals = + [ CacheIndex . fromJustNote "inconsistend definition" $ elemIndex v vals + | v <- vals + ] + itemToRecordValue (CellDouble d) = CacheNumber d + itemToRecordValue (CellText t) = CacheText t + itemToRecordValue v = error $ "Unsupported value for pivot tables: " ++ show v diff --git a/test/PivotTableTests.hs b/test/PivotTableTests.hs --- a/test/PivotTableTests.hs +++ b/test/PivotTableTests.hs @@ -18,6 +18,7 @@ import Codec.Xlsx import Codec.Xlsx.Parser.Internal.PivotTable +import Codec.Xlsx.Types.Internal (unsafeRefId) import Codec.Xlsx.Types.PivotTable.Internal import Codec.Xlsx.Writer.Internal.PivotTable @@ -38,7 +39,14 @@ ref = CellRef "A1:D5" forCacheId (CacheId 3) = Just (sheetName, ref, testPivotCacheFields) forCacheId _ = Nothing - Just (sheetName, ref, testPivotCacheFields) @==? + -- fields with numeric values go into cache records + testPivotCacheFields' = + [ if cfName cf == PivotFieldName "Color" + then cf + else cf {cfItems = []} + | cf <- testPivotCacheFields + ] + Just (sheetName, ref, testPivotCacheFields', Just (unsafeRefId 1)) @==? parseCache testPivotCacheDefinition Just testPivotTable @==? parsePivotTable forCacheId testPivotTableDefinition @@ -145,6 +153,7 @@ testPivotCacheDefinition = [r| @@ -157,19 +166,13 @@ - - - + - - - + - - - + diff --git a/xlsx.cabal b/xlsx.cabal --- a/xlsx.cabal +++ b/xlsx.cabal @@ -1,6 +1,6 @@ Name: xlsx -Version: 0.7.0 +Version: 0.7.1 Synopsis: Simple and incomplete Excel file parser/writer Description: