gridtables 0.0.1.0 → 0.0.2.0
raw patch · 4 files changed
+142/−31 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Text.GridTable.Trace: instance GHC.Classes.Eq Text.GridTable.Trace.GChar
Files
- CHANGELOG.md +10/−2
- gridtables.cabal +1/−1
- src/Text/GridTable/Trace.hs +44/−28
- test/test-gridtables.hs +87/−0
CHANGELOG.md view
@@ -2,9 +2,17 @@ `gridtables` uses [PVP Versioning][]. -## gridtables-0.0.1+## gridtables-0.0.2.0 -Release pending.+Released 2022-07-30.++- Treat "combining" Unicode characters, such as the zero-width+ space or the word joiner, as having no width.+++## gridtables-0.0.1.0++Released 2022-07-29. - Boldly going where no Haskell library has gone before.
gridtables.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: gridtables-version: 0.0.1.0+version: 0.0.2.0 synopsis: Parser for reStructuredText-style grid tables. description: Provides a parser for plain-text representations of tables. This package supports table headers, cells
src/Text/GridTable/Trace.hs view
@@ -26,7 +26,7 @@ import Data.Array.MArray import Data.Array.ST import Data.Function (on)-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (fromMaybe) import Data.Set (Set) import Data.Text (Text) import Text.DocLayout (charWidth)@@ -49,7 +49,7 @@ else return $ tableFromTraceInfo traceInfo partSeps specs1 -- | Type used to represent the 2D layout of table characters-type CharGrid = Array (CharRow, CharCol) (Maybe Char)+type CharGrid = Array (CharRow, CharCol) GChar -- | Index of a half-width character in the character-wise -- representation.@@ -65,19 +65,31 @@ deriving stock (Eq, Show) deriving newtype (Enum, Ix, Num, Ord) --- | Converts a list of lines into an char array.+data GChar+ = C Char -- ^ half- or full-width character+ | CZ [Char] Char -- ^ character preceded by zero-width chars+ | WP -- ^ padding for wide characters+ | Missing -- ^ padding for short lines+ deriving stock (Eq)++-- | Converts a list of lines into a char array. toCharGrid :: [Text] -> CharGrid toCharGrid lines =- let chars = foldr (\t m -> max m (T.length t)) 0 lines+ let chars = foldr (\t m -> max m (T.length t)) 0 lines -- potential overcount gbounds = ( (CharRow 1, CharCol 1) , (CharRow (length lines), CharCol chars) )- charList c = case charWidth c of- 2 -> [Just c, Nothing]- _ -> [Just c]- extendedLines = map ((\line -> take chars (line ++ repeat Nothing))- . concatMap charList . T.unpack)- lines+ toGChars [] = repeat Missing+ toGChars (c:cs) = case charWidth c of+ 2 -> C c : WP : toGChars cs+ 1 -> C c : toGChars cs+ _ -> case span ((== 0) . charWidth) cs of+ (zw, []) -> [CZ (c:zw) '\0']+ (zw, c':cs') -> CZ (c:zw) c' :+ case charWidth c' of+ 2 -> WP : toGChars cs'+ _ -> toGChars cs'+ extendedLines = map (take chars . toGChars . T.unpack) lines in listArray gbounds (mconcat extendedLines) -- | Information on, and extracted from, a body separator line. This is a line@@ -111,8 +123,8 @@ -> CharGrid -> CharRow -> Maybe [ColSpec] colSpecsInLine c charGrid i = case charGrid ! (i, firstCol) of- Just '+' -> loop [] (firstCol + 1)- _ -> Nothing+ C '+' -> loop [] (firstCol + 1)+ _ -> Nothing where loop acc j = case colSpecAt j of Nothing -> Nothing@@ -128,7 +140,7 @@ | otherwise = case findEnd (j + 1) of Nothing -> Nothing Just (end, rightMark) ->- let leftMark = charGrid ! (i, j) == Just ':'+ let leftMark = charGrid ! (i, j) == C ':' align = case (leftMark, rightMark) of (False , False) -> AlignDefault (True , False) -> AlignLeft@@ -141,11 +153,11 @@ } in pure (pure colspec) findEnd j = case charGrid ! (i, j) of- Just '+' -> pure (j, False)- Just ':' -> if charGrid ! (i, j + 1) == Just '+'+ C '+' -> pure (j, False)+ C ':' -> if charGrid ! (i, j + 1) == C '+' then pure (j + 1, True) else Nothing- Just c'+ C c' | c' == c -> findEnd (j + 1) _ -> Nothing @@ -162,8 +174,8 @@ c <- readArray mutGrid idx -- convert `=` to `-` and remove alignment markers case c of- Just '=' -> writeArray mutGrid idx (Just '-')- Just ':' -> writeArray mutGrid idx (Just '-')+ C '=' -> writeArray mutGrid idx (C '-')+ C ':' -> writeArray mutGrid idx (C '-') _ -> pure () return mutGrid @@ -240,8 +252,8 @@ loop colseps j | not (bounds charGrid `inRange` (top, j)) = Nothing | otherwise = case charGrid ! (top, j) of- Just '-' -> loop colseps (j + 1)- Just '+' ->+ C '-' -> loop colseps (j + 1)+ C '+' -> let colseps' = Set.insert j colseps in case scanDown charGrid start j of Nothing -> loop colseps' (j + 1)@@ -265,7 +277,7 @@ if not (bounds charGrid `inRange` (i, right)) then Nothing else case charGrid ! (i, right) of- Just '+' ->+ C '+' -> let rowseps' = Set.insert i rowseps in case scanLeft charGrid start (i, right) of Nothing -> loop rowseps' (i + 1)@@ -274,7 +286,7 @@ , rowseps' `Set.union` newrowseps , colseps )- Just '|' -> loop rowseps (i + 1)+ C '|' -> loop rowseps (i + 1) _ -> -- all but the final column must be terminated if right == snd (snd (bounds charGrid)) then loop rowseps (i + 1)@@ -288,11 +300,11 @@ let go :: CharCol -> Maybe ColSeps -> Maybe ColSeps go _ Nothing = Nothing go j (Just colseps) = case charGrid ! (bottom, j) of- Just '+' -> Just (Set.insert j colseps)- Just '-' -> Just colseps+ C '+' -> Just (Set.insert j colseps)+ C '-' -> Just colseps _ -> Nothing - in if charGrid ! (bottom, left) /= Just '+'+ in if charGrid ! (bottom, left) /= C '+' then Nothing else case foldr go (Just Set.empty) [(right - 1), right - 2 .. (left + 1)] of@@ -309,8 +321,8 @@ let go :: CharRow -> Maybe RowSeps -> Maybe RowSeps go _ Nothing = Nothing go i (Just rowseps) = case charGrid ! (i, left) of- Just '+' -> Just (Set.insert i rowseps)- Just '|' -> Just rowseps+ C '+' -> Just (Set.insert i rowseps)+ C '|' -> Just rowseps _ -> Nothing in foldr go (Just Set.empty) [bottom - 1, bottom - 2 .. top + 1] @@ -319,7 +331,11 @@ getLines charGrid (top, left) (bottom, right) = let rowIdxs = [top + 1 .. bottom - 1] colIdxs = [left + 1 .. right - 1]- in map (\ir -> T.pack $ mapMaybe (\ic -> charGrid ! (ir, ic)) colIdxs)+ toChars rowIdx colIdx = case charGrid ! (rowIdx, colIdx) of+ C c -> [c]+ CZ zw c -> zw ++ [c]+ _ -> []+ in map (\ir -> T.pack $ concatMap (toChars ir) colIdxs) rowIdxs -- | Traced cell with raw contents and border positions.
test/test-gridtables.hs view
@@ -222,6 +222,93 @@ ] }) + , testGroup "Char widths"+ [ testCase "wide character" $+ let gt = T.unlines+ [ "+--+---+"+ , "|魚| x |"+ , "+--+---+"+ ]+ in parse' gridTable gt @?=+ Right (ArrayTable+ { arrayTableCells = listArray ((1,1), (1, 2))+ [ ContentCell 1 1 ["魚"] , ContentCell 1 1 [" x "]]+ , arrayTableHead = Nothing+ , arrayTableColSpecs = defaultAlign [2, 3]+ })++ , testCase "zero-width space" $+ let gt = T.unlines+ [ "+--+---+"+ , "|x\8203y| z |"+ , "+--+---+"+ ]+ in parse' gridTable gt @?=+ Right (ArrayTable+ { arrayTableCells = listArray ((1,1), (1, 2))+ [ ContentCell 1 1 ["x\8203y"] , ContentCell 1 1 [" z "]]+ , arrayTableHead = Nothing+ , arrayTableColSpecs = defaultAlign [2, 3]+ })++ , testCase "zero-width space after wide character" $+ let gt = T.unlines+ [ "+---+---+"+ , "|魚\8203y| z |"+ , "+---+---+"+ ]+ in parse' gridTable gt @?=+ Right (ArrayTable+ { arrayTableCells = listArray ((1,1), (1, 2))+ [ ContentCell 1 1 ["魚\8203y"] , ContentCell 1 1 [" z "]]+ , arrayTableHead = Nothing+ , arrayTableColSpecs = defaultAlign [3, 3]+ })++ , testCase "wide character after zero-width space" $+ let gt = T.unlines+ [ "+---+---+"+ , "|y\8203魚| z |"+ , "+---+---+"+ ]+ in parse' gridTable gt @?=+ Right (ArrayTable+ { arrayTableCells = listArray ((1,1), (1, 2))+ [ ContentCell 1 1 ["y\8203魚"] , ContentCell 1 1 [" z "]]+ , arrayTableHead = Nothing+ , arrayTableColSpecs = defaultAlign [3, 3]+ })++ , testCase "multiple zero-width characters" $+ let gt = T.unlines+ [ "+--+---+"+ , "|a\8204\8205b| c |"+ , "+--+---+"+ ]+ in parse' gridTable gt @?=+ Right (ArrayTable+ { arrayTableCells = listArray ((1,1), (1, 2))+ [ ContentCell 1 1 ["a\8204\8205b"] , ContentCell 1 1 [" c "]]+ , arrayTableHead = Nothing+ , arrayTableColSpecs = defaultAlign [2, 3]+ })++ , testCase "many wide chars" $+ let gt = T.unlines+ [ "+----------+-+"+ , "|１２３４５|a|"+ , "+----------+-+"+ ]+ in parse' gridTable gt @?=+ Right (ArrayTable+ { arrayTableCells = listArray ((1,1), (1, 2))+ [ ContentCell 1 1 ["１２３４５"] , ContentCell 1 1 ["a"]]+ , arrayTableHead = Nothing+ , arrayTableColSpecs = defaultAlign [10, 1]+ })++ ]+ , testCase "unterminated row" $ let gt = T.unlines [ "+-----+"