From 14e1cfb7c98ecba8674f4683f1046436728770f7 Mon Sep 17 00:00:00 2001 From: Luke Date: Wed, 17 Aug 2022 20:08:35 +0100 Subject: [PATCH 1/6] Issue 148: add newtype for column and row indices. Also refactor the codebase accordingly. --- src/Codec/Xlsx/Formatted.hs | 39 +++++----- src/Codec/Xlsx/Lens.hs | 18 ++--- src/Codec/Xlsx/Parser.hs | 38 +++++----- src/Codec/Xlsx/Parser/Stream.hs | 10 +-- src/Codec/Xlsx/Types.hs | 7 +- src/Codec/Xlsx/Types/Cell.hs | 2 +- src/Codec/Xlsx/Types/Common.hs | 123 ++++++++++++++++++++------------ src/Codec/Xlsx/Writer.hs | 4 +- src/Codec/Xlsx/Writer/Stream.hs | 8 ++- 9 files changed, 144 insertions(+), 105 deletions(-) diff --git a/src/Codec/Xlsx/Formatted.hs b/src/Codec/Xlsx/Formatted.hs index 175b2dcc..ef2ce049 100644 --- a/src/Codec/Xlsx/Formatted.hs +++ b/src/Codec/Xlsx/Formatted.hs @@ -234,7 +234,7 @@ data Formatted = Formatted { -- -- 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 @@ -246,7 +246,8 @@ formatted cs styleSheet = } -- | Build an 'Xlsx', render provided cells as per the 'StyleSheet'. -formatWorkbook :: [(Text, Map (Int, Int) FormattedCell)] -> StyleSheet -> Xlsx +formatWorkbook :: + [(Text, Map (RowIndex, ColumnIndex) FormattedCell)] -> StyleSheet -> Xlsx formatWorkbook nfcss initStyle = extract go where initSt = stateFromStyleSheet initStyle @@ -263,7 +264,7 @@ formatWorkbook nfcss initStyle = extract go -- | 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{..} = @@ -301,11 +302,14 @@ toFormattedCells m merges StyleSheet{..} = applyMerges $ M.map toFormattedCell m 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 @@ -334,13 +338,15 @@ conditionallyFormatted cfs styleSheet = CondFormatted -------------------------------------------------------------------------------} -- | 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}) @@ -354,11 +360,11 @@ formatCell (row, col) cell = do -- 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] @@ -368,7 +374,7 @@ cellBlock (row, col) cell@FormattedCell{..} = (block, merge) 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 @@ -376,18 +382,19 @@ cellBlock (row, col) cell@FormattedCell{..} = (block, merge) 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 diff --git a/src/Codec/Xlsx/Lens.hs b/src/Codec/Xlsx/Lens.hs index f15f6912..f07b2581 100644 --- a/src/Codec/Xlsx/Lens.hs +++ b/src/Codec/Xlsx/Lens.hs @@ -74,43 +74,43 @@ atSheet s = xlSheets . \f -> fmap unSheetList . at s f . SheetList -- | 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 diff --git a/src/Codec/Xlsx/Parser.hs b/src/Codec/Xlsx/Parser.hs index 166863a1..3b96659e 100644 --- a/src/Codec/Xlsx/Parser.hs +++ b/src/Codec/Xlsx/Parser.hs @@ -249,18 +249,18 @@ extractSheetFast ar sst contentTypes caches wf = do 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 = @@ -270,10 +270,10 @@ extractSheetFast ar sst contentTypes caches wf = do 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 @@ -294,7 +294,7 @@ extractSheetFast ar sst contentTypes caches wf = do cellNodes <- collectChildren row $ childList "c" cells <- forM cellNodes parseCell return - ( r + ( RowIndex r , if props == def then Nothing else Just props @@ -310,8 +310,8 @@ extractSheetFast ar sst contentTypes caches wf = do -- parseCell :: Xeno.Node - -> Either Text ( Int - , Int + -> Either Text ( RowIndex + , ColumnIndex , Cell , Maybe (SharedFormulaIndex, SharedFormulaOptions)) parseCell cell = do @@ -384,11 +384,11 @@ extractSheet ar sst contentTypes caches wf = do 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 @@ -406,7 +406,7 @@ extractSheet ar sst contentTypes caches wf = do ) 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 @@ -427,11 +427,11 @@ extractSheet ar sst contentTypes caches wf = do 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] diff --git a/src/Codec/Xlsx/Parser/Stream.hs b/src/Codec/Xlsx/Parser/Stream.hs index 7c29d41a..4ee5cc78 100644 --- a/src/Codec/Xlsx/Parser/Stream.hs +++ b/src/Codec/Xlsx/Parser/Stream.hs @@ -134,7 +134,7 @@ data SheetItem = MkSheetItem 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 ExcelValueType 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 @@ addCellToRow txt = do 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 @@ -709,7 +709,7 @@ parseType list = -- | 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 diff --git a/src/Codec/Xlsx/Types.hs b/src/Codec/Xlsx/Types.hs index c239fee3..58c6dd7e 100644 --- a/src/Codec/Xlsx/Types.hs +++ b/src/Codec/Xlsx/Types.hs @@ -269,7 +269,8 @@ instance ToAttrVal SheetState where -- | 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 @@ -389,7 +390,7 @@ parseStyleSheet (Styles bs) = parseLBS def bs >>= parseDoc -- | 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 @@ -398,7 +399,7 @@ toRows cells = 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 diff --git a/src/Codec/Xlsx/Types/Cell.hs b/src/Codec/Xlsx/Types/Cell.hs index 8279f773..c7867fbf 100644 --- a/src/Codec/Xlsx/Types/Cell.hs +++ b/src/Codec/Xlsx/Types/Cell.hs @@ -115,7 +115,7 @@ makeLenses ''Cell -- | 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 diff --git a/src/Codec/Xlsx/Types/Common.hs b/src/Codec/Xlsx/Types/Common.hs index 424b0aaa..1ef16308 100644 --- a/src/Codec/Xlsx/Types/Common.hs +++ b/src/Codec/Xlsx/Types/Common.hs @@ -5,13 +5,12 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + module Codec.Xlsx.Types.Common ( CellRef(..) - , Coord(..) , CellCoord , RangeCoord - , mkCoord - , unCoord , mapBoth , col2coord , coord2col @@ -42,8 +41,8 @@ module Codec.Xlsx.Types.Common , DateBase(..) , dateFromNumber , dateToNumber - , int2col - , col2int + , columnIndexToText -- previously int2col + , textToColumnIndex -- previously col2int -- ** prisms , _XlsxText , _XlsxRichText @@ -52,6 +51,8 @@ module Codec.Xlsx.Types.Common , _CellBool , _CellRich , _CellError + , RowIndex(..) + , ColumnIndex(..) ) where import GHC.Generics (Generic) @@ -89,9 +90,19 @@ import Data.Profunctor(dimap) 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 + -- | 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' @@ -100,9 +111,12 @@ int2col = T.pack . reverse . map int2let . base26 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' @@ -118,42 +132,56 @@ instance NFData CellRef -- | A helper type for coordinates to carry the intent of them being relative or absolute (preceded by '$'): -- --- > singleCellRefRaw' (Rel 5, Abs 1) == "$A5" -data Coord - = Abs !Int - | Rel !Int +-- > singleCellRefRaw' (RowRel 5, ColumnAbs 1) == "$A5" +data RowCoord + = RowAbs !RowIndex + | RowRel !RowIndex deriving (Eq, Ord, Show, Read, Generic) -instance NFData Coord +instance NFData RowCoord -type CellCoord = (Coord, Coord) +data ColumnCoord + = ColumnAbs !ColumnIndex + | ColumnRel !ColumnIndex + deriving (Eq, Ord, Show, Read, Generic) +instance NFData ColumnCoord + +type CellCoord = (RowCoord, ColumnCoord) type RangeCoord = (CellCoord, CellCoord) -mkCoord :: Bool -> Int -> Coord -mkCoord isAbs = if isAbs then Abs else Rel +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 :: Coord -> Text -coord2col (Abs c) = "$" <> coord2col (Rel c) -coord2col (Rel c) = int2col c +coord2col :: ColumnCoord -> Text +coord2col (ColumnAbs c) = "$" <> coord2col (ColumnRel c) +coord2col (ColumnRel c) = columnIndexToText c -col2coord :: Text -> Coord +col2coord :: Text -> ColumnCoord col2coord t = let t' = T.stripPrefix "$" t - in mkCoord (isJust t') (col2int (fromMaybe t t')) + in mkColumnCoord (isJust t') (textToColumnIndex (fromMaybe t t')) -coord2row :: Coord -> Text -coord2row (Abs c) = "$" <> coord2row (Rel c) -coord2row (Rel c) = T.pack $ show c +coord2row :: RowCoord -> Text +coord2row (RowAbs c) = "$" <> coord2row (RowRel c) +coord2row (RowRel c) = rowIndexToText c -row2coord :: Text -> Coord +row2coord :: Text -> RowCoord row2coord t = let t' = T.stripPrefix "$" t - in mkCoord (isJust t') . read . T.unpack $ fromMaybe t t' + in mkRowCoord (isJust t') . read . T.unpack $ 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 -unCoord :: Coord -> Int -unCoord (Abs i) = i -unCoord (Rel i) = i +unColumnCoord :: ColumnCoord -> ColumnIndex +unColumnCoord (ColumnAbs i) = i +unColumnCoord (ColumnRel i) = i -- | Helper function to apply the same transformation to both members of a tuple -- @@ -163,8 +191,8 @@ mapBoth f = bimap f f -- | Render position in @(row, col)@ format to an Excel reference. -- --- > singleCellRef (2, 4) == CellRef "D2" -singleCellRef :: (Int, Int) -> CellRef +-- > singleCellRef (RowIndex 2, ColumnIndex 4) == CellRef "D2" +singleCellRef :: (RowIndex, ColumnIndex) -> CellRef singleCellRef = CellRef . singleCellRefRaw -- | Allow specifying whether a coordinate parameter is relative or absolute. @@ -173,8 +201,8 @@ singleCellRef = CellRef . singleCellRefRaw singleCellRef' :: CellCoord -> CellRef singleCellRef' = CellRef . singleCellRefRaw' -singleCellRefRaw :: (Int, Int) -> Text -singleCellRefRaw = singleCellRefRaw' . mapBoth Rel +singleCellRefRaw :: (RowIndex, ColumnIndex) -> Text +singleCellRefRaw (row, col) = T.concat [columnIndexToText col, T.pack (show row)] singleCellRefRaw' :: CellCoord -> Text singleCellRefRaw' (row, col) = @@ -182,7 +210,7 @@ singleCellRefRaw' (row, col) = -- | Converse function to 'singleCellRef' -- Ignores a potential foreign sheet prefix. -fromSingleCellRef :: CellRef -> Maybe (Int, Int) +fromSingleCellRef :: CellRef -> Maybe (RowIndex, ColumnIndex) fromSingleCellRef = fromSingleCellRefRaw . unCellRef -- | Converse function to 'singleCellRef\'' @@ -190,8 +218,9 @@ fromSingleCellRef = fromSingleCellRefRaw . unCellRef fromSingleCellRef' :: CellRef -> Maybe CellCoord fromSingleCellRef' = fromSingleCellRefRaw' . unCellRef -fromSingleCellRefRaw :: Text -> Maybe (Int, Int) -fromSingleCellRefRaw = fmap (mapBoth unCoord) . fromSingleCellRefRaw' +fromSingleCellRefRaw :: Text -> Maybe (RowIndex, ColumnIndex) +fromSingleCellRefRaw = + fmap (first unRowCoord . second unColumnCoord) . fromSingleCellRefRaw' fromSingleCellRefRaw' :: Text -> Maybe CellCoord fromSingleCellRefRaw' t' = ignoreRefSheetName t' >>= \t -> do @@ -206,13 +235,13 @@ fromSingleCellRefRaw' t' = ignoreRefSheetName t' >>= \t -> do row <- decimal rowT return $ bimap - (mkCoord isRowAbsolute) - (mkCoord isColAbsolute) - (row, col2int colT) + (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 @@ -267,14 +296,14 @@ type Range = CellRef -- | Render range -- --- > mkRange (2, 4) (6, 8) == CellRef "D2:H6" -mkRange :: (Int, Int) -> (Int, Int) -> Range +-- > 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] -- | Render range with possibly absolute coordinates -- -- > mkRange' (Abs 2, Abs 4) (6, 8) == CellRef "$D$2:H6" -mkRange' :: (Coord,Coord) -> (Coord,Coord) -> Range +mkRange' :: (RowCoord,ColumnCoord) -> (RowCoord,ColumnCoord) -> Range mkRange' fr to = CellRef $ T.concat [singleCellRefRaw' fr, ":", singleCellRefRaw' to] @@ -290,9 +319,9 @@ mkForeignRange sheetName fr to = -- | Converse function to 'mkRange' ignoring absolute coordinates. -- Ignores a potential foreign sheet prefix. -fromRange :: Range -> Maybe ((Int, Int), (Int, Int)) +fromRange :: Range -> Maybe ((RowIndex, ColumnIndex), (RowIndex, ColumnIndex)) fromRange r = - mapBoth (mapBoth unCoord) <$> fromRange' r + mapBoth (first unRowCoord . second unColumnCoord) <$> fromRange' r -- | Converse function to 'mkRange\'' to handle possibly absolute coordinates. -- Ignores a potential foreign sheet prefix. diff --git a/src/Codec/Xlsx/Writer.hs b/src/Codec/Xlsx/Writer.hs index 1375184a..f7f77c1b 100644 --- a/src/Codec/Xlsx/Writer.hs +++ b/src/Codec/Xlsx/Writer.hs @@ -164,7 +164,7 @@ nextRefId r = do sheetDataXml :: Cells - -> Map Int RowProperties + -> Map RowIndex RowProperties -> Map SharedFormulaIndex SharedFormulaOptions -> [Element] sheetDataXml rows rh sharedFormulas = @@ -398,7 +398,7 @@ refFileDataToRel :: FilePath -> ReferencedFileData -> (RefId, Relationship) 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 = diff --git a/src/Codec/Xlsx/Writer/Stream.hs b/src/Codec/Xlsx/Writer/Stream.hs index ce57600c..0c10ea5c 100644 --- a/src/Codec/Xlsx/Writer/Stream.hs +++ b/src/Codec/Xlsx/Writer/Stream.hs @@ -304,7 +304,7 @@ writeWorkSheet sharedStrings' = doc (n_ "worksheet") $ do 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 @@ mapRow sharedStrings' sheetItem = do 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) From d06b38c7fb6671c9599df5542515eb6c59fd7090 Mon Sep 17 00:00:00 2001 From: Luke Date: Wed, 31 Aug 2022 16:30:15 +0100 Subject: [PATCH 2/6] Fix compile errors on test code --- src/Codec/Xlsx/Types/Common.hs | 2 ++ test/CommonTests/CellRefTests.hs | 60 ++++++++++++++++++-------------- test/StreamTests.hs | 29 +++++++++++++-- test/TestXlsx.hs | 9 ++--- 4 files changed, 68 insertions(+), 32 deletions(-) diff --git a/src/Codec/Xlsx/Types/Common.hs b/src/Codec/Xlsx/Types/Common.hs index 1ef16308..7346fda4 100644 --- a/src/Codec/Xlsx/Types/Common.hs +++ b/src/Codec/Xlsx/Types/Common.hs @@ -9,6 +9,8 @@ module Codec.Xlsx.Types.Common ( CellRef(..) + , RowCoord(..) + , ColumnCoord(..) , CellCoord , RangeCoord , mapBoth diff --git a/test/CommonTests/CellRefTests.hs b/test/CommonTests/CellRefTests.hs index 7c28cc26..4ddf4932 100644 --- a/test/CommonTests/CellRefTests.hs +++ b/test/CommonTests/CellRefTests.hs @@ -31,14 +31,14 @@ tests :: TestTree tests = testGroup "Types.Common CellRef tests" - [ testProperty "col2int . int2col == id" $ - \(Positive i) -> i == col2int (int2col i) + [ testProperty "textToColumnIndex . columnIndexToText == id" $ + \(Positive i) -> i == textToColumnIndex (columnIndexToText i) , testProperty "row2coord . coord2row = id" $ - \(r :: Coord) -> r == row2coord (coord2row r) + \(r :: RowCoord) -> r == row2coord (coord2row r) , testProperty "col2coord . coord2col = id" $ - \(c :: Coord) -> c == col2coord (coord2col c) + \(c :: ColumnCoord) -> c == col2coord (coord2col c) , testProperty "fromSingleCellRef' . singleCellRef' = pure" $ \(cellCoord :: CellCoord) -> pure cellCoord == fromSingleCellRef' (singleCellRef' cellCoord) @@ -71,10 +71,10 @@ tests = Alt.empty == fromForeignRange (uncurry mkRange' range) , testCase "building single CellRefs" $ do - singleCellRef' (mapBoth Rel (5, 25)) @?= CellRef "Y5" - singleCellRef' (Rel 5, Abs 25) @?= CellRef "$Y5" - singleCellRef' (Abs 5, Rel 25) @?= CellRef "Y$5" - singleCellRef' (mapBoth Abs (5, 25)) @?= CellRef "$Y$5" + 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) @@ -82,37 +82,45 @@ tests = 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 (mapBoth Rel (5, 25)) - fromSingleCellRef' (CellRef "$Y5") @?= Just (Rel 5, Abs 25) - fromSingleCellRef' (CellRef "Y$5") @?= Just (Abs 5, Rel 25) - fromSingleCellRef' (CellRef "$Y$5") @?= Just (mapBoth Abs (5, 25)) - fromSingleCellRef' (CellRef "$Y$50") @?= Just (mapBoth Abs (50, 25)) + 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' (mapBoth Rel (5, 25)) (mapBoth Rel (10, 26)) @?= CellRef "Y5:Z10" - mkRange' (mapBoth Abs (5, 25)) (mapBoth Abs (10, 26)) @?= CellRef "$Y$5:$Z$10" - mkRange' (Rel 5, Abs 25) (Abs 10, Rel 26) @?= CellRef "$Y5:Z$10" - mkForeignRange "myWorksheet" (Rel 5, Abs 25) (Abs 10, Rel 26) @?= CellRef "'myWorksheet'!$Y5:Z$10" - mkForeignRange "my sheet" (Rel 5, Abs 25) (Abs 10, Rel 26) @?= CellRef "'my sheet'!$Y5:Z$10" + 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 (mapBoth (mapBoth Rel) ((5, 25), (10, 26))) - fromRange' (CellRef "$Y$5:$Z$10") @?= Just (mapBoth (mapBoth Abs) ((5, 25), (10, 26))) - fromRange' (CellRef "myWorksheet!$Y5:Z$10") @?= Just ((Rel 5, Abs 25), (Abs 10, Rel 26)) - fromForeignRange (CellRef "myWorksheet!$Y5:Z$10") @?= Just ("myWorksheet", ((Rel 5, Abs 25), (Abs 10, Rel 26))) - fromForeignRange (CellRef "'myWorksheet'!Y5:Z10") @?= Just ("myWorksheet", mapBoth (mapBoth Rel) ((5, 25), (10, 26))) - fromForeignRange (CellRef "'my sheet'!Y5:Z10") @?= Just ("my sheet", mapBoth (mapBoth Rel) ((5, 25), (10, 26))) + 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 Coord where - series = cons1 (Abs . getPositive) \/ cons1 (Rel . 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 = diff --git a/test/StreamTests.hs b/test/StreamTests.hs index 401e212f..e10ef490 100644 --- a/test/StreamTests.hs +++ b/test/StreamTests.hs @@ -131,6 +131,9 @@ simpleWorkbook :: Xlsx simpleWorkbook = def & atSheet "Sheet1" ?~ sheet where sheet = toWs [((1,1), a1), ((1,2), cellValue ?~ CellText "text at B1 Sheet1" $ def)] +-- sheets = [("Sheet1" , 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 @@ -141,8 +144,11 @@ simpleWorkbookRow :: Xlsx simpleWorkbookRow = def & atSheet "Sheet1" ?~ sheet where sheet = toWs [((1,1), a1), ((2,1), cellValue ?~ CellText "text at A2 Sheet1" $ def)] +-- sheets = [("Sheet1" , 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 @@ -159,6 +165,18 @@ smallWorkbook = def & atSheet "Sheet1" ?~ sheet , ((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 = def & atSheet "Sheet1" ?~ sheet @@ -168,7 +186,14 @@ bigWorkbook = def & atSheet "Sheet1" ?~ sheet ,((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 diff --git a/test/TestXlsx.hs b/test/TestXlsx.hs index 122ae28c..32ac3efa 100644 --- a/test/TestXlsx.hs +++ b/test/TestXlsx.hs @@ -507,15 +507,16 @@ testCondFormattedResult = CondFormatted styleSheet formattings , _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 (RowIndex 1, ColumnIndex 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 (RowIndex 10, ColumnIndex 2) ?= (def & formattedFormat . formatFont . non def . fontBold ?~ True) testRunCondFormatted :: CondFormatted testRunCondFormatted = conditionallyFormatted condFmts minimalStyleSheet @@ -595,4 +596,4 @@ foreignValidations = M.fromList , _dvValidationType = ValidationTypeList $ RangeExpression $ CellRef "'cellrange DV source'!$A$1:$B$2" } ) - ] \ No newline at end of file + ] From c64a3217d6b13397105c6e7f4735779a3759ee8c Mon Sep 17 00:00:00 2001 From: Luke Date: Wed, 31 Aug 2022 19:48:49 +0100 Subject: [PATCH 3/6] Fix all but 3 test cases --- src/Codec/Xlsx/Types/Common.hs | 7 +++++-- src/Codec/Xlsx/Types/Internal/CommentTable.hs | 3 ++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Codec/Xlsx/Types/Common.hs b/src/Codec/Xlsx/Types/Common.hs index 7346fda4..2f76d929 100644 --- a/src/Codec/Xlsx/Types/Common.hs +++ b/src/Codec/Xlsx/Types/Common.hs @@ -122,6 +122,9 @@ textToColumnIndex = ColumnIndex . T.foldl' (\i c -> i * 26 + let2int c) 0 where let2int c = 1 + ord c - ord 'A' +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) -- @@ -173,7 +176,7 @@ coord2row (RowRel c) = rowIndexToText c row2coord :: Text -> RowCoord row2coord t = let t' = T.stripPrefix "$" t - in mkRowCoord (isJust t') . read . T.unpack $ fromMaybe t t' + in mkRowCoord (isJust t') (textToRowIndex (fromMaybe t t')) -- | Unwrap a Coord into an abstract Int coordinate unRowCoord :: RowCoord -> RowIndex @@ -204,7 +207,7 @@ singleCellRef' :: CellCoord -> CellRef singleCellRef' = CellRef . singleCellRefRaw' singleCellRefRaw :: (RowIndex, ColumnIndex) -> Text -singleCellRefRaw (row, col) = T.concat [columnIndexToText col, T.pack (show row)] +singleCellRefRaw (row, col) = T.concat [columnIndexToText col, rowIndexToText row] singleCellRefRaw' :: CellCoord -> Text singleCellRefRaw' (row, col) = diff --git a/src/Codec/Xlsx/Types/Internal/CommentTable.hs b/src/Codec/Xlsx/Types/Internal/CommentTable.hs index 15c6e5e6..05c0f238 100644 --- a/src/Codec/Xlsx/Types/Internal/CommentTable.hs +++ b/src/Codec/Xlsx/Types/Internal/CommentTable.hs @@ -102,7 +102,8 @@ renderShapes (CommentTable m) = LB.concat , "" , "" ] - 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 From 439fae71d841fdcdc75969f9cf16f6fb1b427660 Mon Sep 17 00:00:00 2001 From: Luke Date: Wed, 31 Aug 2022 20:03:19 +0100 Subject: [PATCH 4/6] Remove boilerplate that is inferred from compiler anyway --- test/TestXlsx.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/TestXlsx.hs b/test/TestXlsx.hs index 32ac3efa..1ca4bb77 100644 --- a/test/TestXlsx.hs +++ b/test/TestXlsx.hs @@ -509,14 +509,14 @@ testCondFormattedResult = CondFormatted styleSheet formattings testFormattedCells :: Map (RowIndex, ColumnIndex) FormattedCell testFormattedCells = flip execState def $ do - at (RowIndex 1, ColumnIndex 1) ?= + 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 (RowIndex 10, ColumnIndex 2) ?= (def & formattedFormat . formatFont . non def . fontBold ?~ True) + at (10, 2) ?= (def & formattedFormat . formatFont . non def . fontBold ?~ True) testRunCondFormatted :: CondFormatted testRunCondFormatted = conditionallyFormatted condFmts minimalStyleSheet From 53ffbc47980c630eee00da108b0927f39ef67bdb Mon Sep 17 00:00:00 2001 From: Luke Date: Thu, 8 Sep 2022 11:12:58 +0100 Subject: [PATCH 5/6] Mark int2col and col2int as deprecated, rather than removing them. --- src/Codec/Xlsx/Types/Common.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/Codec/Xlsx/Types/Common.hs b/src/Codec/Xlsx/Types/Common.hs index 2f76d929..3ffa66b5 100644 --- a/src/Codec/Xlsx/Types/Common.hs +++ b/src/Codec/Xlsx/Types/Common.hs @@ -43,8 +43,10 @@ module Codec.Xlsx.Types.Common , DateBase(..) , dateFromNumber , dateToNumber - , columnIndexToText -- previously int2col - , textToColumnIndex -- previously col2int + , int2col + , col2int + , columnIndexToText + , textToColumnIndex -- ** prisms , _XlsxText , _XlsxRichText @@ -102,6 +104,14 @@ instance NFData ColumnIndex instance ToAttrVal RowIndex where toAttrVal = toAttrVal . unRowIndex + -- | DEPRECATED: this function will be removed in an upcoming release, use + -- columnIndexToText instead. +int2col = columnIndexToText + + -- | DEPRECATED: this function will be removed in an upcoming release, use + -- textToColumnIndex instead. +col2int = textToColumnIndex + -- | convert column number (starting from 1) to its textual form (e.g. 3 -> \"C\") columnIndexToText :: ColumnIndex -> Text columnIndexToText = T.pack . reverse . map int2let . base26 . unColumnIndex From 22211048e98bf76edd28a207a3151251dbe1de17 Mon Sep 17 00:00:00 2001 From: Luke Date: Fri, 9 Sep 2022 10:51:26 +0100 Subject: [PATCH 6/6] Use DEPRECATED pragma and remove obsolete comments. --- src/Codec/Xlsx/Types/Common.hs | 10 ++++++---- test/StreamTests.hs | 12 ++++-------- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/src/Codec/Xlsx/Types/Common.hs b/src/Codec/Xlsx/Types/Common.hs index 3ffa66b5..1ad8208e 100644 --- a/src/Codec/Xlsx/Types/Common.hs +++ b/src/Codec/Xlsx/Types/Common.hs @@ -104,12 +104,14 @@ instance NFData ColumnIndex instance ToAttrVal RowIndex where toAttrVal = toAttrVal . unRowIndex - -- | DEPRECATED: this function will be removed in an upcoming release, use - -- columnIndexToText instead. +{-# DEPRECATED int2col + "this function will be removed in an upcoming release, use columnIndexToText instead." #-} +int2col :: ColumnIndex -> Text int2col = columnIndexToText - -- | DEPRECATED: this function will be removed in an upcoming release, use - -- textToColumnIndex instead. +{-# 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\") diff --git a/test/StreamTests.hs b/test/StreamTests.hs index e10ef490..bb8ffc45 100644 --- a/test/StreamTests.hs +++ b/test/StreamTests.hs @@ -130,10 +130,8 @@ sharedStringInputTextsIsSameAsValueSetLength someTexts = simpleWorkbook :: Xlsx simpleWorkbook = def & atSheet "Sheet1" ?~ sheet where - sheet = toWs [((1,1), a1), ((1,2), cellValue ?~ CellText "text at B1 Sheet1" $ def)] --- sheets = [("Sheet1" , toWs --- [ ((RowIndex 1, ColumnIndex 1), a1) --- , ((RowIndex 1, ColumnIndex 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 @@ -143,10 +141,8 @@ a1 = cellValue ?~ CellText "text at A1 Sheet1" $ cellStyle ?~ 1 $ def simpleWorkbookRow :: Xlsx simpleWorkbookRow = def & atSheet "Sheet1" ?~ sheet where - sheet = toWs [((1,1), a1), ((2,1), cellValue ?~ CellText "text at A2 Sheet1" $ def)] --- sheets = [("Sheet1" , toWs --- [ ((RowIndex 1, ColumnIndex 1), a1) --- , ((RowIndex 2, ColumnIndex 1), cellValue ?~ CellText "text at A2 Sheet1" $ def)])] + sheet = toWs [ ((RowIndex 1, ColumnIndex 1), a1) + , ((RowIndex 2, ColumnIndex 1), cellValue ?~ CellText "text at A2 Sheet1" $ def) ] toWs :: [((RowIndex, ColumnIndex), Cell)] -> Worksheet toWs x = set wsCells (M.fromList x) def