diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -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 for + reporting) +* fixed parsing cells with comments but with no content (thanks + Stéphane Laurent for reporting) +* added some higher-level helpers work with pictures in SpreadsheetML + Drawing + 0.4.2 ----- * added basic tables support 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 @@ -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 diff --git a/src/Codec/Xlsx/Types.hs b/src/Codec/Xlsx/Types.hs --- a/src/Codec/Xlsx/Types.hs +++ b/src/Codec/Xlsx/Types.hs @@ -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) diff --git a/src/Codec/Xlsx/Types/Common.hs b/src/Codec/Xlsx/Types/Common.hs --- a/src/Codec/Xlsx/Types/Common.hs +++ b/src/Codec/Xlsx/Types/Common.hs @@ -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 diff --git a/src/Codec/Xlsx/Types/Drawing.hs b/src/Codec/Xlsx/Types/Drawing.hs --- a/src/Codec/Xlsx/Types/Drawing.hs +++ b/src/Codec/Xlsx/Types/Drawing.hs @@ -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{..} = diff --git a/src/Codec/Xlsx/Types/Drawing/Common.hs b/src/Codec/Xlsx/Types/Drawing/Common.hs --- a/src/Codec/Xlsx/Types/Drawing/Common.hs +++ b/src/Codec/Xlsx/Types/Drawing/Common.hs @@ -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{..} = diff --git a/src/Codec/Xlsx/Types/Internal/CommentTable.hs b/src/Codec/Xlsx/Types/Internal/CommentTable.hs --- a/src/Codec/Xlsx/Types/Internal/CommentTable.hs +++ b/src/Codec/Xlsx/Types/Internal/CommentTable.hs @@ -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 diff --git a/src/Codec/Xlsx/Types/Protection.hs b/src/Codec/Xlsx/Types/Protection.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Xlsx/Types/Protection.hs @@ -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 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 @@ -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 ). It suffices however diff --git a/test/DataTest.hs b/test/DataTest.hs --- a/test/DataTest.hs +++ b/test/DataTest.hs @@ -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 diff --git a/xlsx.cabal b/xlsx.cabal --- a/xlsx.cabal +++ b/xlsx.cabal @@ -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