diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,17 @@ `gridtables` uses [PVP Versioning][]. +## gridtables-0.0.3.0 + +Released 2022-08-18. + +- Missing cells no longer cause an error, but are replaced with + empty cells. + +- The borders of the last cell in a row are allowed to be + shorter than the cell. Previously the last column was + discarded in that case. + ## gridtables-0.0.2.0 Released 2022-07-30. diff --git a/gridtables.cabal b/gridtables.cabal --- a/gridtables.cabal +++ b/gridtables.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: gridtables -version: 0.0.2.0 +version: 0.0.3.0 synopsis: Parser for reStructuredText-style grid tables. description: Provides a parser for plain-text representations of tables. This package supports table headers, cells diff --git a/src/Text/GridTable/Trace.hs b/src/Text/GridTable/Trace.hs --- a/src/Text/GridTable/Trace.hs +++ b/src/Text/GridTable/Trace.hs @@ -26,6 +26,7 @@ import Data.Array.MArray import Data.Array.ST import Data.Function (on) +import Data.List (foldl') import Data.Maybe (fromMaybe) import Data.Set (Set) import Data.Text (Text) @@ -72,6 +73,26 @@ | Missing -- ^ padding for short lines deriving stock (Eq) +-- | Info on the grid. Used to keep track of information collected while +-- tracing a character grid. The set of cells is used as a kind of queue +-- during parsing, while the other data is required to assemble the +-- final table. +data TraceInfo = TraceInfo + { gridRowSeps :: Set CharRow + , gridColSeps :: Set CharCol + , gridCorners :: Set CharIndex + , gridCells :: Set CellTrace + } + +-- | Initial tracing info. +initialTraceInfo :: TraceInfo +initialTraceInfo = TraceInfo + { gridRowSeps = Set.fromList [CharRow 1] + , gridColSeps = Set.fromList [CharCol 1] + , gridCorners = Set.fromList [(CharRow 1, CharCol 1)] + , gridCells = Set.empty + } + -- | Converts a list of lines into a char array. toCharGrid :: [Text] -> CharGrid toCharGrid lines = @@ -179,26 +200,6 @@ _ -> pure () return mutGrid --- | Info on the grid. Used to keep track of information collected while --- tracing a character grid. The set of cells is used as a kind of queue --- during parsing, while the other data is required to assemble the --- final table. -data TraceInfo = TraceInfo - { gridRowSeps :: Set CharRow - , gridColSeps :: Set CharCol - , gridCorners :: Set CharIndex - , gridCells :: Set CellTrace - } - --- | Initial tracing info. -initialTraceInfo :: TraceInfo -initialTraceInfo = TraceInfo - { gridRowSeps = Set.fromList [CharRow 1] - , gridColSeps = Set.fromList [CharCol 1] - , gridCorners = Set.fromList [(CharRow 1, CharCol 1)] - , gridCells = Set.fromList [] - } - -- | Trace the given char grid and collect all relevant info. -- This function calls itself recursively. traceCharGrid :: CharGrid @@ -256,7 +257,8 @@ C '+' -> let colseps' = Set.insert j colseps in case scanDown charGrid start j of - Nothing -> loop colseps' (j + 1) + Nothing -> loop colseps' (j + 1) <|> + lastCellInRow charGrid start (j + 1) Just (end, rowseps, newcolseps) -> pure ( end , rowseps @@ -302,7 +304,7 @@ go j (Just colseps) = case charGrid ! (bottom, j) of C '+' -> Just (Set.insert j colseps) C '-' -> Just colseps - _ -> Nothing + _ -> Nothing in if charGrid ! (bottom, left) /= C '+' then Nothing @@ -323,9 +325,50 @@ go i (Just rowseps) = case charGrid ! (i, left) of C '+' -> Just (Set.insert i rowseps) C '|' -> Just rowseps - _ -> Nothing + _ -> Nothing in foldr go (Just Set.empty) [bottom - 1, bottom - 2 .. top + 1] +lastCellInRow :: CharGrid -> CharIndex -> CharCol -> Maybe ScanResult +lastCellInRow charGrid start@(top, _left) right = + if bounds charGrid `inRange` (top, right) && + charGrid ! (top, right) == Missing + then scanRestOfLines charGrid start + else Nothing + +lastColumn :: CharGrid -> CharCol +lastColumn = snd . snd . bounds + +lastRow :: CharGrid -> CharRow +lastRow = fst . snd . bounds + +scanRightRestOfLine :: CharGrid -> CharIndex -> CharRow -> Maybe ColSeps +scanRightRestOfLine charGrid (_top, left) bottom = + let go :: CharCol -> Maybe ColSeps -> Maybe ColSeps + go _ Nothing = Nothing + go j (Just colseps) = case charGrid ! (bottom, j) of + C '+' -> Just (Set.insert j colseps) + C '-' -> Just colseps + Missing -> Just colseps + _ -> Nothing + + in if charGrid ! (bottom, left) /= C '+' + then Nothing + else foldr go (Just Set.empty) [left + 1 .. lastColumn charGrid] + +scanRestOfLines :: CharGrid -> CharIndex -> Maybe ScanResult +scanRestOfLines charGrid start@(top, _left) = + let go :: Maybe CharIndex -> CharRow -> Maybe CharIndex + go idx i = idx <|> + case scanRightRestOfLine charGrid start i of + Nothing -> Nothing + Just _colseps -> Just (i, lastColumn charGrid) + in case foldl' go Nothing [top + 1 .. lastRow charGrid] of + Just (bottom, right) -> Just + ( (bottom, right) + , Set.singleton bottom + , Set.singleton right) + Nothing -> Nothing + -- | Gets the textual contents, i.e. the lines of a cell. getLines :: CharGrid -> CharIndex -> CharIndex -> [Text] getLines charGrid (top, left) (bottom, right) = @@ -418,11 +461,10 @@ let fromBuilderCell :: BuilderCell -> GridCell [Text] fromBuilderCell = \case FilledCell c -> c - FreeCell -> error "Found an unassigned cell." - getAssocs tblgrid >>= (\kvs -> forM_ kvs $ \(idx, bc) -> - case bc of - FreeCell -> error $ "unassigned: " ++ show idx - _ -> pure ()) + FreeCell -> + -- Found an unassigned cell; replace with empty cell. TODO: This + -- should be reported as a warning. + ContentCell 1 1 mempty mapArray fromBuilderCell tblgrid -- | Calculate the array indices that are spanned by a cell. diff --git a/test/test-gridtables.hs b/test/test-gridtables.hs --- a/test/test-gridtables.hs +++ b/test/test-gridtables.hs @@ -340,6 +340,68 @@ , arrayTableColSpecs = defaultAlign [3] }) + , testCase "top row that's too short" $ + let ls = T.unlines + [ "+---+-+" + , "|one|two|" + , "+---+---+" + , "|one|two|" + , "+---+---+" + ] + in parse' gridTable ls @?= + Right (ArrayTable + { arrayTableCells = listArray ((1,1), (2,2)) + [ ContentCell 1 1 ["one"] + , ContentCell 1 1 ["two"] + , ContentCell 1 1 ["one"] + , ContentCell 1 1 ["two"]] + , arrayTableHead = Nothing + , arrayTableColSpecs = defaultAlign [3, 3] + }) + + , testCase "all vertical seps in last column too short" $ + let ls = T.unlines + [ "+----+:-:+" + , "|eins|long text|" + , "+----+---+" + , "|zwei|long text|" + , "+----+---+" + , "|drei|more text|" + , "+----+---+" + ] + in parse' gridTable ls @?= + Right (ArrayTable + { arrayTableCells = listArray ((1,1), (3,2)) + [ ContentCell 1 1 ["eins"] + , ContentCell 1 1 ["long text"] + , ContentCell 1 1 ["zwei"] + , ContentCell 1 1 ["long text"] + , ContentCell 1 1 ["drei"] + , ContentCell 1 1 ["more text"] + ] + , arrayTableHead = Nothing + , arrayTableColSpecs = defaultAlign [4, 9] + }) + + , testCase "missing cell" $ + let ls = T.unlines + [ "+---+" + , "|one|" + , "+---+---+" + , "|one|two|" + , "+---+---+" + ] + in parse' gridTable ls @?= + Right (ArrayTable + { arrayTableCells = listArray ((1,1), (2,2)) + [ ContentCell 1 1 ["one"] + , ContentCell 1 1 [] + , ContentCell 1 1 ["one"] + , ContentCell 1 1 ["two"]] + , arrayTableHead = Nothing + , arrayTableColSpecs = defaultAlign [3, 3] + }) + , testCase "followed by non-empty line" $ let ls = T.unlines [ "+-----+"