packages feed

xlsx 0.7.0 → 0.7.1

raw patch · 12 files changed

+168/−35 lines, 12 files

Files

CHANGELOG.markdown view
@@ -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
src/Codec/Xlsx/Formatted.hs view
@@ -6,6 +6,7 @@ module Codec.Xlsx.Formatted   ( FormattedCell(..)   , Formatted(..)+  , Format(..)   , formatted   , toFormattedCells   , CondFormatted(..)
src/Codec/Xlsx/Parser.hs view
@@ -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 <https://www.w3.org/TR/REC-xml/#sec-predefined-ent predefined entities>+--   and <https://www.w3.org/TR/REC-xml/#NT-CharRef Unicode character references>+--   (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)
src/Codec/Xlsx/Parser/Internal/Fast.hs view
@@ -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
src/Codec/Xlsx/Parser/Internal/PivotTable.hs view
@@ -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
src/Codec/Xlsx/Types/Internal.hs view
@@ -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
src/Codec/Xlsx/Types/PivotTable/Internal.hs view
@@ -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"
src/Codec/Xlsx/Writer.hs view
@@ -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{..}
src/Codec/Xlsx/Writer/Internal.hs view
@@ -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  {-------------------------------------------------------------------------------
src/Codec/Xlsx/Writer/Internal/PivotTable.hs view
@@ -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
test/PivotTableTests.hs view
@@ -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| <?xml version="1.0" encoding="UTF-8" standalone="yes"?><!--Pivot cache definition generated by xlsx--> <pivotCacheDefinition xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"+    xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" r:id="rId1"     invalid="1" refreshOnLoad="1"     xmlns:ns="http://schemas.openxmlformats.org/officeDocument/2006/relationships">   <cacheSource type="worksheet">@@ -157,19 +166,13 @@      </sharedItems>     </cacheField>     <cacheField name="Year">-     <sharedItems containsNumber="1" containsString="0" containsSemiMixedTypes="0">-       <n v="2012"/><n v="2011"/>-     </sharedItems>+     <sharedItems containsNumber="1" containsString="0" containsSemiMixedTypes="0"/>     </cacheField>     <cacheField name="Price">-     <sharedItems containsNumber="1" containsString="0" containsSemiMixedTypes="0">-       <n v="12.23"/><n v="73.99"/><n v="10.19"/><n v="34.99"/>-     </sharedItems>+     <sharedItems containsNumber="1" containsString="0" containsSemiMixedTypes="0"/>     </cacheField>     <cacheField name="Count">-     <sharedItems containsNumber="1" containsString="0" containsSemiMixedTypes="0">-       <n v="17"/><n v="21"/><n v="172"/><n v="49"/>-     </sharedItems>+     <sharedItems containsNumber="1" containsString="0" containsSemiMixedTypes="0"/>     </cacheField> </cacheFields> </pivotCacheDefinition>
xlsx.cabal view
@@ -1,6 +1,6 @@ Name:                xlsx -Version:             0.7.0+Version:             0.7.1  Synopsis:            Simple and incomplete Excel file parser/writer Description: