xlsx 1.0.0.1 → 1.1.0

raw patch · 19 files changed

+891/−193 lines, 19 filesdep ~lensdep ~mtldep ~safePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: lens, mtl, safe, xml-conduit

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +13/−0
• src/Codec/Xlsx/Formatted.hs +24/−16
• src/Codec/Xlsx/Lens.hs +9/−9
• src/Codec/Xlsx/Parser.hs +43/−24
• src/Codec/Xlsx/Parser/Stream.hs +13/−6
• src/Codec/Xlsx/Types.hs +45/−3
• src/Codec/Xlsx/Types/Cell.hs +1/−1
• src/Codec/Xlsx/Types/Common.hs +255/−29
• src/Codec/Xlsx/Types/DataValidation.hs +67/−7
• src/Codec/Xlsx/Types/Internal/CommentTable.hs +11/−3
• src/Codec/Xlsx/Writer.hs +13/−10
• src/Codec/Xlsx/Writer/Stream.hs +5/−3
• test/Common.hs +9/−0
• test/CommonTests.hs +13/−5
• test/CommonTests/CellRefTests.hs +182/−0
• test/Main.hs +64/−12
• test/StreamTests.hs +58/−31
• test/TestXlsx.hs +63/−32
• xlsx.cabal +3/−2

@@ -1,3 +1,16 @@+1.1.0+------------+* Fix default cell type in streaming parser+  (thanks to Nikita Razmakhnin <nikita@supercede.com>)+* Implemented cell range data validation+  (thanks to Florian Fouratier <6524406+flhorizon@users.noreply.github.com>)+* Added support for sheet visibility+  (thanks to Florian Fouratier <6524406+flhorizon@users.noreply.github.com>)+* Added parsing of comment visibility+  (thanks to Luke <luke@supercede.com>)+* Added newtypes for column and row indices+  (thanks to Luke <luke@supercede.com>)+ 1.0.0 ------------ * Add support for streaming xlsx files

@@ -234,7 +234,7 @@ -- -- If you don't already have a 'StyleSheet' you want to use as starting point -- then 'minimalStyleSheet' is a good choice.-formatted :: Map (Int, Int) FormattedCell -> StyleSheet -> Formatted+formatted :: Map (RowIndex, ColumnIndex) FormattedCell -> StyleSheet -> Formatted formatted cs styleSheet =    let initSt         = stateFromStyleSheet styleSheet        (cs', finalSt) = runState (mapM (uncurry formatCell) (M.toList cs)) initSt@@ -245,7 +245,9 @@         , formattedMerges     = reverse (finalSt ^. formattingMerges)         } -formatWorkbook :: [(Text, Map (Int, Int) FormattedCell)] -> StyleSheet -> Xlsx+-- | Build an 'Xlsx', render provided cells as per the 'StyleSheet'.+formatWorkbook ::+  [(Text, Map (RowIndex, ColumnIndex) FormattedCell)] -> StyleSheet -> Xlsx formatWorkbook nfcss initStyle = extract go   where     initSt = stateFromStyleSheet initStyle@@ -262,7 +264,7 @@  -- | reverse to 'formatted' which allows to get a map of formatted cells -- from an existing worksheet and its workbook's style sheet-toFormattedCells :: CellMap -> [Range] -> StyleSheet -> Map (Int, Int) FormattedCell+toFormattedCells :: CellMap -> [Range] -> StyleSheet -> Map (RowIndex, ColumnIndex) FormattedCell toFormattedCells m merges StyleSheet{..} = applyMerges $ M.map toFormattedCell m   where     toFormattedCell cell@Cell{..} =@@ -300,11 +302,14 @@         if apply then prop cXf else fail "not applied"     applyMerges cells = foldl' onlyTopLeft cells merges     onlyTopLeft cells range = flip execState cells $ do-        let ((r1, c1), (r2, c2)) = fromJustNote "fromRange" $ fromRange range+        let ((r1, c1), (r2, c2)) =+              fromJustNote "fromRange" $ fromRange range             nonTopLeft = tail [(r, c) | r<-[r1..r2], c<-[c1..c2]]         forM_ nonTopLeft (modify . M.delete)-        at (r1, c1) . non def . formattedRowSpan .= (r2 - r1 +1)-        at (r1, c1) . non def . formattedColSpan .= (c2 - c1 +1)+        at (r1, c1) . non def . formattedRowSpan .=+          (unRowIndex r2 - unRowIndex r1 + 1)+        at (r1, c1) . non def . formattedColSpan .=+          (unColumnIndex c2 - unColumnIndex c1 + 1)  data CondFormatted = CondFormatted {     -- | The resulting stylesheet@@ -333,13 +338,15 @@ -------------------------------------------------------------------------------}  -- | Format a cell with (potentially) rowspan or colspan-formatCell :: (Int, Int) -> FormattedCell -> State FormattingState [((Int, Int), Cell)]+formatCell :: (RowIndex, ColumnIndex) -> FormattedCell+  -> State FormattingState [((RowIndex, ColumnIndex), Cell)] formatCell (row, col) cell = do     let (block, mMerge) = cellBlock (row, col) cell     forM_ mMerge $ \merge -> formattingMerges %= (:) merge     mapM go block   where-    go :: ((Int, Int), FormattedCell) -> State FormattingState ((Int, Int), Cell)+    go :: ((RowIndex, ColumnIndex), FormattedCell)+      -> State FormattingState ((RowIndex, ColumnIndex), Cell)     go (pos, c@FormattedCell{..}) = do       styleId <- cellStyleId c       return (pos, _formattedCell{_cellStyle = styleId})@@ -353,11 +360,11 @@ -- remaining cells are the cells covered by the rowspan/colspan. -- -- Also returns the cell merge instruction, if any.-cellBlock :: (Int, Int) -> FormattedCell-          -> ([((Int, Int), FormattedCell)], Maybe Range)+cellBlock :: (RowIndex, ColumnIndex) -> FormattedCell+          -> ([((RowIndex, ColumnIndex), FormattedCell)], Maybe Range) cellBlock (row, col) cell@FormattedCell{..} = (block, merge)   where-    block :: [((Int, Int), FormattedCell)]+    block :: [((RowIndex, ColumnIndex), FormattedCell)]     block = [ ((row', col'), cellAt (row', col'))             | row' <- [topRow  .. bottomRow]             , col' <- [leftCol .. rightCol]@@ -367,7 +374,7 @@     merge = do guard (topRow /= bottomRow || leftCol /= rightCol)                return $ mkRange (topRow, leftCol) (bottomRow, rightCol) -    cellAt :: (Int, Int) -> FormattedCell+    cellAt :: (RowIndex, ColumnIndex) -> FormattedCell     cellAt (row', col') =       if row' == row && col == col'         then cell@@ -375,18 +382,19 @@      border = _formatBorder _formattedFormat -    borderAt :: (Int, Int) -> Border+    borderAt :: (RowIndex, ColumnIndex) -> Border     borderAt (row', col') = def       & borderTop    .~ do guard (row' == topRow)    ; _borderTop    =<< border       & borderBottom .~ do guard (row' == bottomRow) ; _borderBottom =<< border       & borderLeft   .~ do guard (col' == leftCol)   ; _borderLeft   =<< border       & borderRight  .~ do guard (col' == rightCol)  ; _borderRight  =<< border -    topRow, bottomRow, leftCol, rightCol :: Int+    topRow, bottomRow :: RowIndex+    leftCol, rightCol :: ColumnIndex     topRow    = row-    bottomRow = row + _formattedRowSpan - 1+    bottomRow = RowIndex $ unRowIndex row + _formattedRowSpan - 1     leftCol   = col-    rightCol  = col + _formattedColSpan - 1+    rightCol  = ColumnIndex $ unColumnIndex col + _formattedColSpan - 1  cellStyleId :: FormattedCell -> State FormattingState (Maybe Int) cellStyleId c = mapM (getId formattingCellXfs) =<< constructCellXf c

@@ -74,43 +74,43 @@ -- | lens giving access to a cell in some worksheet -- by its position, by default row+column index is used -- so this lens is a synonym of 'ixCellRC'-ixCell :: (Int, Int) -> Traversal' Worksheet Cell+ixCell :: (RowIndex, ColumnIndex) -> Traversal' Worksheet Cell ixCell = ixCellRC  -- | lens to access cell in a worksheet-ixCellRC :: (Int, Int) -> Traversal' Worksheet Cell+ixCellRC :: (RowIndex, ColumnIndex) -> Traversal' Worksheet Cell ixCellRC i = wsCells . ix i  -- | lens to access cell in a worksheet using more traditional -- x+y coordinates-ixCellXY :: (Int, Int) -> Traversal' Worksheet Cell+ixCellXY :: (ColumnIndex, RowIndex) -> Traversal' Worksheet Cell ixCellXY i = ixCellRC $ swap i  -- | accessor that can read, write or delete cell in a worksheet -- synonym of 'atCellRC' so uses row+column index-atCell :: (Int, Int) -> Lens' Worksheet (Maybe Cell)+atCell :: (RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe Cell) atCell = atCellRC  -- | lens to read, write or delete cell in a worksheet-atCellRC :: (Int, Int) -> Lens' Worksheet (Maybe Cell)+atCellRC :: (RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe Cell) atCellRC i = wsCells . at i  -- | lens to read, write or delete cell in a worksheet -- using more traditional x+y or row+column index-atCellXY :: (Int, Int) -> Lens' Worksheet (Maybe Cell)+atCellXY :: (ColumnIndex, RowIndex) -> Lens' Worksheet (Maybe Cell) atCellXY i = atCellRC $ swap i  -- | lens to read, write or delete cell value in a worksheet -- with row+column coordinates, synonym for 'cellValueRC'-cellValueAt :: (Int, Int) -> Lens' Worksheet (Maybe CellValue)+cellValueAt :: (RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue) cellValueAt = cellValueAtRC  -- | lens to read, write or delete cell value in a worksheet -- using row+column coordinates of that cell-cellValueAtRC :: (Int, Int) -> Lens' Worksheet (Maybe CellValue)+cellValueAtRC :: (RowIndex, ColumnIndex) -> Lens' Worksheet (Maybe CellValue) cellValueAtRC i = atCell i . non def . cellValue  -- | lens to read, write or delete cell value in a worksheet -- using traditional x+y coordinates-cellValueAtXY :: (Int, Int) -> Lens' Worksheet (Maybe CellValue)+cellValueAtXY :: (ColumnIndex, RowIndex) -> Lens' Worksheet (Maybe CellValue) cellValueAtXY i = cellValueAtRC $ swap i

@@ -112,11 +112,12 @@   (wfs, names, cacheSources, dateBase) <- readWorkbook ar   sheets <- forM wfs $ \wf -> do       sheet <- parseSheet ar sst contentTypes cacheSources wf-      return (wfName wf, sheet)+      return . (wfName wf,) . (wsState .~ wfState wf) $ sheet   CustomProperties customPropMap <- getCustomProperties ar   return $ Xlsx sheets (getStyles ar) names customPropMap dateBase  data WorksheetFile = WorksheetFile { wfName :: Text+                                   , wfState :: SheetState                                    , wfPath :: FilePath                                    }                    deriving (Show, Generic)@@ -204,6 +205,7 @@             { _wsDrawing = Nothing             , _wsPivotTables = []             , _wsTables = []+            , _wsState = wfState wf             , ..             }             , tableIds@@ -247,18 +249,18 @@     justNonEmpty _ = Nothing     collectRows = foldr collectRow (M.empty, M.empty, M.empty)     collectRow ::-         ( Int+         ( RowIndex          , Maybe RowProperties-         , [(Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])-      -> ( Map Int RowProperties+         , [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])+      -> ( Map RowIndex RowProperties          , CellMap          , Map SharedFormulaIndex SharedFormulaOptions)-      -> ( Map Int RowProperties+      -> ( Map RowIndex RowProperties          , CellMap          , Map SharedFormulaIndex SharedFormulaOptions)     collectRow (r, mRP, rowCells) (rowMap, cellMap, sharedF) =       let (newCells0, newSharedF0) =-            unzip [(((x, y), cd), shared) | (x, y, cd, shared) <- rowCells]+            unzip [(((rInd, cInd), cd), shared) | (rInd, cInd, cd, shared) <- rowCells]           newCells = M.fromAscList newCells0           newSharedF = M.fromAscList $ catMaybes newSharedF0           newRowMap =@@ -268,10 +270,10 @@       in (newRowMap, cellMap <> newCells, sharedF <> newSharedF)     parseRow ::          Xeno.Node-      -> Either Text ( Int+      -> Either Text ( RowIndex                      , Maybe RowProperties-                     , [( Int-                        , Int+                     , [( RowIndex+                        , ColumnIndex                         , Cell                         , Maybe (SharedFormulaIndex, SharedFormulaOptions))])     parseRow row = do@@ -292,15 +294,24 @@       cellNodes <- collectChildren row $ childList "c"       cells <- forM cellNodes parseCell       return-        ( r+        ( RowIndex r         , if props == def             then Nothing             else Just props         , cells)++    -- NB: According to format specification default value for cells without+    -- `t` attribute is a `n` - number.+    --+    -- Schema part from spec (see the `CellValue` spec reference):+    -- <xsd:complexType name="CT_Cell">+    --  ..+    --  <xsd:attribute name="t" type="ST_CellType" use="optional" default="n"/>+    -- </xsd:complexType>     parseCell ::          Xeno.Node-      -> Either Text ( Int-                     , Int+      -> Either Text ( RowIndex+                     , ColumnIndex                      , Cell                      , Maybe (SharedFormulaIndex, SharedFormulaOptions))     parseCell cell = do@@ -373,11 +384,11 @@         collect $ cur $/ element (n_ "sheetData") &/ element (n_ "row") >=> parseRow       parseRow ::            Cursor-        -> [( Int+        -> [( RowIndex             , Maybe RowProperties-            , [(Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])]+            , [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])]       parseRow c = do-        r <- fromAttribute "r" c+        r <- RowIndex <$> fromAttribute "r" c         let prop = RowProps               { rowHeight = do h <- listToMaybe $ fromAttribute "ht" c                                case fromAttribute "customHeight" c of@@ -395,10 +406,17 @@                )       parseCell ::            Cursor-        -> [(Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))]+        -> [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))]       parseCell cell = do         ref <- fromAttribute "r" cell         let s = listToMaybe $ cell $| attribute "s" >=> decimal+            -- NB: According to format specification default value for cells without+            -- `t` attribute is a `n` - number.+            --+            -- <xsd:complexType name="CT_Cell" from spec (see the `CellValue` spec reference)>+            --  ..+            --  <xsd:attribute name="t" type="ST_CellType" use="optional" default="n"/>+            -- </xsd:complexType>             t = fromMaybe "n" $ listToMaybe $ cell $| attribute "t"             d = listToMaybe $ extractCellValue sst t cell             mFormulaData = listToMaybe $ cell $/ element (n_ "f") >=> formulaDataFromCursor@@ -409,11 +427,11 @@         return (r, c, Cell s d comment f, shared)       collect = foldr collectRow (M.empty, M.empty, M.empty)       collectRow ::-           ( Int+           ( RowIndex            , Maybe RowProperties-           , [(Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])-        -> (Map Int RowProperties, CellMap, Map SharedFormulaIndex SharedFormulaOptions)-        -> (Map Int RowProperties, CellMap, Map SharedFormulaIndex SharedFormulaOptions)+           , [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])+        -> (Map RowIndex RowProperties, CellMap, Map SharedFormulaIndex SharedFormulaOptions)+        -> (Map RowIndex RowProperties, CellMap, Map SharedFormulaIndex SharedFormulaOptions)       collectRow (r, mRP, rowCells) (rowMap, cellMap, sharedF) =         let (newCells0, newSharedF0) =               unzip [(((x,y),cd), shared) | (x, y, cd, shared) <- rowCells]@@ -484,6 +502,7 @@       tables       mProtection       sharedFormulas+      (wfState wf)  extractCellValue :: SharedStringTable -> Text -> Cursor -> [CellValue] extractCellValue sst t cur@@ -637,7 +656,7 @@   sheets <-     sequence $     cur $/ element (n_ "sheets") &/ element (n_ "sheet") >=>-    liftA2 (worksheetFile wbPath wbRels) <$> attribute "name" <*>+    liftA3 (worksheetFile wbPath wbRels) <$> attribute "name" <*> fromAttributeDef "state" def <*>     fromAttribute (odr "id")   let cacheRefs =         cur $/ element (n_ "pivotCaches") &/ element (n_ "pivotCache") >=>@@ -670,9 +689,9 @@   cur <- xmlCursorRequired ar fp   headErr (InvalidFile fp "Couldn't parse drawing") (fromCursor cur) -worksheetFile :: FilePath -> Relationships -> Text -> RefId -> Parser WorksheetFile-worksheetFile parentPath wbRels name rId =-  WorksheetFile name <$> lookupRelPath parentPath wbRels rId+worksheetFile :: FilePath -> Relationships -> Text -> SheetState -> RefId -> Parser WorksheetFile+worksheetFile parentPath wbRels name visibility rId =+  WorksheetFile name visibility <$> lookupRelPath parentPath wbRels rId  getRels :: Zip.Archive -> FilePath -> Parser Relationships getRels ar fp = do

@@ -134,7 +134,7 @@     deriving anyclass NFData  data Row = MkRow-  { _ri_row_index   :: Int       -- ^ Row number+  { _ri_row_index   :: RowIndex  -- ^ Row number   , _ri_cell_row    :: ~CellRow  -- ^ Row itself   } deriving stock (Generic, Show)     deriving anyclass NFData@@ -162,8 +162,8 @@ data SheetState = MkSheetState   { _ps_row             :: ~CellRow        -- ^ Current row   , _ps_sheet_index     :: Int             -- ^ Current sheet ID (AKA 'sheetInfoSheetId')-  , _ps_cell_row_index  :: Int             -- ^ Current row number-  , _ps_cell_col_index  :: Int             -- ^ Current column number+  , _ps_cell_row_index  :: RowIndex        -- ^ Current row number+  , _ps_cell_col_index  :: ColumnIndex     -- ^ Current column number   , _ps_cell_style      :: Maybe Int   , _ps_is_in_val       :: Bool            -- ^ Flag for indexing wheter the parser is in value or not   , _ps_shared_strings  :: SharedStringsMap -- ^ Shared string map@@ -549,7 +549,7 @@   style <- use ps_cell_style   when (_ps_is_in_val st) $ do     val <- liftEither $ first ParseCellError $ parseValue (_ps_shared_strings st) txt (_ps_type st)-    put $ st { _ps_row = IntMap.insert (_ps_cell_col_index st)+    put $ st { _ps_row = IntMap.insert (unColumnIndex $ _ps_cell_col_index st)                          (Cell { _cellStyle   = style                                , _cellValue   = Just val                                , _cellComment = Nothing@@ -688,7 +688,14 @@ parseType :: SheetValues -> Either TypeError ExcelValueType parseType list =   case findName "t" list of-    Nothing -> pure Untyped+    -- NB: According to format specification default value for cells without+    -- `t` attribute is a `n` - number.+    --+    -- <xsd:complexType name="CT_Cell" from spec (see the `CellValue` spec reference)>+    --  ..+    --  <xsd:attribute name="t" type="ST_CellType" use="optional" default="n"/>+    -- </xsd:complexType>+    Nothing -> Right TN     Just (_nm, valText)->       case valText of         "n"         -> Right TN@@ -702,7 +709,7 @@  -- | Parse coordinates from a list of xml elements if such were found on "r" key {-# SCC parseCoordinates #-}-parseCoordinates :: SheetValues -> Either CoordinateErrors (Int, Int)+parseCoordinates :: SheetValues -> Either CoordinateErrors (RowIndex, ColumnIndex) parseCoordinates list = do   (_nm, valText) <- maybe (Left $ CoordinateNotFound list) Right $ findName "r" list   maybe (Left $ DecodeFailure valText list) Right $ fromSingleCellRef $ CellRef valText

@@ -14,6 +14,7 @@     , ColumnsProperties(..)     , PageSetup(..)     , Worksheet(..)+    , SheetState(..)     , CellMap     , CellValue(..)     , CellFormula(..)@@ -45,6 +46,7 @@     , wsTables     , wsProtection     , wsSharedFormulas+    , wsState     -- ** Cells     , Cell.cellValue     , Cell.cellStyle@@ -227,10 +229,48 @@     cpBestFit <- fromAttrDef "bestFit" False     return ColumnsProperties {..} +-- | Sheet visibility state+-- cf. Ecma Office Open XML Part 1:+-- 18.18.68 ST_SheetState (Sheet Visibility Types)+-- * "visible"+--     Indicates the sheet is visible (default)+-- * "hidden"+--     Indicates the workbook window is hidden, but can be shown by the user via the user interface.+-- * "veryHidden"+--     Indicates the sheet is hidden and cannot be shown in the user interface (UI). This state is only available programmatically.+data SheetState =+  Visible -- ^ state="visible"+  | Hidden -- ^ state="hidden"+  | VeryHidden -- ^ state="veryHidden"+  deriving (Eq, Show, Generic)++instance NFData SheetState++instance Default SheetState where+  def = Visible++instance FromAttrVal SheetState where+    fromAttrVal "visible"    = readSuccess Visible+    fromAttrVal "hidden"     = readSuccess Hidden+    fromAttrVal "veryHidden" = readSuccess VeryHidden+    fromAttrVal t            = invalidText "SheetState" t++instance FromAttrBs SheetState where+    fromAttrBs "visible"    = return Visible+    fromAttrBs "hidden"     = return Hidden+    fromAttrBs "veryHidden" = return VeryHidden+    fromAttrBs t            = unexpectedAttrBs "SheetState" t++instance ToAttrVal SheetState where+    toAttrVal Visible    = "visible"+    toAttrVal Hidden     = "hidden"+    toAttrVal VeryHidden = "veryHidden"+ -- | Xlsx worksheet data Worksheet = Worksheet   { _wsColumnsProperties :: [ColumnsProperties] -- ^ column widths-  , _wsRowPropertiesMap :: Map Int RowProperties -- ^ custom row properties (height, style) map+  , _wsRowPropertiesMap :: Map RowIndex RowProperties+    -- ^ custom row properties (height, style) map   , _wsCells :: CellMap -- ^ data mapped by (row, column) pairs   , _wsDrawing :: Maybe Drawing -- ^ SpreadsheetML Drawing   , _wsMerges :: [Range] -- ^ list of cell merges@@ -243,6 +283,7 @@   , _wsTables :: [Table]   , _wsProtection :: Maybe SheetProtection   , _wsSharedFormulas :: Map SharedFormulaIndex SharedFormulaOptions+  , _wsState :: SheetState   } deriving (Eq, Show, Generic) instance NFData Worksheet @@ -265,6 +306,7 @@     , _wsTables = []     , _wsProtection = Nothing     , _wsSharedFormulas = M.empty+    , _wsState = def     }  -- | Raw worksheet styles, for structured implementation see 'StyleSheet'@@ -348,7 +390,7 @@  -- | converts cells mapped by (row, column) into rows which contain -- row index and cells as pairs of column indices and cell values-toRows :: CellMap -> [(Int, [(Int, Cell)])]+toRows :: CellMap -> [(RowIndex, [(ColumnIndex, Cell)])] toRows cells =     map extractRow $ groupBy ((==) `on` (fst . fst)) $ M.toList cells   where@@ -357,7 +399,7 @@     extractRow _ = error "invalid CellMap row"  -- | reverse to 'toRows'-fromRows :: [(Int, [(Int, Cell)])] -> CellMap+fromRows :: [(RowIndex, [(ColumnIndex, Cell)])] -> CellMap fromRows rows = M.fromList $ concatMap mapRow rows   where     mapRow (r, cells) = map (\(c, v) -> ((r, c), v)) cells

@@ -115,7 +115,7 @@ -- | Map containing cell values which are indexed by row and column -- if you need to use more traditional (x,y) indexing please you could -- use corresponding accessors from ''Codec.Xlsx.Lens''-type CellMap = Map (Int, Int) Cell+type CellMap = Map (RowIndex, ColumnIndex) Cell  {-------------------------------------------------------------------------------   Parsing

@@ -1,18 +1,39 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Codec.Xlsx.Types.Common   ( CellRef(..)+  , RowCoord(..)+  , ColumnCoord(..)+  , CellCoord+  , RangeCoord+  , mapBoth+  , col2coord+  , coord2col+  , row2coord+  , coord2row   , singleCellRef+  , singleCellRef'   , fromSingleCellRef+  , fromSingleCellRef'   , fromSingleCellRefNoting+  , escapeRefSheetName+  , unEscapeRefSheetName+  , mkForeignSingleCellRef+  , fromForeignSingleCellRef   , Range   , mkRange+  , mkRange'+  , mkForeignRange   , fromRange+  , fromRange'+  , fromForeignRange   , SqRef(..)   , XlsxText(..)   , xlsxTextToCellValue@@ -24,6 +45,8 @@   , dateToNumber   , int2col   , col2int+  , columnIndexToText+  , textToColumnIndex   -- ** prisms   , _XlsxText   , _XlsxRichText@@ -32,15 +55,21 @@   , _CellBool   , _CellRich   , _CellError+  , RowIndex(..)+  , ColumnIndex(..)   ) where  import GHC.Generics (Generic) +import Control.Applicative (liftA2) import Control.Arrow import Control.DeepSeq (NFData) import Control.Monad (forM, guard)+import Data.Bifunctor (bimap) import qualified Data.ByteString as BS import Data.Char+import Data.Maybe (isJust, fromMaybe)+import Data.Function ((&)) import Data.Ix (inRange) import qualified Data.Map as Map import Data.Text (Text)@@ -65,9 +94,29 @@ import Control.Lens(makePrisms) #endif +newtype RowIndex = RowIndex {unRowIndex :: Int}+  deriving (Eq, Ord, Show, Read, Generic, Num, Real, Enum, Integral)+newtype ColumnIndex = ColumnIndex {unColumnIndex :: Int}+  deriving (Eq, Ord, Show, Read, Generic, Num, Real, Enum, Integral)+instance NFData RowIndex+instance NFData ColumnIndex++instance ToAttrVal RowIndex where+  toAttrVal = toAttrVal . unRowIndex++{-# DEPRECATED int2col+    "this function will be removed in an upcoming release, use columnIndexToText instead." #-}+int2col :: ColumnIndex -> Text+int2col = columnIndexToText++{-# DEPRECATED col2int+    "this function will be removed in an upcoming release, use textToColumnIndex instead." #-}+col2int :: Text -> ColumnIndex+col2int = textToColumnIndex+ -- | convert column number (starting from 1) to its textual form (e.g. 3 -> \"C\")-int2col :: Int -> Text-int2col = T.pack . reverse . map int2let . base26+columnIndexToText :: ColumnIndex -> Text+columnIndexToText = T.pack . reverse . map int2let . base26 . unColumnIndex     where         int2let 0 = 'Z'         int2let x = chr $ (x - 1) + ord 'A'@@ -76,65 +125,239 @@                         i'' = if i' == 0 then 26 else i'                     in seq i' (i' : base26 ((i - i'') `div` 26)) --- | reverse to 'int2col'-col2int :: Text -> Int-col2int = T.foldl' (\i c -> i * 26 + let2int c) 0+rowIndexToText :: RowIndex -> Text+rowIndexToText = T.pack . show . unRowIndex++-- | reverse of 'columnIndexToText'+textToColumnIndex :: Text -> ColumnIndex+textToColumnIndex = ColumnIndex . T.foldl' (\i c -> i * 26 + let2int c) 0     where         let2int c = 1 + ord c - ord 'A' --- | Excel cell or cell range reference (e.g. @E3@)+textToRowIndex :: Text -> RowIndex+textToRowIndex = RowIndex . read . T.unpack++-- | Excel cell or cell range reference (e.g. @E3@), possibly absolute. -- See 18.18.62 @ST_Ref@ (p. 2482)+--+-- Note: The @ST_Ref@ type can point to another sheet (supported)+-- or a sheet in another workbook (separate .xlsx file, not implemented). newtype CellRef = CellRef   { unCellRef :: Text   } deriving (Eq, Ord, Show, Generic)- instance NFData CellRef +-- | A helper type for coordinates to carry the intent of them being relative or absolute (preceded by '$'):+--+-- > singleCellRefRaw' (RowRel 5, ColumnAbs 1) == "$A5"+data RowCoord+  = RowAbs !RowIndex+  | RowRel !RowIndex+  deriving (Eq, Ord, Show, Read, Generic)+instance NFData RowCoord++data ColumnCoord+  = ColumnAbs !ColumnIndex+  | ColumnRel !ColumnIndex+  deriving (Eq, Ord, Show, Read, Generic)+instance NFData ColumnCoord++type CellCoord = (RowCoord, ColumnCoord)++type RangeCoord = (CellCoord, CellCoord)++mkColumnCoord :: Bool -> ColumnIndex -> ColumnCoord+mkColumnCoord isAbs = if isAbs then ColumnAbs else ColumnRel++mkRowCoord :: Bool -> RowIndex -> RowCoord+mkRowCoord isAbs = if isAbs then RowAbs else RowRel++coord2col :: ColumnCoord -> Text+coord2col (ColumnAbs c) = "$" <> coord2col (ColumnRel c)+coord2col (ColumnRel c) = columnIndexToText c++col2coord :: Text -> ColumnCoord+col2coord t =+  let t' = T.stripPrefix "$" t+    in mkColumnCoord (isJust t') (textToColumnIndex (fromMaybe t t'))++coord2row :: RowCoord -> Text+coord2row (RowAbs c) = "$" <> coord2row (RowRel c)+coord2row (RowRel c) = rowIndexToText c++row2coord :: Text -> RowCoord+row2coord t =+  let t' = T.stripPrefix "$" t+    in mkRowCoord (isJust t') (textToRowIndex (fromMaybe t t'))++-- | Unwrap a Coord into an abstract Int coordinate+unRowCoord :: RowCoord -> RowIndex+unRowCoord (RowAbs i) = i+unRowCoord (RowRel i) = i++-- | Unwrap a Coord into an abstract Int coordinate+unColumnCoord :: ColumnCoord -> ColumnIndex+unColumnCoord (ColumnAbs i) = i+unColumnCoord (ColumnRel i) = i++-- | Helper function to apply the same transformation to both members of a tuple+--+-- > mapBoth Abs (1, 2) == (Abs 1, Abs 2s)+mapBoth :: (a -> b) -> (a, a) -> (b, b)+mapBoth f = bimap f f+ -- | Render position in @(row, col)@ format to an Excel reference. ----- > mkCellRef (2, 4) == "D2"-singleCellRef :: (Int, Int) -> CellRef+-- > singleCellRef (RowIndex 2, ColumnIndex 4) == CellRef "D2"+singleCellRef :: (RowIndex, ColumnIndex) -> CellRef singleCellRef = CellRef . singleCellRefRaw -singleCellRefRaw :: (Int, Int) -> Text-singleCellRefRaw (row, col) = T.concat [int2col col, T.pack (show row)]+-- | Allow specifying whether a coordinate parameter is relative or absolute.+--+-- > singleCellRef' (Rel 5, Abs 1) == CellRef "$A5"+singleCellRef' :: CellCoord -> CellRef+singleCellRef' = CellRef . singleCellRefRaw' --- | reverse to 'mkCellRef'-fromSingleCellRef :: CellRef -> Maybe (Int, Int)+singleCellRefRaw :: (RowIndex, ColumnIndex) -> Text+singleCellRefRaw (row, col) = T.concat [columnIndexToText col, rowIndexToText row]++singleCellRefRaw' :: CellCoord -> Text+singleCellRefRaw' (row, col) =+    coord2col col <> coord2row row++-- | Converse function to 'singleCellRef'+-- Ignores a potential foreign sheet prefix.+fromSingleCellRef :: CellRef -> Maybe (RowIndex, ColumnIndex) fromSingleCellRef = fromSingleCellRefRaw . unCellRef -fromSingleCellRefRaw :: Text -> Maybe (Int, Int)-fromSingleCellRefRaw t = do-  let (colT, rowT) = T.span (inRange ('A', 'Z')) t-  guard $ not (T.null colT) && not (T.null rowT) && T.all isDigit rowT-  row <- decimal rowT-  return (row, col2int colT)+-- | Converse function to 'singleCellRef\''+-- Ignores a potential foreign sheet prefix.+fromSingleCellRef' :: CellRef -> Maybe CellCoord+fromSingleCellRef' = fromSingleCellRefRaw' . unCellRef --- | reverse to 'mkCellRef' expecting valid reference and failig with+fromSingleCellRefRaw :: Text -> Maybe (RowIndex, ColumnIndex)+fromSingleCellRefRaw =+  fmap (first unRowCoord . second unColumnCoord) . fromSingleCellRefRaw'++fromSingleCellRefRaw' :: Text -> Maybe CellCoord+fromSingleCellRefRaw' t' = ignoreRefSheetName t' >>= \t -> do+    let (isColAbsolute, remT) =+          T.stripPrefix "$" t+          & \remT' -> (isJust remT', fromMaybe t remT')+    let (colT, rowExpr) = T.span (inRange ('A', 'Z')) remT+    let (isRowAbsolute, rowT) =+          T.stripPrefix "$" rowExpr+          & \rowT' -> (isJust rowT', fromMaybe rowExpr rowT')+    guard $ not (T.null colT) && not (T.null rowT) && T.all isDigit rowT+    row <- decimal rowT+    return $+      bimap+      (mkRowCoord isRowAbsolute)+      (mkColumnCoord isColAbsolute)+      (row, textToColumnIndex colT)++-- | Converse function to 'singleCellRef' expecting valid reference and failig with -- a standard error message like /"Bad cell reference 'XXX'"/-fromSingleCellRefNoting :: CellRef -> (Int, Int)+fromSingleCellRefNoting :: CellRef -> (RowIndex, ColumnIndex) fromSingleCellRefNoting ref = fromJustNote errMsg $ fromSingleCellRefRaw txt   where     txt = unCellRef ref     errMsg = "Bad cell reference '" ++ T.unpack txt ++ "'" +-- | Frame and escape the referenced sheet name in single quotes (apostrophe).+--+-- Sheet name in ST_Ref can be single-quoted when it contains non-alphanum class, non-ASCII range characters.+-- Intermediate squote characters are escaped in a doubled fashion:+-- "My ' Sheet" -> 'My '' Sheet'+escapeRefSheetName :: Text -> Text+escapeRefSheetName sheetName =+   T.concat ["'", escape sheetName, "'"]+  where+    escape sn = T.splitOn "'" sn & T.intercalate "''"++-- | Unframe and unescape the referenced sheet name.+unEscapeRefSheetName :: Text -> Text+unEscapeRefSheetName = unescape . unFrame+      where+        unescape  = T.intercalate "'" . T.splitOn "''"+        unFrame sn = fromMaybe sn $ T.stripPrefix "'" sn >>= T.stripSuffix "'"++ignoreRefSheetName :: Text -> Maybe Text+ignoreRefSheetName t =+  case T.split (== '!') t of+    [_, r] -> Just r+    [r] -> Just r+    _ -> Nothing++-- | Render a single cell existing in another worksheet.+-- This function always renders the sheet name single-quoted regardless the presence of spaces.+-- A sheet name shouldn't contain @"[]*:?/\"@ chars and apostrophe @"'"@ should not happen at extremities.+--+-- > mkForeignRange "MyOtherSheet" (Rel 2, Rel 4) (Abs 6, Abs 8) == "'MyOtherSheet'!D2:$H$6"+mkForeignSingleCellRef :: Text -> CellCoord -> CellRef+mkForeignSingleCellRef sheetName coord =+    let cr = singleCellRefRaw' coord+      in CellRef $ T.concat [escapeRefSheetName sheetName, "!", cr]++-- | Converse function to 'mkForeignSingleCellRef'.+-- The provided CellRef must be a foreign range.+fromForeignSingleCellRef :: CellRef -> Maybe (Text, CellCoord)+fromForeignSingleCellRef r =+    case T.split (== '!') (unCellRef r) of+      [sheetName, ref] -> (unEscapeRefSheetName sheetName,) <$> fromSingleCellRefRaw' ref+      _ -> Nothing+ -- | Excel range (e.g. @D13:H14@), actually store as as 'CellRef' in -- xlsx type Range = CellRef  -- | Render range ----- > mkRange (2, 4) (6, 8) == "D2:H6"-mkRange :: (Int, Int) -> (Int, Int) -> Range-mkRange fr to = CellRef $ T.concat [singleCellRefRaw fr, T.pack ":", singleCellRefRaw to]+-- > mkRange (RowIndex 2, ColumnIndex 4) (RowIndex 6, ColumnIndex 8) == CellRef "D2:H6"+mkRange :: (RowIndex, ColumnIndex) -> (RowIndex, ColumnIndex) -> Range+mkRange fr to = CellRef $ T.concat [singleCellRefRaw fr, ":", singleCellRefRaw to] --- | reverse to 'mkRange'-fromRange :: Range -> Maybe ((Int, Int), (Int, Int))+-- | Render range with possibly absolute coordinates+--+-- > mkRange' (Abs 2, Abs 4) (6, 8) == CellRef "$D$2:H6"+mkRange' :: (RowCoord,ColumnCoord) -> (RowCoord,ColumnCoord) -> Range+mkRange' fr to =+  CellRef $ T.concat [singleCellRefRaw' fr, ":", singleCellRefRaw' to]++-- | Render a cell range existing in another worksheet.+-- This function always renders the sheet name single-quoted regardless the presence of spaces.+-- A sheet name shouldn't contain @"[]*:?/\"@ chars and apostrophe @"'"@ should not happen at extremities.+--+-- > mkForeignRange "MyOtherSheet" (Rel 2, Rel 4) (Abs 6, Abs 8) == "'MyOtherSheet'!D2:$H$6"+mkForeignRange :: Text -> CellCoord -> CellCoord -> Range+mkForeignRange sheetName fr to =+    case mkRange' fr to of+      CellRef cr -> CellRef $ T.concat [escapeRefSheetName sheetName, "!", cr]++-- | Converse function to 'mkRange' ignoring absolute coordinates.+-- Ignores a potential foreign sheet prefix.+fromRange :: Range -> Maybe ((RowIndex, ColumnIndex), (RowIndex, ColumnIndex)) fromRange r =-  case T.split (== ':') (unCellRef r) of-    [from, to] -> (,) <$> fromSingleCellRefRaw from <*> fromSingleCellRefRaw to-    _ -> Nothing+  mapBoth (first unRowCoord . second unColumnCoord) <$> fromRange' r +-- | Converse function to 'mkRange\'' to handle possibly absolute coordinates.+-- Ignores a potential foreign sheet prefix.+fromRange' :: Range -> Maybe RangeCoord+fromRange' t' = parseRange =<< ignoreRefSheetName (unCellRef t')+  where+    parseRange t =+      case T.split (== ':') t of+        [from, to] -> liftA2 (,) (fromSingleCellRefRaw' from) (fromSingleCellRefRaw' to)+        _ -> Nothing++-- | Converse function to 'mkForeignRange'.+-- The provided Range must be a foreign range.+fromForeignRange :: Range -> Maybe (Text, RangeCoord)+fromForeignRange r =+    case T.split (== '!') (unCellRef r) of+      [sheetName, ref] -> (unEscapeRefSheetName sheetName,) <$> fromRange' (CellRef ref)+      _ -> Nothing+ -- | A sequence of cell references -- -- See 18.18.76 "ST_Sqref (Reference Sequence)" (p.2488)@@ -183,6 +406,9 @@ -- standard includes date format also but actually dates -- are represented by numbers with a date format assigned -- to a cell containing it+-- Specification (ECMA-376):+-- - 18.3.1.4 c (Cell)+-- - 18.18.11 ST_CellType (Cell Type) data CellValue   = CellText Text   | CellDouble Double

@@ -4,15 +4,41 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-}-module Codec.Xlsx.Types.DataValidation where+module Codec.Xlsx.Types.DataValidation+  ( ValidationExpression(..)+    , ValidationType(..)+    , dvAllowBlank+    , dvError+    , dvErrorStyle+    , dvErrorTitle+    , dvPrompt+    , dvPromptTitle+    , dvShowDropDown+    , dvShowErrorMessage+    , dvShowInputMessage+    , dvValidationType+    , ErrorStyle(..)+    , DataValidation(..)+    , ListOrRangeExpression(..)+    , ValidationList+    , maybePlainValidationList+    , maybeValidationRange+    , readValidationType+    , readListFormulas+    , readOpExpression2+    , readValidationTypeOpExp+    , readValExpression+    , viewValidationExpression+  ) where +import Control.Applicative ((<|>)) import Control.DeepSeq (NFData) #ifdef USE_MICROLENS import Lens.Micro.TH (makeLenses) #else import Control.Lens.TH (makeLenses) #endif-import Control.Monad ((>=>))+import Control.Monad ((>=>), guard) import Data.ByteString (ByteString) import Data.Char (isSpace) import Data.Default@@ -48,13 +74,21 @@     | ValidationTypeCustom     Formula     | ValidationTypeDate       ValidationExpression     | ValidationTypeDecimal    ValidationExpression-    | ValidationTypeList       [Text]+    | ValidationTypeList       ListOrRangeExpression     | ValidationTypeTextLength ValidationExpression     | ValidationTypeTime       ValidationExpression     | ValidationTypeWhole      ValidationExpression     deriving (Eq, Show, Generic) instance NFData ValidationType +type ValidationList = [Text]++data ListOrRangeExpression+  = ListExpression ValidationList -- ^ a plain list of elements+  | RangeExpression Range -- ^ a cell or range reference+  deriving (Eq, Show, Generic)+instance NFData ListOrRangeExpression+ -- See 18.18.18 "ST_DataValidationErrorStyle (Data Validation Error Styles)" (p. 2438/2448) data ErrorStyle     = ErrorStyleInformation@@ -183,20 +217,39 @@     opExp <- readOpExpression2 op cur     readValidationTypeOpExp ty opExp -readListFormulas :: Formula -> Maybe [Text]-readListFormulas (Formula f) = readQuotedList f+-- | Attempt to obtain a plain list expression+maybePlainValidationList :: ValidationType -> Maybe ValidationList+maybePlainValidationList (ValidationTypeList (ListExpression le)) = Just le+maybePlainValidationList _ = Nothing++-- | Attempt to obtain a range expression+maybeValidationRange :: ValidationType -> Maybe Range+maybeValidationRange (ValidationTypeList (RangeExpression re)) = Just re+maybeValidationRange _ = Nothing++readListFormulas :: Formula -> Maybe ListOrRangeExpression+readListFormulas (Formula f) = readQuotedList f <|> readUnquotedCellRange f   where     readQuotedList t         | Just t'  <- T.stripPrefix "\"" (T.dropAround isSpace t)         , Just t'' <- T.stripSuffix "\"" t'-        = Just $ map (T.dropAround isSpace) $ T.splitOn "," t''+        = Just . ListExpression $ map (T.dropAround isSpace) $ T.splitOn "," t''         | otherwise = Nothing+    readUnquotedCellRange t =+      -- a CellRef expression of a range (this is not validated beyond the absence of quotes)+      -- note that the foreign sheet name can be 'single-quoted'+      let stripped = T.dropAround isSpace t+        in RangeExpression (CellRef stripped) <$ guard (not (T.null stripped))   -- This parser expects a comma-separated list surrounded by quotation marks.   -- Spaces around the quotation marks and commas are removed, but inner spaces   -- are kept.   --   -- The parser seems to be consistent with how Excel treats list formulas, but   -- I wasn't able to find a specification of the format.+  --+  -- Addendum: <dataValidation type="list" ...> undescriminately designates an actual list or a cell range.+  -- For a cell range validation, instead of a quoted list, it's an unquoted CellRef-like contents of the form:+  -- ActualSheetName!$C$2:$C$18  readOpExpression2 :: Text -> Cursor -> [ValidationExpression] readOpExpression2 op cur@@ -281,7 +334,14 @@           ValidationTypeTime f       -> opExp $ viewValidationExpression f           ValidationTypeWhole f      -> opExp $ viewValidationExpression f           ValidationTypeList as      ->-            let f = Formula $ "\"" <> T.intercalate "," as <> "\""+            let renderPlainList l =+                  let csvFy xs = T.intercalate "," xs+                      reQuote x = '"' `T.cons`  x `T.snoc` '"'+                    in reQuote (csvFy l)+                f = Formula $+                      case as of+                        RangeExpression re -> unCellRef re+                        ListExpression le -> renderPlainList le             in  (Nothing, Just f, Nothing)  viewValidationExpression :: ValidationExpression -> (Text, Formula, Maybe Formula)

@@ -10,6 +10,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Text (Text)+import qualified Data.Text as Text import Data.Text.Lazy (toStrict) import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder.Int as B@@ -27,6 +28,9 @@     { _commentsTable :: Map CellRef Comment }     deriving (Eq, Show, Generic) +tshow :: Show a => a -> Text+tshow = Text.pack . show+ fromList :: [(CellRef, Comment)] -> CommentTable fromList = CommentTable . M.fromList @@ -51,7 +55,8 @@       commentToEl (ref, Comment{..}) = Element           { elementName = "comment"           , elementAttributes = M.fromList [ ("ref" .= ref)-                                           , ("authorId" .= lookupAuthor _commentAuthor)]+                                           , ("authorId" .= lookupAuthor _commentAuthor)+                                           , ("visible" .= tshow _commentVisible)]           , elementNodes      = [NodeElement $ toElement "text" _commentText]           }       lookupAuthor a = fromJustNote "author lookup" $ M.lookup a authorIds@@ -73,8 +78,10 @@     ref <- fromAttribute "ref" cur     txt <- cur $/ element (n_ "text") >=> fromCursor     authorId <- cur $| attribute "authorId" >=> decimal+    visible <- (read . Text.unpack :: Text -> Bool)+      <$> (fromAttribute "visible" cur :: [Text])     let author = fromJustNote "authorId" $ M.lookup authorId authors-    return (ref, Comment txt author True)+    return (ref, Comment txt author visible)  -- | helper to render comment baloons vml file, -- currently uses fixed shape@@ -95,7 +102,8 @@         , "<v:path gradientshapeok=\"t\" o:connecttype=\"rect\"></v:path>"         , "</v:shapetype>"         ]-    fromRef = fromJustNote "Invalid comment ref" . fromSingleCellRef+    fromRef cr =+      fromJustNote ("Invalid comment ref: " <> show cr) $ fromSingleCellRef cr     commentShapes = [ commentShape (fromRef ref) (_commentVisible cmnt)                     | (ref, cmnt) <- M.toList m ]     commentShape (r, c) v = LB.concat

@@ -89,7 +89,7 @@                     (customPropsXml (CustomProperties customProps)) ],                   [ ("custom-properties", "docProps/custom.xml") ])     workbookFiles = bookFiles xlsx-    sheetNames = xlsx ^. xlSheets . to (map fst)+    sheetNames = xlsx ^. xlSheets & mapped %~ fst  singleSheetFiles :: Int                  -> Cells@@ -164,7 +164,7 @@  sheetDataXml ::      Cells-  -> Map Int RowProperties+  -> Map RowIndex RowProperties   -> Map SharedFormulaIndex SharedFormulaOptions   -> [Element] sheetDataXml rows rh sharedFormulas =@@ -398,7 +398,7 @@ refFileDataToRel basePath (i, FileData {..}) =     relEntry i fdRelType (fdPath `relFrom` basePath) -type Cells = [(Int, [(Int, XlsxCell)])]+type Cells = [(RowIndex, [(ColumnIndex, XlsxCell)])]  coreXml :: UTCTime -> Text -> L.ByteString coreXml created creator =@@ -489,7 +489,7 @@ bookFiles xlsx = runST $ do   ref <- newSTRef 1   ssRId <- nextRefId ref-  let sheets = xlsx ^. xlSheets . to (map snd)+  let sheets = xlsx ^. xlSheets & mapped %~ snd       shared = sstConstruct sheets       sharedStrings =         (ssRId, FileData "xl/sharedStrings.xml" (smlCT "sharedStrings") "sharedStrings" $@@ -514,7 +514,10 @@     (sheetFile, others) <- singleSheetFiles i cells pvTables sheet tblIdRef     return ((rId, sheetFile), others)   let sheetFiles = map fst allSheetFiles-      sheetNameByRId = zip (map fst sheetFiles) (xlsx ^. xlSheets . to (map fst))+      sheetAttrsByRId =+        zipWith (\(rId, _) (name, sheet) -> (rId, name, sheet ^. wsState))+          sheetFiles+          (xlsx ^. xlSheets)       sheetOthers = concatMap snd allSheetFiles   cacheRefFDsById <- forM cacheIdFiles $ \(cacheId, fd) -> do       refId <- nextRefId ref@@ -522,7 +525,7 @@   let cacheRefsById = [ (cId, rId) | (cId, (rId, _)) <- cacheRefFDsById ]       cacheRefs = map snd cacheRefFDsById       bookFile = FileData "xl/workbook.xml" (smlCT "sheet.main") "officeDocument" $-                 bookXml sheetNameByRId (xlsx ^. xlDefinedNames) cacheRefsById (xlsx ^. xlDateBase)+                 bookXml sheetAttrsByRId (xlsx ^. xlDefinedNames) cacheRefsById (xlsx ^. xlDateBase)       rels = FileData "xl/_rels/workbook.xml.rels"              "application/vnd.openxmlformats-package.relationships+xml"              "relationships" relsXml@@ -533,12 +536,12 @@       otherFiles = concat [rels:(map snd referenced), pivotOtherFiles, sheetOthers]   return $ bookFile:otherFiles -bookXml :: [(RefId, Text)]+bookXml :: [(RefId, Text, SheetState)]         -> DefinedNames         -> [(CacheId, RefId)]         -> DateBase         -> L.ByteString-bookXml rIdNames (DefinedNames names) cacheIdRefs dateBase =+bookXml rIdAttrs (DefinedNames names) cacheIdRefs dateBase =   renderLBS def {rsNamespaces = nss} $ Document (Prologue [] Nothing []) root []   where     nss = [ ("r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships") ]@@ -557,8 +560,8 @@             "sheets"             [ leafElement               "sheet"-              ["name" .= name, "sheetId" .= i, (odr "id") .= rId]-            | (i, (rId, name)) <- zip [(1 :: Int) ..] rIdNames+              ["name" .= name, "sheetId" .= i, "state" .= state, (odr "id") .= rId]+            | (i, (rId, name, state)) <- zip [(1 :: Int) ..] rIdAttrs             ]           , elementListSimple             "definedNames"

@@ -304,7 +304,7 @@  mapRow :: MonadReader SheetWriteSettings m => Map Text Int -> Row -> ConduitT Row Event m () mapRow sharedStrings' sheetItem = do-  mRowProp <- preview $ wsRowProperties . ix rowIx . rowHeightLens . _Just . failing _CustomHeight _AutomaticHeight+  mRowProp <- preview $ wsRowProperties . ix (unRowIndex rowIx) . rowHeightLens . _Just . failing _CustomHeight _AutomaticHeight   let rowAttr :: Attributes       rowAttr = ixAttr <> fold (attr "ht" . txtd <$> mRowProp)   tag (n_ "row") rowAttr $@@ -313,14 +313,16 @@     rowIx = sheetItem ^. ri_row_index     ixAttr = attr "r" $ toAttrVal rowIx -mapCell :: Monad m => Map Text Int -> Int -> Int -> Cell -> ConduitT Row Event m ()-mapCell sharedStrings' rix cix cell =+mapCell ::+  Monad m => Map Text Int -> RowIndex -> Int -> Cell -> ConduitT Row Event m ()+mapCell sharedStrings' rix cix' cell =   when (has (cellValue . _Just) cell || has (cellStyle . _Just) cell) $   tag (n_ "c") celAttr $     when (has (cellValue . _Just) cell) $     el (n_ "v") $       content $ renderCell sharedStrings' cell   where+    cix = ColumnIndex cix'     celAttr  = attr "r" ref <>       renderCellType sharedStrings' cell       <> foldMap (attr "s" . txti) (cell ^. cellStyle)

@@ -1,3 +1,7 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Common   ( parseBS   , cursorFromElement@@ -7,10 +11,15 @@ import Text.XML.Cursor  import Codec.Xlsx.Parser.Internal+import Codec.Xlsx.Types (SheetState (..)) import Codec.Xlsx.Writer.Internal +import Test.SmallCheck.Series (Serial)+ parseBS :: FromCursor a => ByteString -> [a] parseBS = fromCursor . fromDocument . parseLBS_ def  cursorFromElement :: Element -> Cursor cursorFromElement = fromNode . NodeElement . addNS mainNamespace Nothing++instance Monad m  => Serial m SheetState

@@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  module CommonTests   ( tests@@ -10,20 +12,25 @@ import Data.Time.Calendar (fromGregorian) import Data.Time.Clock (UTCTime(..)) import Test.Tasty.SmallCheck (testProperty)-import Test.SmallCheck.Series-       (Positive(..), Serial(..), newtypeCons, cons0, (\/))+import Test.SmallCheck.Series as Series+  ( Positive(..)+  , Serial(..)+  , newtypeCons+  , cons0+  , (\/)+  ) import Test.Tasty (testGroup, TestTree) import Test.Tasty.HUnit (testCase, (@?=))  import Codec.Xlsx.Types.Common +import qualified CommonTests.CellRefTests as CellRefTests+ tests :: TestTree tests =   testGroup     "Types.Common tests"-    [ testProperty "col2int . int2col == id" $-        \(Positive i) -> i == col2int (int2col i)-    , testCase "date conversions" $ do+    [ testCase "date conversions" $ do         dateFromNumber DateBase1900 (- 2338.0) @?= read "1893-08-06 00:00:00 UTC"         dateFromNumber DateBase1900 2.0 @?= read "1900-01-02 00:00:00 UTC"         dateFromNumber DateBase1900 3687.0 @?= read "1910-02-03 00:00:00 UTC"@@ -49,6 +56,7 @@        -- Because excel treats 1900 as a leap year, dateToNumber and dateFromNumber        -- aren't inverses of each other in the range n E [60, 61[ for DateBase1900        \b (n :: Pico) -> (n >= 60 && n < 61 && b == DateBase1900) || n == dateToNumber b (dateFromNumber b $ n)+     , CellRefTests.tests     ]  instance Monad m => Serial m (Fixed E12) where

@@ -0,0 +1,182 @@++{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE ViewPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module CommonTests.CellRefTests+  ( tests+  ) where++import qualified Control.Applicative as Alt+import Control.Monad+import Data.Char (chr, isPrint)+import qualified Data.List as L+import Data.Text (Text)+import qualified Data.Text as T+import Data.Word (Word8)+import Test.SmallCheck.Series as Series (NonEmpty (..), Positive (..),+                                         Serial (..), cons1, cons2, generate,+                                         (\/))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.SmallCheck (testProperty)++import Codec.Xlsx.Types.Common++tests :: TestTree+tests =+  testGroup+    "Types.Common CellRef tests"+  [ testProperty "textToColumnIndex . columnIndexToText == id" $+        \(Positive i) -> i == textToColumnIndex (columnIndexToText i)++    , testProperty "row2coord . coord2row = id" $+        \(r :: RowCoord) -> r == row2coord (coord2row r)++    , testProperty "col2coord . coord2col = id" $+        \(c :: ColumnCoord) -> c == col2coord (coord2col c)++    , testProperty "fromSingleCellRef' . singleCellRef' = pure" $+        \(cellCoord :: CellCoord) -> pure cellCoord == fromSingleCellRef' (singleCellRef' cellCoord)++    , testProperty "fromRange' . mkRange' = pure" $+        \(range :: RangeCoord) -> pure range == fromRange' (uncurry mkRange' range)++    , testProperty "fromForeignSingleCellRef . mkForeignSingleCellRef = pure" $+        \(viewForeignCellParams -> params) ->+            pure params == fromForeignSingleCellRef (uncurry mkForeignSingleCellRef params)++    , testProperty "fromSingleCellRef' . mkForeignSingleCellRef = pure . snd" $+        \(viewForeignCellParams -> (nStr, cellCoord)) ->+            pure cellCoord == fromSingleCellRef' (mkForeignSingleCellRef nStr cellCoord)++    , testProperty "fromForeignSingleCellRef . singleCellRef' = const empty" $+        \(cellCoord :: CellCoord) ->+            Alt.empty == fromForeignSingleCellRef (singleCellRef' cellCoord)++    , testProperty "fromForeignRange . mkForeignRange = pure" $+        \(viewForeignRangeParams -> params@(nStr, (start, end))) ->+            pure params == fromForeignRange (mkForeignRange nStr start end)++    , testProperty "fromRange' . mkForeignRange = pure . snd" $+        \(viewForeignRangeParams -> (nStr, range@(start, end))) ->+            pure range == fromRange' (mkForeignRange nStr start end)++    , testProperty "fromForeignRange . mkRange' = const empty" $+        \(range :: RangeCoord) ->+            Alt.empty == fromForeignRange (uncurry mkRange' range)++    , testCase "building single CellRefs" $ do+        singleCellRef' (RowRel 5, ColumnRel 25) @?= CellRef "Y5"+        singleCellRef' (RowRel 5, ColumnAbs 25) @?= CellRef "$Y5"+        singleCellRef' (RowAbs 5, ColumnRel 25) @?= CellRef "Y$5"+        singleCellRef' (RowAbs 5, ColumnAbs 25) @?= CellRef "$Y$5"+        singleCellRef (5, 25) @?= CellRef "Y5"+    , testCase "parsing single CellRefs as abstract coordinates" $ do+        fromSingleCellRef (CellRef "Y5") @?= Just (5, 25)+        fromSingleCellRef (CellRef "$Y5") @?= Just (5, 25)+        fromSingleCellRef (CellRef "Y$5") @?= Just (5, 25)+        fromSingleCellRef (CellRef "$Y$5") @?= Just (5, 25)+    , testCase "parsing single CellRefs as potentially absolute coordinates" $ do+        fromSingleCellRef' (CellRef "Y5") @?= Just (RowRel 5, ColumnRel 25)+        fromSingleCellRef' (CellRef "$Y5") @?= Just (RowRel 5, ColumnAbs 25)+        fromSingleCellRef' (CellRef "Y$5") @?= Just (RowAbs 5, ColumnRel 25)+        fromSingleCellRef' (CellRef "$Y$5") @?= Just (RowAbs 5, ColumnAbs 25)+        fromSingleCellRef' (CellRef "$Y$50") @?= Just (RowAbs 50, ColumnAbs 25)+        fromSingleCellRef' (CellRef "$Y$5$0") @?= Nothing+        fromSingleCellRef' (CellRef "Y5:Z10") @?= Nothing+    , testCase "building ranges" $ do+        mkRange (5, 25) (10, 26) @?= CellRef "Y5:Z10"+        mkRange' (RowRel 5, ColumnRel 25) (RowRel 10, ColumnRel 26) @?= CellRef "Y5:Z10"+        mkRange' (RowAbs 5, ColumnAbs 25) (RowAbs 10, ColumnAbs 26) @?= CellRef "$Y$5:$Z$10"+        mkRange' (RowRel 5, ColumnAbs 25) (RowAbs 10, ColumnRel 26) @?= CellRef "$Y5:Z$10"+        mkForeignRange "myWorksheet" (RowRel 5, ColumnAbs 25) (RowAbs 10, ColumnRel 26) @?= CellRef "'myWorksheet'!$Y5:Z$10"+        mkForeignRange "my sheet" (RowRel 5, ColumnAbs 25) (RowAbs 10, ColumnRel 26) @?= CellRef "'my sheet'!$Y5:Z$10"+    , testCase "parsing ranges CellRefs as abstract coordinates" $ do+        fromRange (CellRef "Y5:Z10") @?= Just ((5, 25), (10, 26))+        fromRange (CellRef "$Y$5:$Z$10") @?= Just ((5, 25), (10, 26))+        fromRange (CellRef "myWorksheet!$Y5:Z$10") @?= Just ((5, 25), (10, 26))+    , testCase "parsing ranges CellRefs as potentially absolute coordinates" $ do+        fromRange' (CellRef "Y5:Z10") @?= Just ((RowRel 5, ColumnRel 25), (RowRel 10, ColumnRel 26))+        fromRange' (CellRef "$Y$5:$Z$10") @?= Just ((RowAbs 5, ColumnAbs 25), (RowAbs 10, ColumnAbs 26))+        fromRange' (CellRef "myWorksheet!$Y5:Z$10") @?= Just ((RowRel 5, ColumnAbs 25), (RowAbs 10, ColumnRel 26))+        fromForeignRange (CellRef "myWorksheet!$Y5:Z$10") @?= Just ("myWorksheet", ((RowRel 5, ColumnAbs 25), (RowAbs 10, ColumnRel 26)))+        fromForeignRange (CellRef "'myWorksheet'!Y5:Z10") @?= Just ("myWorksheet", ((RowRel 5, ColumnRel 25), (RowRel 10, ColumnRel 26)))+        fromForeignRange (CellRef "'my sheet'!Y5:Z10") @?= Just ("my sheet", ((RowRel 5, ColumnRel 25), (RowRel 10, ColumnRel 26)))+        fromForeignRange (CellRef "$Y5:Z$10") @?= Nothing+  ]++instance Monad m => Serial m RowIndex where+  series = cons1 (RowIndex . getPositive)++instance Monad m => Serial m ColumnIndex where+  series = cons1 (ColumnIndex . getPositive)++instance Monad m => Serial m RowCoord where+  series = cons1 (RowAbs . getPositive) \/ cons1 (RowRel . getPositive)++instance Monad m => Serial m ColumnCoord where+  series = cons1 (ColumnAbs . getPositive) \/ cons1 (ColumnRel . getPositive)++-- | Allow defining an instance to generate valid foreign range params+data MkForeignRangeRef =+  MkForeignRangeRef NameString RangeCoord+  deriving (Show)++viewForeignRangeParams :: MkForeignRangeRef -> (Text, RangeCoord)+viewForeignRangeParams (MkForeignRangeRef nameStr range) = (nameString nameStr, range)++instance Monad m => Serial m MkForeignRangeRef where+  series = cons2 MkForeignRangeRef++-- | Allow defining an instance to generate valid foreign cellref params+data MkForeignCellRef =+  MkForeignCellRef NameString CellCoord+  deriving (Show)++viewForeignCellParams :: MkForeignCellRef -> (Text, CellCoord)+viewForeignCellParams (MkForeignCellRef nameStr coord) = (nameString nameStr, coord)++instance Monad m => Serial m MkForeignCellRef where+  series = cons2 MkForeignCellRef++-- | Overload an instance for allowed sheet name chars+newtype NameChar =+  NameChar { _unNCh :: Char }+  deriving (Show, Eq)++-- | Instance for Char which broadens the pool to permitted ascii and some wchars+-- as @Serial m Char@ is only @[ 'A' .. 'Z' ]@+instance Monad m => Serial m NameChar where+  series =+    fmap NameChar $+      let wChars = ['é', '€', '愛']+          startSeq = "ab cd'" -- single quote is permitted as long as it's not 1st or last+          authorizedAscii =+            let asciiRange = L.map (chr . fromIntegral) [minBound @Word8 .. maxBound `div` 2]+                forbiddenClass = "[]*:?/\\" :: String+                isAuthorized c = isPrint c && not (c `L.elem` forbiddenClass)+                isPlanned c = isAuthorized c && not (c `L.elem` startSeq)+              in L.filter isPlanned asciiRange+        in generate $ \d -> take (d + 1) $ startSeq ++ wChars ++ authorizedAscii++-- | Allow defining an instance to generate valid sheetnames (non-empty, valid char set, squote rule)+newtype NameString =+  NameString { _unNS :: Series.NonEmpty NameChar }+  deriving (Show)++nameString :: NameString -> Text+nameString = T.pack . L.map _unNCh . getNonEmpty . _unNS++instance Monad m => Serial m NameString where+  series = fmap NameString $+    series @m @(Series.NonEmpty NameChar) >>= \t -> t <$ guard (isOk t)+        where+          -- squote isn't permitted at the beginning and the end of a sheet's name+          isOk (getNonEmpty -> s) =+            head s /= NameChar '\'' &&+            last s /= NameChar '\''

@@ -1,32 +1,31 @@+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedLists   #-} {-# LANGUAGE OverloadedStrings #-} module Main   ( main   ) where -import Control.Monad.State.Lazy+#ifdef USE_MICROLENS+import Lens.Micro+#else+import Control.Lens+#endif import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as LB-import Data.Map (Map) import qualified Data.Map as M-import Data.Time.Clock.POSIX (POSIXTime)-import qualified Data.Vector as V+import Data.Maybe (listToMaybe)+import Data.Text (Text) import qualified StreamTests-import Text.RawString.QQ import Text.XML  import Test.Tasty (defaultMain, testGroup)-import Test.Tasty.HUnit (testCase)+import Test.Tasty.HUnit (testCase, (@=?))+import Test.Tasty.SmallCheck (testProperty) -import Test.Tasty.HUnit ((@=?)) import TestXlsx  import Codec.Xlsx import Codec.Xlsx.Formatted-import Codec.Xlsx.Types.Internal-import Codec.Xlsx.Types.Internal.CommentTable-import Codec.Xlsx.Types.Internal.CustomProperties as CustomProperties-import Codec.Xlsx.Types.Internal.SharedStringTable  import AutoFilterTests import Common@@ -72,12 +71,38 @@         let fmtd = formatted testFormattedCells minimalStyleSheet         testFormattedCells @==? toFormattedCells (formattedCellMap fmtd) (formattedMerges fmtd)                                                  (formattedStyleSheet fmtd)-    , testCase "proper results from `conditionalltyFormatted`" $+    , testCase "proper results from `conditionallyFormatted`" $         testCondFormattedResult @==? testRunCondFormatted     , testCase "toXlsxEither: properly formatted" $         Right testXlsx @==? toXlsxEither (fromXlsx testTime testXlsx)     , testCase "toXlsxEither: invalid format" $         Left (InvalidZipArchive "Did not find end of central directory signature") @==? toXlsxEither "this is not a valid XLSX file"+    , testCase "toXlsx: correct floats parsing (typed and untyped cells are floats by default)"+        $ floatsParsingTests toXlsx+    , testCase "toXlsxFast: correct floats parsing (typed and untyped cells are floats by default)"+        $ floatsParsingTests toXlsxFast+    , testGroup "Codec: sheet state visibility"+        [ testGroup "toXlsxEitherFast"+            [ testProperty "pure state == toXlsxEitherFast (fromXlsx (defXlsxWithState state))" $+                \state ->+                    (Right (Just state) ==) $+                    fmap sheetStateOfDefXlsx $+                    toXlsxEitherFast . fromXlsx testTime $+                    defXlsxWithState state+            , testCase "should otherwise infer visible state by default" $+                Right (Just Visible) @=? (fmap sheetStateOfDefXlsx . toXlsxEitherFast) (fromXlsx testTime defXlsx)+            ]+        , testGroup "toXlsxEither"+            [ testProperty "pure state == toXlsxEither (fromXlsx (defXlsxWithState state))" $+                \state ->+                    (Right (Just state) ==) $+                    fmap sheetStateOfDefXlsx $+                    toXlsxEither . fromXlsx testTime $+                    defXlsxWithState state+            , testCase "should otherwise infer visible state by default" $+                Right (Just Visible) @=? (fmap sheetStateOfDefXlsx . toXlsxEither) (fromXlsx testTime defXlsx)+            ]+        ]     , CommonTests.tests     , CondFmtTests.tests     , PivotTableTests.tests@@ -85,3 +110,30 @@     , AutoFilterTests.tests     , StreamTests.tests     ]++floatsParsingTests :: (ByteString -> Xlsx) -> IO ()+floatsParsingTests parser = do+  bs <- LB.readFile "data/floats.xlsx"+  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)+        ]+  expectedCells @==? parsedCells++constSheetName :: Text+constSheetName = "sheet1"++defXlsx :: Xlsx+defXlsx = def & atSheet constSheetName ?~ def++defXlsxWithState :: SheetState -> Xlsx+defXlsxWithState state =+    def & atSheet constSheetName ?~ (wsState .~ state $ def)++sheetStateOfDefXlsx :: Xlsx -> Maybe SheetState+sheetStateOfDefXlsx xlsx =+  xlsx ^. atSheet constSheetName & mapped %~ _wsState

@@ -23,45 +23,35 @@ import Control.Exception import Codec.Xlsx import Codec.Xlsx.Parser.Stream-import Codec.Xlsx.Types.Common-import Codec.Xlsx.Types.Internal.SharedStringTable import Conduit ((.|)) import qualified Conduit as C-import Control.Exception (bracket) import Control.Lens hiding (indexed) import Data.Set.Lens-import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString as BS import Data.Map (Map) import qualified Data.Map as M-import qualified Data.Map as Map import qualified Data.IntMap.Strict as IM-import Data.Maybe (mapMaybe) import Data.Text (Text)-import qualified Data.Text as T import qualified Data.Text as Text-import Data.Vector (Vector, indexed, toList) import Diff-import System.Directory (getTemporaryDirectory)-import System.FilePath.Posix-import Test.Tasty (TestName, TestTree, testGroup)+import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import TestXlsx-import Text.RawString.QQ-import Text.XML import qualified Codec.Xlsx.Writer.Stream as SW import qualified Codec.Xlsx.Writer.Internal.Stream as SW import Control.Monad.State.Lazy import Test.Tasty.SmallCheck+import Test.SmallCheck.Series.Instances () import qualified Data.Set as Set import Data.Set (Set) import Text.Printf-import Debug.Trace-import Control.DeepSeq import Data.Conduit-import Codec.Xlsx.Formatted +tshow :: Show a => a -> Text+tshow = Text.pack . show++toBs :: Xlsx -> BS.ByteString toBs = LB.toStrict . fromXlsx testTime  tests :: TestTree@@ -90,6 +80,10 @@        testGroup "Reader/inline strings"       [ testCase "Can parse row with inline strings" inlineStringsAreParsed+      ],++      testGroup "Reader/floats parsing"+      [ testCase "Can parse untyped values as floats" untypedCellsAreParsedAsFloats       ]     ] @@ -134,9 +128,10 @@  -- can we do xx simpleWorkbook :: Xlsx-simpleWorkbook = set xlSheets sheets def+simpleWorkbook = def & atSheet "Sheet1" ?~ sheet   where-    sheets = [("Sheet1" , toWs [((1,1), a1), ((1,2), cellValue ?~ CellText "text at B1 Sheet1" $ def)])]+    sheet = toWs [ ((RowIndex 1, ColumnIndex 1), a1)+                 , ((RowIndex 1, ColumnIndex 2), cellValue ?~ CellText "text at B1 Sheet1" $ def) ]  a1 :: Cell a1 = cellValue ?~ CellText "text at A1 Sheet1" $ cellStyle ?~ 1 $ def@@ -144,15 +139,12 @@ -- can we do x --           x simpleWorkbookRow :: Xlsx-simpleWorkbookRow = set xlSheets sheets def+simpleWorkbookRow = def & atSheet "Sheet1" ?~ sheet   where-    sheets = [("Sheet1" , toWs [((1,1), a1), ((2,1), cellValue ?~ CellText "text at A2 Sheet1" $ def)])]---tshow :: Show a => a -> Text-tshow = Text.pack . show+    sheet = toWs [ ((RowIndex 1, ColumnIndex 1), a1)+                 , ((RowIndex 2, ColumnIndex 1), cellValue ?~ CellText "text at A2 Sheet1" $ def) ] -toWs :: [((Int,Int), Cell)] -> Worksheet+toWs :: [((RowIndex, ColumnIndex), Cell)] -> Worksheet toWs x = set wsCells (M.fromList x) def  -- can we do xxx@@ -160,25 +152,44 @@ --           . --           . smallWorkbook :: Xlsx-smallWorkbook = set xlSheets sheets def+smallWorkbook = def & atSheet "Sheet1" ?~ sheet   where-    sheets = [("Sheet1" , toWs $ [1..2] >>= \row ->+    sheet = toWs $ [1..2] >>= \row ->                   [((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,5), def & cellValue ?~ CellBool False)                   ]-              )]+--    sheets = [("Sheet1" , toWs $ [1..2] >>= \row ->+--        [ ((RowIndex row, ColumnIndex 1), a1)+--        , ((RowIndex row, ColumnIndex 2),+--            def & cellValue ?~ CellText ("text at B"<> tshow row <> " Sheet1"))+--        , ((RowIndex row, ColumnIndex 3),+--            def & cellValue ?~ CellText "text at C1 Sheet1")+--        , ((RowIndex row, ColumnIndex 4),+--            def & cellValue ?~ CellDouble (0.2 + 0.1))+--        , ((RowIndex row, ColumnIndex 5),+--            def & cellValue ?~ CellBool False)+--        ]+--      )]+ bigWorkbook :: Xlsx-bigWorkbook = set xlSheets sheets def+bigWorkbook = def & atSheet "Sheet1" ?~ sheet   where-    sheets = [("Sheet1" , toWs $ [1..512] >>= \row ->+    sheet = toWs $ [1..512] >>= \row ->                   [((row,1), a1)                   ,((row,2), def & cellValue ?~ CellText ("text at B"<> tshow row <> " Sheet1"))                   ,((row,3), def & cellValue ?~ CellText "text at C1 Sheet1")                   ]-              )]+--    sheets = [("Sheet1" , toWs $ [1..512] >>= \row ->+--        [((RowIndex row, ColumnIndex 1), a1)+--        ,((RowIndex row, ColumnIndex 2),+--            def & cellValue ?~ CellText ("text at B"<> tshow row <> " Sheet1"))+--        ,((RowIndex row, ColumnIndex 3),+--            def & cellValue ?~ CellText "text at C1 Sheet1")+--        ]+--      )]  inlineStringsAreParsed :: IO () inlineStringsAreParsed = do@@ -204,5 +215,21 @@             ]         ]   expected @==? (items ^.. traversed . si_row . ri_cell_row)++untypedCellsAreParsedAsFloats :: IO ()+untypedCellsAreParsedAsFloats = do+  -- values in that file are under `General` cell-type and are not marked+  -- 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) ]+        -- 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) ]+        ]+  expected @==? (_ri_cell_row . _si_row <$> items)  #endif

@@ -7,13 +7,12 @@ module TestXlsx where  #ifdef USE_MICROLENS-import           Lens.Micro.Platform+import Lens.Micro.Platform #else import Control.Lens #endif import Control.Monad.State.Lazy import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as LB import Data.Map (Map) import qualified Data.Map as M import Data.Time.Clock.POSIX (POSIXTime)@@ -21,11 +20,6 @@ import Text.RawString.QQ import Text.XML -import Test.Tasty (defaultMain, testGroup)-import Test.Tasty.HUnit (testCase)--import Test.Tasty.HUnit ((@=?))- import Codec.Xlsx import Codec.Xlsx.Formatted import Codec.Xlsx.Types.Internal@@ -34,11 +28,6 @@        as CustomProperties import Codec.Xlsx.Types.Internal.SharedStringTable -import AutoFilterTests-import Common-import CommonTests-import CondFmtTests-import Diff import PivotTableTests import DrawingTests @@ -46,10 +35,17 @@ testXlsx = Xlsx sheets minimalStyles definedNames customProperties DateBase1904   where     sheets =-      [("List1", sheet1), ("Another sheet", sheet2), ("with pivot table", pvSheet)]+      [ ("List1", sheet1)+      , ("Another sheet", sheet2)+      , ("with pivot table", pvSheet)+      , ("cellrange DV source", foreignDvSourceSheet) -- "foreign" sheet holding validation data+      , ("cellrange DV test", foreignDvTestSheet) -- applies validation using foreign cell ranges+      , ("hidden sheet", def & wsState .~ Hidden & cellValueAt (1,1) ?~ CellText "I'm hidden!")+      , ("VERY hidden sheet", def & wsState .~ VeryHidden & cellValueAt (1,1) ?~ CellText "I'm VERY hidden!!")+      ]     sheet1 = Worksheet cols rowProps testCellMap1 drawing ranges       sheetViews pageSetup cFormatting validations [] (Just autoFilter)-      tables (Just protection) sharedFormulas+      tables (Just protection) sharedFormulas def     sharedFormulas =       M.fromList         [ (SharedFormulaIndex 0, SharedFormulaOptions (CellRef "A5:C5") (Formula "A4"))@@ -76,6 +72,10 @@       , _sprLegacyPassword = Just $ legacyPassword "hard password"       }     sheet2 = def & wsCells .~ testCellMap2+    foreignDvSourceSheet = def & wsCells .~ cellRangeDvSourceMap+    foreignDvTestSheet = def &  wsDataValidations .~ foreignValidations &+                                wsCells . at (1, 1) ?~+                                    (def & cellValue ?~ CellText ("Hi! try " <> unCellRef testForeignDvRange))     pvSheet = sheetWithPvCells & wsPivotTables .~ [testPivotTable]     sheetWithPvCells = def & wsCells .~ testPivotSrcCells     rowProps = M.fromList [(1, RowProps { rowHeight       = Just (CustomHeight 50)@@ -164,6 +164,18 @@     cd6_2 = def & cellFormula ?~ sharedFormulaByIndex (SharedFormulaIndex 1)     cd6_3 = def & cellFormula ?~ sharedFormulaByIndex (SharedFormulaIndex 1) +cellRangeDvSourceMap :: CellMap+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)+                                    , ((3, 2), def & cellValue ?~ CellText "numbers!")+                                    , ((3, 3), def & cellValue ?~ CellDouble 5)+                                  ]+ testCellMap2 :: CellMap testCellMap2 = M.fromList [ ((1, 2), def & cellValue ?~ CellText "something here")                           , ((3, 5), def & cellValue ?~ CellDouble 123.456)@@ -245,7 +257,7 @@  testCommentTable :: CommentTable testCommentTable = CommentTable $ M.fromList-    [ (CellRef "D4", Comment (XlsxRichText rich) "Bob" True)+    [ (CellRef "D4", Comment (XlsxRichText rich) "Bob" False)     , (CellRef "A2", Comment (XlsxText "Some comment here") "CBR" True) ]   where     rich = [ RichTextRun@@ -313,7 +325,7 @@     <author>CBR</author>   </authors>   <commentList>-    <comment ref="D4" authorId="0">+    <comment ref="D4" authorId="0" visible="False">       <text>         <r>           <rPr>@@ -331,7 +343,7 @@         </r>       </text>     </comment>-    <comment ref="A2" authorId="1">+    <comment ref="A2" authorId="1" visible="True">       <text><t>Some comment here</t></text>     </comment>   </commentList>@@ -439,17 +451,15 @@ testFormatWorkbookResult = def & xlSheets .~ sheets                                & xlStyles .~ renderStyleSheet style   where-    testCellMap1 = M.fromList [((1, 1), Cell { _cellStyle   = Nothing-                                             , _cellValue   = Just (CellText "text at A1 Sheet1")-                                             , _cellComment = Nothing-                                             , _cellFormula = Nothing })]-    testCellMap2 = M.fromList [((2, 3), Cell { _cellStyle   = Just 1-                                             , _cellValue   = Just (CellDouble 1.23456)-                                             , _cellComment = Nothing-                                             , _cellFormula = Nothing })]-    sheets = [ ("Sheet1", def & wsCells .~ testCellMap1)-             , ("Sheet2", def & wsCells .~ testCellMap2)-             ]+    cellMap1 = M.fromList [((1, 1), Cell { _cellStyle   = Nothing+                                              , _cellValue   = Just (CellText "text at A1 Sheet1")+                                              , _cellComment = Nothing+                                              , _cellFormula = Nothing })]+    cellMap2 = M.fromList [((2, 3), Cell { _cellStyle   = Just 1+                                              , _cellValue   = Just (CellDouble 1.23456)+                                              , _cellComment = Nothing+                                              , _cellFormula = Nothing })]+    sheets = [ ("Sheet1", def & wsCells .~ cellMap1) , ("Sheet2", def & wsCells .~ cellMap2) ]     style = minimalStyleSheet & styleSheetNumFmts .~ M.fromList [(164, "DD.MM.YYYY")]                               & styleSheetCellXfs .~ [cellXf1, cellXf2]     cellXf1 = def@@ -497,15 +507,16 @@         , _cfrPriority   = 1         , _cfrStopIfTrue = Nothing } -testFormattedCells :: Map (Int, Int) FormattedCell+testFormattedCells :: Map (RowIndex, ColumnIndex) FormattedCell testFormattedCells = flip execState def $ do-    at (1,1) ?= (def & formattedRowSpan .~ 5+    at (1, 1) ?=+                  (def & formattedRowSpan .~ 5                      & formattedColSpan .~ 5                      & formattedFormat . formatBorder . non def . borderTop .                                                         non def . borderStyleLine ?~ LineStyleDashed                      & formattedFormat . formatBorder . non def . borderBottom .                                                         non def . borderStyleLine ?~ LineStyleDashed)-    at (10,2) ?= (def & formattedFormat . formatFont . non def . fontBold ?~ True)+    at (10, 2) ?= (def & formattedFormat . formatFont . non def . fontBold ?~ True)  testRunCondFormatted :: CondFormatted testRunCondFormatted = conditionallyFormatted condFmts minimalStyleSheet@@ -536,7 +547,7 @@         , _dvShowDropDown     = True         , _dvShowErrorMessage = True         , _dvShowInputMessage = True-        , _dvValidationType   = ValidationTypeList ["aaaa","bbbb","cccc"]+        , _dvValidationType   = ValidationTypeList $ ListExpression ["aaaa","bbbb","cccc"]         }       )     , ( SqRef [CellRef "A6", CellRef "I2"], def@@ -566,3 +577,23 @@         }       )     ]++testForeignDvRange :: Range+testForeignDvRange = CellRef "B2:B7"++foreignValidations :: Map SqRef DataValidation+foreignValidations = M.fromList+  [ ( SqRef [testForeignDvRange], def+        { _dvAllowBlank       = True+        , _dvError            = Just "incorrect data"+        , _dvErrorStyle       = ErrorStyleInformation+        , _dvErrorTitle       = Just "error title"+        , _dvPrompt           = Just "Input kebab string"+        , _dvPromptTitle      = Just "I love kebab-case"+        , _dvShowDropDown     = True+        , _dvShowErrorMessage = True+        , _dvShowInputMessage = True+        , _dvValidationType   = ValidationTypeList $ RangeExpression $ CellRef "'cellrange DV source'!$A$1:$B$2"+        }+      )+  ]

@@ -1,6 +1,6 @@ Name:                xlsx -Version:             1.0.0.1+Version:             1.1.0  Synopsis:            Simple and incomplete Excel file parser/writer Description:@@ -129,7 +129,7 @@                      , indexed-traversable     cpp-options: -DUSE_MICROLENS   else-    Build-depends:     lens         >= 3.8 && < 5.2+    Build-depends:     lens         >= 3.8 && < 5.3    Default-Language:     Haskell2010   Other-Extensions:  DeriveDataTypeable@@ -148,6 +148,7 @@   other-modules: AutoFilterTests                , Common                , CommonTests+               , CommonTests.CellRefTests                , CondFmtTests                , Diff                , DrawingTests