xlsx 0.4.2 → 0.4.3
raw patch · 11 files changed
+481/−97 lines, 11 files
Files
- CHANGELOG.markdown +12/−0
- src/Codec/Xlsx/Parser.hs +52/−47
- src/Codec/Xlsx/Types.hs +19/−1
- src/Codec/Xlsx/Types/Common.hs +10/−0
- src/Codec/Xlsx/Types/Drawing.hs +104/−28
- src/Codec/Xlsx/Types/Drawing/Common.hs +12/−1
- src/Codec/Xlsx/Types/Internal/CommentTable.hs +18/−15
- src/Codec/Xlsx/Types/Protection.hs +239/−0
- src/Codec/Xlsx/Writer.hs +3/−1
- test/DataTest.hs +10/−3
- xlsx.cabal +2/−1
CHANGELOG.markdown view
@@ -1,3 +1,15 @@+0.4.3+-----+* added (legacy) sheet protection support+* switched to use `r` prefix for relationships namespace in+ workbook.xml to improve compatibility with readers expecting that+ prefix (thanks Stéphane Laurent <laurent_step@yahoo.fr> for+ reporting)+* fixed parsing cells with comments but with no content (thanks+ Stéphane Laurent <laurent_step@yahoo.fr> for reporting)+* added some higher-level helpers work with pictures in SpreadsheetML+ Drawing+ 0.4.2 ----- * added basic tables support
src/Codec/Xlsx/Parser.hs view
@@ -6,49 +6,47 @@ -- | This module provides a function for reading .xlsx files module Codec.Xlsx.Parser- ( toXlsx- , toXlsxEither- , ParseError (..)- , Parser- ) where+ ( toXlsx+ , toXlsxEither+ , ParseError(..)+ , Parser+ ) where -import qualified Codec.Archive.Zip as Zip-import Control.Applicative-import Control.Arrow (left)-import Control.Error.Safe (headErr)-import Control.Error.Util (note)-import Control.Lens hiding (element,- views, (<.>))-import Control.Monad.Except (catchError,- throwError)-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Lazy.Char8 ()-import Data.List-import qualified Data.Map as M-import Data.Maybe-import Data.Monoid-import Data.Ord-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Read as T-import Data.Traversable-import Prelude hiding (sequence)-import System.FilePath.Posix-import Text.XML as X-import Text.XML.Cursor+import qualified Codec.Archive.Zip as Zip+import Control.Applicative+import Control.Arrow (left)+import Control.Error.Safe (headErr)+import Control.Error.Util (note)+import Control.Lens hiding (element, views, (<.>))+import Control.Monad.Except (catchError, throwError)+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy.Char8 ()+import Data.List+import qualified Data.Map as M+import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Read as T+import Data.Traversable+import Prelude hiding (sequence)+import System.FilePath.Posix+import Text.XML as X+import Text.XML.Cursor -import Codec.Xlsx.Parser.Internal-import Codec.Xlsx.Parser.Internal.PivotTable-import Codec.Xlsx.Types-import Codec.Xlsx.Types.Internal-import Codec.Xlsx.Types.Internal.CfPair-import Codec.Xlsx.Types.Internal.CommentTable-import Codec.Xlsx.Types.Internal.ContentTypes as ContentTypes-import Codec.Xlsx.Types.Internal.CustomProperties as CustomProperties-import Codec.Xlsx.Types.Internal.DvPair-import Codec.Xlsx.Types.Internal.Relationships as Relationships-import Codec.Xlsx.Types.Internal.SharedStringTable-import Codec.Xlsx.Types.PivotTable.Internal+import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Parser.Internal.PivotTable+import Codec.Xlsx.Types+import Codec.Xlsx.Types.Internal+import Codec.Xlsx.Types.Internal.CfPair+import Codec.Xlsx.Types.Internal.CommentTable as CommentTable+import Codec.Xlsx.Types.Internal.ContentTypes as ContentTypes+import Codec.Xlsx.Types.Internal.CustomProperties+ as CustomProperties+import Codec.Xlsx.Types.Internal.DvPair+import Codec.Xlsx.Types.Internal.Relationships as Relationships+import Codec.Xlsx.Types.Internal.SharedStringTable+import Codec.Xlsx.Types.PivotTable.Internal -- | Reads `Xlsx' from raw data (lazy bytestring) toXlsx :: L.ByteString -> Xlsx@@ -116,7 +114,7 @@ cws = cur $/ element (n_ "cols") &/ element (n_ "col") >=> fromCursor - (rowProps, cells) = collect $ cur $/ element (n_ "sheetData") &/ element (n_ "row") >=> parseRow+ (rowProps, cells0) = collect $ cur $/ element (n_ "sheetData") &/ element (n_ "row") >=> parseRow parseRow :: Cursor -> [(Int, Maybe RowProperties, [(Int, Int, Cell)])] parseRow c = do r <- c $| attribute "r" >=> decimal@@ -136,9 +134,9 @@ t = fromMaybe "n" $ listToMaybe $ cell $| attribute "t" d = listToMaybe $ cell $/ element (n_ "v") &/ content >=> extractCellValue sst t f = listToMaybe $ cell $/ element (n_ "f") >=> fromCursor- (c, r) = T.span (>'9') $ unCellRef ref+ (r, c) = fromSingleCellRefNoting ref comment = commentsMap >>= lookupComment ref- return (int r, col2int c, Cell s d comment f)+ return (r, c, Cell s d comment f) collect = foldr collectRow (M.empty, M.empty) collectRow (_, Nothing, rowCells) (rowMap, cellMap) = (rowMap, foldr collectCell cellMap rowCells)@@ -146,6 +144,15 @@ (M.insert r h rowMap, foldr collectCell cellMap rowCells) collectCell (x, y, cd) = M.insert (x,y) cd + commentCells =+ M.fromList+ [ (fromSingleCellRefNoting r, def {_cellComment = Just cmnt})+ | (r, cmnt) <- maybe [] CommentTable.toList commentsMap+ ]+ cells = cells0 `M.union` commentCells++ mProtection = listToMaybe $ cur $/ element (n_ "sheetProtection") >=> fromCursor+ mDrawingId = listToMaybe $ cur $/ element (n_ "drawing") >=> fromAttribute (odr"id") merges = cur $/ parseMerges@@ -195,6 +202,7 @@ pTables mAutoFilter tables+ mProtection extractCellValue :: SharedStringTable -> Text -> Text -> [CellValue] extractCellValue sst "s" v =@@ -364,6 +372,3 @@ -> Either ParseError FilePath lookupRelPath fp rels rId = relTarget <$> note (InvalidRef fp rId) (Relationships.lookup rId rels)--int :: Text -> Int-int = either error fst . T.decimal
src/Codec/Xlsx/Types.hs view
@@ -34,6 +34,7 @@ , wsPivotTables , wsAutoFilter , wsTables+ , wsProtection -- ** Cells , cellValue , cellStyle@@ -77,6 +78,7 @@ import Codec.Xlsx.Types.Drawing.Common as X import Codec.Xlsx.Types.PageSetup as X import Codec.Xlsx.Types.PivotTable as X+import Codec.Xlsx.Types.Protection as X import Codec.Xlsx.Types.RichText as X import Codec.Xlsx.Types.SheetViews as X import Codec.Xlsx.Types.StyleSheet as X@@ -172,12 +174,28 @@ , _wsPivotTables :: [PivotTable] , _wsAutoFilter :: Maybe AutoFilter , _wsTables :: [Table]+ , _wsProtection :: Maybe SheetProtection } deriving (Eq, Show) makeLenses ''Worksheet instance Default Worksheet where- def = Worksheet [] M.empty M.empty Nothing [] Nothing Nothing M.empty M.empty [] Nothing []+ def =+ Worksheet+ { _wsColumns = []+ , _wsRowPropertiesMap = M.empty+ , _wsCells = M.empty+ , _wsDrawing = Nothing+ , _wsMerges = []+ , _wsSheetViews = Nothing+ , _wsPageSetup = Nothing+ , _wsConditionalFormattings = M.empty+ , _wsDataValidations = M.empty+ , _wsPivotTables = []+ , _wsAutoFilter = Nothing+ , _wsTables = []+ , _wsProtection = Nothing+ } newtype Styles = Styles {unStyles :: L.ByteString} deriving (Eq, Show)
src/Codec/Xlsx/Types/Common.hs view
@@ -4,6 +4,7 @@ ( CellRef(..) , singleCellRef , fromSingleCellRef+ , fromSingleCellRefNoting , Range , mkRange , fromRange@@ -22,6 +23,7 @@ import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as T+import Safe import Text.XML import Text.XML.Cursor @@ -75,6 +77,14 @@ guard $ not (T.null colT) && not (T.null rowT) && T.all isDigit rowT row <- decimal rowT return (row, col2int colT)++-- | reverse to 'mkCellRef' expecting valid reference and failig with+-- a standard error message like /"Bad cell reference 'XXX'"/+fromSingleCellRefNoting :: CellRef -> (Int, Int)+fromSingleCellRefNoting ref = fromJustNote errMsg $ fromSingleCellRefRaw txt+ where+ txt = unCellRef ref+ errMsg = "Bad cell reference '" ++ T.unpack txt ++ "'" -- | Excel range (e.g. @D13:H14@), actually store as as 'CellRef' in -- xlsx
src/Codec/Xlsx/Types/Drawing.hs view
@@ -1,41 +1,43 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} module Codec.Xlsx.Types.Drawing where -import Control.Lens.TH-import Data.ByteString.Lazy (ByteString)-import Data.Default-import qualified Data.Map as M-import Data.Maybe (catMaybes,- listToMaybe)-import Data.Text (Text)-import Text.XML-import Text.XML.Cursor+import Control.Arrow (first)+import Control.Lens.TH+import Data.ByteString.Lazy (ByteString)+import Data.Default+import qualified Data.Map as M+import Data.Maybe (catMaybes, listToMaybe, mapMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Text.XML+import Text.XML.Cursor #if !MIN_VERSION_base(4,8,0)-import Control.Applicative+import Control.Applicative #endif -import Codec.Xlsx.Parser.Internal-import Codec.Xlsx.Types.Drawing.Common-import Codec.Xlsx.Types.Drawing.Chart-import Codec.Xlsx.Types.Internal-import Codec.Xlsx.Types.Internal.Relationships-import Codec.Xlsx.Writer.Internal+import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Types.Drawing.Chart+import Codec.Xlsx.Types.Drawing.Common+import Codec.Xlsx.Types.Internal+import Codec.Xlsx.Types.Internal.Relationships+import Codec.Xlsx.Writer.Internal -- | information about image file as a par of a drawing data FileInfo = FileInfo { _fiFilename :: FilePath- -- ^ image filename, images are assumed to be stored under path "xl/media/"+ -- ^ image filename, images are assumed to be stored under path "xl\/media\/" , _fiContentType :: Text- -- ^ image content type, ECMA-376 advises to use "image/png" or "image/jpeg"+ -- ^ image content type, ECMA-376 advises to use "image\/png" or "image\/jpeg" -- if interoperability is wanted , _fiContents :: ByteString -- ^ image file contents@@ -88,6 +90,52 @@ -- TODO: sp, grpSp, graphicFrame, cxnSp, contentPart deriving (Eq, Show) +-- | basic function to create picture drawing object+--+-- /Note:/ specification says that drawing element ids need to be+-- unique within 1 document, otherwise /...document shall be+-- considered non-conformant/.+picture :: DrawingElementId -> FileInfo -> DrawingObject FileInfo c+picture dId fi =+ Picture+ { _picMacro = Nothing+ , _picPublished = False+ , _picNonVisual = nonVis+ , _picBlipFill = bfProps+ , _picShapeProperties = shProps+ }+ where+ nonVis =+ PicNonVisual $+ NonVisualDrawingProperties+ { _nvdpId = dId+ , _nvdpName = T.pack $ _fiFilename fi+ , _nvdpDescription = Nothing+ , _nvdpHidden = False+ , _nvdpTitle = Nothing+ }+ bfProps =+ BlipFillProperties+ {_bfpImageInfo = Just fi, _bfpFillMode = Just FillStretch}+ shProps =+ ShapeProperties+ { _spXfrm = Nothing+ , _spGeometry = Nothing+ , _spFill = Just NoFill+ , _spOutline = Just $ LineProperties (Just NoFill)+ }++-- | helper to retrive information about all picture files in+-- particular drawing alongside with their anchorings (i.e. sizes and+-- positions)+extractPictures :: Drawing -> [(Anchoring, FileInfo)]+extractPictures dr = mapMaybe maybePictureInfo $ _xdrAnchors dr+ where+ maybePictureInfo Anchor {..} =+ case _anchObject of+ Picture {..} -> (_anchAnchoring,) <$> _bfpImageInfo _picBlipFill+ _ -> Nothing+ -- | This element is used to set certain properties related to a drawing -- element on the client spreadsheet application. --@@ -111,9 +159,13 @@ -- TODO cNvGraphicFramePr } deriving (Eq, Show) +newtype DrawingElementId = DrawingElementId+ { unDrawingElementId :: Int+ } deriving (Eq, Show)+ -- see 20.1.2.2.8 "cNvPr (Non-Visual Drawing Properties)" (p. 2731) data NonVisualDrawingProperties = NonVisualDrawingProperties- { _nvdpId :: Int+ { _nvdpId :: DrawingElementId -- ^ Specifies a unique identifier for the current -- DrawingML object within the current --@@ -149,6 +201,22 @@ , _anchClientData :: ClientData } deriving (Eq, Show) +-- | simple drawing object anchoring using one cell as a top lelft+-- corner and dimensions of that object+simpleAnchorXY :: (Int, Int) -- ^ x+y coordinates of a cell used as+ -- top left anchoring corner+ -> PositiveSize2D -- ^ size of drawing object to be+ -- anchored+ -> DrawingObject p g+ -> Anchor p g+simpleAnchorXY (x, y) sz obj =+ Anchor+ { _anchAnchoring =+ OneCellAnchor {onecaFrom = unqMarker (x, fromIntegral $ cm2emu 10) (y, 0), onecaExt = sz}+ , _anchObject = obj+ , _anchClientData = def+ }+ data GenericDrawing p g = Drawing { _xdrAnchors :: [Anchor p g] } deriving (Eq, Show)@@ -256,6 +324,9 @@ _nvdpTitle <- maybeAttribute "title" cur return NonVisualDrawingProperties{..} +instance FromAttrVal DrawingElementId where+ fromAttrVal = fmap (first DrawingElementId) . fromAttrVal+ instance FromCursor (BlipFillProperties RefId) where fromCursor cur = do let _bfpImageInfo = listToMaybe $ cur $/ element (a_ "blip") >=>@@ -358,8 +429,10 @@ ] instance ToElement PicNonVisual where- toElement nm PicNonVisual{..} =- elementListSimple nm [toElement "cNvPr" _pnvDrawingProps]+ toElement nm PicNonVisual {..} =+ elementListSimple+ nm+ [toElement "cNvPr" _pnvDrawingProps, emptyElement "cNvPicPr"] instance ToElement GraphNonVisual where toElement nm GraphNonVisual {..} =@@ -376,6 +449,9 @@ catMaybes [ "descr" .=? _nvdpDescription , "hidden" .=? justTrue _nvdpHidden , "title" .=? _nvdpTitle ]++instance ToAttrVal DrawingElementId where+ toAttrVal = toAttrVal . unDrawingElementId instance ToElement (BlipFillProperties RefId) where toElement nm BlipFillProperties{..} =
src/Codec/Xlsx/Types/Drawing/Common.hs view
@@ -208,6 +208,16 @@ , _ps2dY :: PositiveCoordinate } deriving (Eq, Show) +positiveSize2D :: Integer -> Integer -> PositiveSize2D+positiveSize2D x y =+ PositiveSize2D (PositiveCoordinate x) (PositiveCoordinate y)++cmSize2D :: Integer -> Integer -> PositiveSize2D+cmSize2D x y = positiveSize2D (cm2emu x) (cm2emu y)++cm2emu :: Integer -> Integer+cm2emu cm = 360000 * cm+ -- See 20.1.7.6 "xfrm (2D Transform for Individual Objects)" (p. 2849) data Transform2D = Transform2D { _trRot :: Angle@@ -517,7 +527,8 @@ , toElement (a_ "ext") <$> _trExtents ] geometryToElement :: Geometry -> Element-geometryToElement PresetGeometry = emptyElement (a_ "prstGeom")+geometryToElement PresetGeometry =+ leafElement (a_ "prstGeom") ["prst" .= ("rect" :: Text)] instance ToElement LineProperties where toElement nm LineProperties{..} =
src/Codec/Xlsx/Types/Internal/CommentTable.hs view
@@ -2,24 +2,24 @@ {-# LANGUAGE RecordWildCards #-} module Codec.Xlsx.Types.Internal.CommentTable where -import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as LB+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy.Char8 as LBC8-import Data.List.Extra (nubOrd)-import Data.Map (Map)-import qualified Data.Map as M-import Data.Text (Text)-import Data.Text.Lazy (toStrict)-import qualified Data.Text.Lazy.Builder as B+import Data.List.Extra (nubOrd)+import Data.Map (Map)+import qualified Data.Map as M+import Data.Text (Text)+import Data.Text.Lazy (toStrict)+import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder.Int as B-import Safe-import Text.XML-import Text.XML.Cursor+import Safe+import Text.XML+import Text.XML.Cursor -import Codec.Xlsx.Parser.Internal-import Codec.Xlsx.Types.Comment-import Codec.Xlsx.Types.Common-import Codec.Xlsx.Writer.Internal+import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Types.Comment+import Codec.Xlsx.Types.Common+import Codec.Xlsx.Writer.Internal newtype CommentTable = CommentTable { _commentsTable :: Map CellRef Comment }@@ -27,6 +27,9 @@ fromList :: [(CellRef, Comment)] -> CommentTable fromList = CommentTable . M.fromList++toList :: CommentTable -> [(CellRef, Comment)]+toList = M.toList . _commentsTable lookupComment :: CellRef -> CommentTable -> Maybe Comment lookupComment ref = M.lookup ref . _commentsTable
+ src/Codec/Xlsx/Types/Protection.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+module Codec.Xlsx.Types.Protection+ ( SheetProtection(..)+ , fullSheetProtection+ , noSheetProtection+ , LegacyPassword+ , legacyPassword+ -- * Lenses+ , sprLegacyPassword+ , sprSheet + , sprObjects + , sprScenarios + , sprFormatCells + , sprFormatColumns + , sprFormatRows + , sprInsertColumns + , sprInsertRows + , sprInsertHyperlinks + , sprDeleteColumns + , sprDeleteRows + , sprSelectLockedCells + , sprSort + , sprAutoFilter + , sprPivotTables + , sprSelectUnlockedCells+ ) where++import Control.Arrow (first)+import Control.Lens (makeLenses)+import Data.Bits+import Data.Char+import Data.Maybe (catMaybes)+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 (hexadecimal)++import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Writer.Internal++newtype LegacyPassword =+ LegacyPassword Text+ deriving (Eq, Show)++-- | Creates legacy @XOR@ hashed password.+--+-- /Note:/ The implementation is known to work only for ASCII symbols,+-- if you know how to encode properly others - an email or a PR will+-- be highly apperciated+--+-- See Part 4, 14.7.1 "Legacy Password Hash Algorithm" (p. 73) and+-- Part 4, 15.2.3 "Additional attributes for workbookProtection+-- element (Part 1, §18.2.29)" (p. 220) and Par 4, 15.3.1.6+-- "Additional attribute for sheetProtection element (Part 1,+-- §18.3.1.85)" (p. 229)+legacyPassword :: Text -> LegacyPassword+legacyPassword = LegacyPassword . hex . legacyHash . map ord . T.unpack+ where+ hex = toStrict . toLazyText . hexadecimal+ legacyHash bs =+ mutHash (foldr (\b hash -> b `xor` mutHash hash) 0 bs) `xor` (length bs) `xor`+ 0xCE4B+ mutHash ph = ((ph `shiftR` 14) .&. 1) .|. ((ph `shiftL` 1) .&. 0x7fff)++-- | Sheet protection options to enforce and specify that it needs to+-- be protected+--+-- TODO: algorithms specified in the spec with hashes, salts and spin+-- counts+--+-- See 18.3.1.85 "sheetProtection (Sheet Protection Options)" (p. 1694)+data SheetProtection = SheetProtection+ { _sprLegacyPassword :: Maybe LegacyPassword+ -- ^ Specifies the legacy hash of the password required for editing+ -- this worksheet.+ --+ -- See Part 4, 15.3.1.6 "Additional attribute for sheetProtection+ -- element (Part 1, §18.3.1.85)" (p. 229)+ , _sprSheet :: Bool+ -- ^ the value of this attribute dictates whether the other+ -- attributes of 'SheetProtection' should be applied+ , _sprAutoFilter :: Bool+ -- ^ AutoFilters should not be allowed to operate when the sheet+ -- is protected+ , _sprDeleteColumns :: Bool+ -- ^ deleting columns should not be allowed when the sheet is+ -- protected+ , _sprDeleteRows :: Bool+ -- ^ deleting rows should not be allowed when the sheet is+ -- protected+ , _sprFormatCells :: Bool+ -- ^ formatting cells should not be allowed when the sheet is+ -- protected+ , _sprFormatColumns :: Bool+ -- ^ formatting columns should not be allowed when the sheet is+ -- protected+ , _sprFormatRows :: Bool+ -- ^ formatting rows should not be allowed when the sheet is+ -- protected+ , _sprInsertColumns :: Bool+ -- ^ inserting columns should not be allowed when the sheet is+ -- protected+ , _sprInsertHyperlinks :: Bool+ -- ^ inserting hyperlinks should not be allowed when the sheet is+ -- protected+ , _sprInsertRows :: Bool+ -- ^ inserting rows should not be allowed when the sheet is+ -- protected+ , _sprObjects :: Bool+ -- ^ editing of objects should not be allowed when the sheet is+ -- protected+ , _sprPivotTables :: Bool+ -- ^ PivotTables should not be allowed to operate when the sheet+ -- is protected+ , _sprScenarios :: Bool+ -- ^ Scenarios should not be edited when the sheet is protected+ , _sprSelectLockedCells :: Bool+ -- ^ selection of locked cells should not be allowed when the+ -- sheet is protected+ , _sprSelectUnlockedCells :: Bool+ -- ^ selection of unlocked cells should not be allowed when the+ -- sheet is protected+ , _sprSort :: Bool+ -- ^ sorting should not be allowed when the sheet is protected+ } deriving (Eq, Show)++makeLenses ''SheetProtection++{-------------------------------------------------------------------------------+ Base instances+-------------------------------------------------------------------------------}++-- | no sheet protection at all+noSheetProtection :: SheetProtection+noSheetProtection =+ SheetProtection+ { _sprLegacyPassword = Nothing+ , _sprSheet = False+ , _sprAutoFilter = False+ , _sprDeleteColumns = False+ , _sprDeleteRows = False+ , _sprFormatCells = False+ , _sprFormatColumns = False+ , _sprFormatRows = False+ , _sprInsertColumns = False+ , _sprInsertHyperlinks = False+ , _sprInsertRows = False+ , _sprObjects = False+ , _sprPivotTables = False+ , _sprScenarios = False+ , _sprSelectLockedCells = False+ , _sprSelectUnlockedCells = False+ , _sprSort = False+ }++-- | protection of all sheet features which could be protected+fullSheetProtection :: SheetProtection+fullSheetProtection =+ SheetProtection+ { _sprLegacyPassword = Nothing+ , _sprSheet = True+ , _sprAutoFilter = True+ , _sprDeleteColumns = True+ , _sprDeleteRows = True+ , _sprFormatCells = True+ , _sprFormatColumns = True+ , _sprFormatRows = True+ , _sprInsertColumns = True+ , _sprInsertHyperlinks = True+ , _sprInsertRows = True+ , _sprObjects = True+ , _sprPivotTables = True+ , _sprScenarios = True+ , _sprSelectLockedCells = True+ , _sprSelectUnlockedCells = True+ , _sprSort = True+ }++{-------------------------------------------------------------------------------+ Parsing+-------------------------------------------------------------------------------}++instance FromCursor SheetProtection where+ fromCursor cur = do+ _sprLegacyPassword <- maybeAttribute "password" cur+ _sprSheet <- fromAttributeDef "sheet" False cur+ _sprAutoFilter <- fromAttributeDef "autoFilter" True cur+ _sprDeleteColumns <- fromAttributeDef "deleteColumns" True cur+ _sprDeleteRows <- fromAttributeDef "deleteRows" True cur+ _sprFormatCells <- fromAttributeDef "formatCells" True cur+ _sprFormatColumns <- fromAttributeDef "formatColumns" True cur+ _sprFormatRows <- fromAttributeDef "formatRows" True cur+ _sprInsertColumns <- fromAttributeDef "insertColumns" True cur+ _sprInsertHyperlinks <- fromAttributeDef "insertHyperlinks" True cur+ _sprInsertRows <- fromAttributeDef "insertRows" True cur+ _sprObjects <- fromAttributeDef "objects" False cur+ _sprPivotTables <- fromAttributeDef "pivotTables" True cur+ _sprScenarios <- fromAttributeDef "scenarios" False cur+ _sprSelectLockedCells <- fromAttributeDef "selectLockedCells" False cur+ _sprSelectUnlockedCells <- fromAttributeDef "selectUnlockedCells" False cur+ _sprSort <- fromAttributeDef "sort" True cur + return SheetProtection {..}++instance FromAttrVal LegacyPassword where+ fromAttrVal = fmap (first LegacyPassword) . fromAttrVal+++{-------------------------------------------------------------------------------+ Rendering+-------------------------------------------------------------------------------}++instance ToElement SheetProtection where+ toElement nm SheetProtection {..} =+ leafElement nm $+ catMaybes+ [ "password" .=? _sprLegacyPassword+ , "sheet" .=? justTrue _sprSheet+ , "autoFilter" .=? justFalse _sprAutoFilter+ , "deleteColumns" .=? justFalse _sprDeleteColumns+ , "deleteRows" .=? justFalse _sprDeleteRows+ , "formatCells" .=? justFalse _sprFormatCells+ , "formatColumns" .=? justFalse _sprFormatColumns+ , "formatRows" .=? justFalse _sprFormatRows+ , "insertColumns" .=? justFalse _sprInsertColumns+ , "insertHyperlinks" .=? justFalse _sprInsertHyperlinks+ , "insertRows" .=? justFalse _sprInsertRows+ , "objects" .=? justTrue _sprObjects+ , "pivotTables" .=? justFalse _sprPivotTables+ , "scenarios" .=? justTrue _sprScenarios+ , "selectLockedCells" .=? justTrue _sprSelectLockedCells+ , "selectUnlockedCells" .=? justTrue _sprSelectUnlockedCells+ , "sort" .=? justFalse _sprSort+ ]++instance ToAttrVal LegacyPassword where+ toAttrVal (LegacyPassword hash) = hash
src/Codec/Xlsx/Writer.hs view
@@ -118,6 +118,7 @@ [ elementListSimple "sheetViews" . map (toElement "sheetView") <$> ws ^. wsSheetViews , nonEmptyElListSimple "cols" . map cwEl $ ws ^. wsColumns , Just . elementListSimple "sheetData" $ sheetDataXml cells (ws ^. wsRowPropertiesMap)+ , toElement "sheetProtection" <$> (ws ^. wsProtection) , toElement "autoFilter" <$> (ws ^. wsAutoFilter) , nonEmptyElListSimple "mergeCells" . map mergeE1 $ ws ^. wsMerges ] ++ map (Just . toElement "conditionalFormatting") cfPairs ++@@ -487,8 +488,9 @@ -> [(CacheId, RefId)] -> L.ByteString bookXml rIdNames (DefinedNames names) cacheIdRefs =- renderLBS def $ Document (Prologue [] Nothing []) root []+ renderLBS def {rsNamespaces = nss} $ Document (Prologue [] Nothing []) root [] where+ nss = [ ("r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships") ] -- The @bookViews@ element is not required according to the schema, but its -- absence can cause Excel to crash when opening the print preview -- (see <https://phpexcel.codeplex.com/workitem/2935>). It suffices however
test/DataTest.hs view
@@ -112,7 +112,7 @@ sheets = [("List1", sheet1), ("Another sheet", sheet2), ("with pivot table", pvSheet)] sheet1 = Worksheet cols rowProps testCellMap1 drawing ranges- sheetViews pageSetup cFormatting validations [] (Just autoFilter) tables+ sheetViews pageSetup cFormatting validations [] (Just autoFilter) tables (Just protection) autoFilter = def & afRef ?~ CellRef "A1:E10" & afFilterColumns .~ fCols fCols = M.fromList [ (1, Filters ["a","b","ZZZ"])@@ -127,6 +127,11 @@ , tblAutoFilter = Just (def & afRef ?~ CellRef "A3") } ]+ protection =+ fullSheetProtection+ { _sprScenarios = False+ , _sprLegacyPassword = Just $ legacyPassword "hard password"+ } sheet2 = def & wsCells .~ testCellMap2 pvSheet = sheetWithPvCells & wsPivotTables .~ [testPivotTable] sheetWithPvCells = flip execState def $ do@@ -220,10 +225,12 @@ def & cellValue ?~ CellText "value" & cellComment ?~ comment2 )+ , ((11, 4), def & cellComment ?~ comment3) ] where comment1 = Comment (XlsxText "simple comment") "bob" True comment2 = Comment (XlsxRichText [rich1, rich2]) "alice" False+ comment3 = Comment (XlsxText "comment for an empty cell") "bob" True rich1 = def & richTextRunText.~ "Look ma!" & richTextRunProperties ?~ ( def & runPropertiesBold ?~ True@@ -365,7 +372,7 @@ nonVis1 = PicNonVisual $ NonVisualDrawingProperties- { _nvdpId = 0+ { _nvdpId = DrawingElementId 0 , _nvdpName = "Picture 1" , _nvdpDescription = Just "" , _nvdpHidden = False@@ -413,7 +420,7 @@ } nonVis2 = GraphNonVisual $ NonVisualDrawingProperties- { _nvdpId = 1+ { _nvdpId = DrawingElementId 1 , _nvdpName = "" , _nvdpDescription = Nothing , _nvdpHidden = False
xlsx.cabal view
@@ -1,6 +1,6 @@ Name: xlsx -Version: 0.4.2+Version: 0.4.3 Synopsis: Simple and incomplete Excel file parser/writer Description:@@ -60,6 +60,7 @@ , Codec.Xlsx.Types.PageSetup , Codec.Xlsx.Types.PivotTable , Codec.Xlsx.Types.PivotTable.Internal+ , Codec.Xlsx.Types.Protection , Codec.Xlsx.Types.RichText , Codec.Xlsx.Types.SheetViews , Codec.Xlsx.Types.StyleSheet