More refactoring of grid table code.
This commit is contained in:
parent
ba19dff8af
commit
6a8fa53f6c
3 changed files with 85 additions and 107 deletions
|
@ -53,10 +53,8 @@ module Text.Pandoc.Parsing ( (>>~),
|
||||||
anyOrderedListMarker,
|
anyOrderedListMarker,
|
||||||
orderedListMarker,
|
orderedListMarker,
|
||||||
charRef,
|
charRef,
|
||||||
gridTableHeader,
|
tableWith,
|
||||||
gridTableRow,
|
gridTableWith,
|
||||||
gridTableSep,
|
|
||||||
gridTableFooter,
|
|
||||||
readWith,
|
readWith,
|
||||||
testStringWith,
|
testStringWith,
|
||||||
ParserState (..),
|
ParserState (..),
|
||||||
|
@ -408,7 +406,58 @@ charRef = do
|
||||||
c <- characterReference
|
c <- characterReference
|
||||||
return $ Str [c]
|
return $ Str [c]
|
||||||
|
|
||||||
-- grid tables, common to RST and Markdown:
|
-- | Parse a table using 'headerParser', 'rowParser',
|
||||||
|
-- 'lineParser', and 'footerParser'.
|
||||||
|
tableWith :: GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||||
|
-> ([Int] -> GenParser Char ParserState [[Block]])
|
||||||
|
-> GenParser Char ParserState sep
|
||||||
|
-> GenParser Char ParserState end
|
||||||
|
-> GenParser Char ParserState [Inline]
|
||||||
|
-> GenParser Char ParserState Block
|
||||||
|
tableWith headerParser rowParser lineParser footerParser captionParser = try $ do
|
||||||
|
(heads, aligns, indices) <- headerParser
|
||||||
|
lines' <- rowParser indices `sepEndBy` lineParser
|
||||||
|
footerParser
|
||||||
|
caption <- option [] captionParser
|
||||||
|
state <- getState
|
||||||
|
let numColumns = stateColumns state
|
||||||
|
let widths = widthsFromIndices numColumns indices
|
||||||
|
return $ Table caption aligns widths heads lines'
|
||||||
|
|
||||||
|
-- Calculate relative widths of table columns, based on indices
|
||||||
|
widthsFromIndices :: Int -- Number of columns on terminal
|
||||||
|
-> [Int] -- Indices
|
||||||
|
-> [Double] -- Fractional relative sizes of columns
|
||||||
|
widthsFromIndices _ [] = []
|
||||||
|
widthsFromIndices numColumns indices =
|
||||||
|
let lengths' = zipWith (-) indices (0:indices)
|
||||||
|
lengths = reverse $
|
||||||
|
case reverse lengths' of
|
||||||
|
[] -> []
|
||||||
|
[x] -> [x]
|
||||||
|
-- compensate for the fact that intercolumn
|
||||||
|
-- spaces are counted in widths of all columns
|
||||||
|
-- but the last...
|
||||||
|
(x:y:zs) -> if x < y && y - x <= 2
|
||||||
|
then y:y:zs
|
||||||
|
else x:y:zs
|
||||||
|
totLength = sum lengths
|
||||||
|
quotient = if totLength > numColumns
|
||||||
|
then fromIntegral totLength
|
||||||
|
else fromIntegral numColumns
|
||||||
|
fracs = map (\l -> (fromIntegral l) / quotient) lengths in
|
||||||
|
tail fracs
|
||||||
|
|
||||||
|
-- Parse a grid table: starts with row of '-' on top, then header
|
||||||
|
-- (which may be grid), then the rows,
|
||||||
|
-- which may be grid, separated by blank lines, and
|
||||||
|
-- ending with a footer (dashed line followed by blank line).
|
||||||
|
gridTableWith :: GenParser Char ParserState Block -- ^ Block parser
|
||||||
|
-> GenParser Char ParserState [Inline] -- ^ Caption parser
|
||||||
|
-> Bool -- ^ Headerless table
|
||||||
|
-> GenParser Char ParserState Block
|
||||||
|
gridTableWith block tableCaption headless =
|
||||||
|
tableWith (gridTableHeader headless block) (gridTableRow block) (gridTableSep '-') gridTableFooter tableCaption
|
||||||
|
|
||||||
gridTableSplitLine :: [Int] -> String -> [String]
|
gridTableSplitLine :: [Int] -> String -> [String]
|
||||||
gridTableSplitLine indices line =
|
gridTableSplitLine indices line =
|
||||||
|
@ -433,8 +482,9 @@ gridTableSep ch = try $ gridDashedLines ch >> return '\n'
|
||||||
|
|
||||||
-- | Parse header for a grid table.
|
-- | Parse header for a grid table.
|
||||||
gridTableHeader :: Bool -- ^ Headerless table
|
gridTableHeader :: Bool -- ^ Headerless table
|
||||||
-> GenParser Char ParserState ([String], [Alignment], [Int])
|
-> GenParser Char ParserState Block
|
||||||
gridTableHeader headless = try $ do
|
-> GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||||
|
gridTableHeader headless block = try $ do
|
||||||
optional blanklines
|
optional blanklines
|
||||||
dashes <- gridDashedLines '-'
|
dashes <- gridDashedLines '-'
|
||||||
rawContent <- if headless
|
rawContent <- if headless
|
||||||
|
@ -453,7 +503,9 @@ gridTableHeader headless = try $ do
|
||||||
then replicate (length dashes) ""
|
then replicate (length dashes) ""
|
||||||
else map (intercalate " ") $ transpose
|
else map (intercalate " ") $ transpose
|
||||||
$ map (gridTableSplitLine indices) rawContent
|
$ map (gridTableSplitLine indices) rawContent
|
||||||
return (rawHeads, aligns, indices)
|
heads <- mapM (parseFromString $ many block) $
|
||||||
|
map removeLeadingTrailingSpace rawHeads
|
||||||
|
return (heads, aligns, indices)
|
||||||
|
|
||||||
gridTableRawLine :: [Int] -> GenParser Char ParserState [String]
|
gridTableRawLine :: [Int] -> GenParser Char ParserState [String]
|
||||||
gridTableRawLine indices = do
|
gridTableRawLine indices = do
|
||||||
|
|
|
@ -717,7 +717,7 @@ dashedLine ch = do
|
||||||
-- Parse a table header with dashed lines of '-' preceded by
|
-- Parse a table header with dashed lines of '-' preceded by
|
||||||
-- one (or zero) line of text.
|
-- one (or zero) line of text.
|
||||||
simpleTableHeader :: Bool -- ^ Headerless table
|
simpleTableHeader :: Bool -- ^ Headerless table
|
||||||
-> GenParser Char ParserState ([[Char]], [Alignment], [Int])
|
-> GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||||
simpleTableHeader headless = try $ do
|
simpleTableHeader headless = try $ do
|
||||||
rawContent <- if headless
|
rawContent <- if headless
|
||||||
then return ""
|
then return ""
|
||||||
|
@ -736,7 +736,9 @@ simpleTableHeader headless = try $ do
|
||||||
let rawHeads' = if headless
|
let rawHeads' = if headless
|
||||||
then replicate (length dashes) ""
|
then replicate (length dashes) ""
|
||||||
else rawHeads
|
else rawHeads
|
||||||
return (rawHeads', aligns, indices)
|
heads <- mapM (parseFromString (many plain)) $
|
||||||
|
map removeLeadingTrailingSpace rawHeads'
|
||||||
|
return (heads, aligns, indices)
|
||||||
|
|
||||||
-- Parse a table footer - dashed lines followed by blank line.
|
-- Parse a table footer - dashed lines followed by blank line.
|
||||||
tableFooter :: GenParser Char ParserState [Char]
|
tableFooter :: GenParser Char ParserState [Char]
|
||||||
|
@ -765,34 +767,9 @@ multilineRow :: [Int]
|
||||||
-> GenParser Char ParserState [[Block]]
|
-> GenParser Char ParserState [[Block]]
|
||||||
multilineRow indices = do
|
multilineRow indices = do
|
||||||
colLines <- many1 (rawTableLine indices)
|
colLines <- many1 (rawTableLine indices)
|
||||||
optional blanklines
|
|
||||||
let cols = map unlines $ transpose colLines
|
let cols = map unlines $ transpose colLines
|
||||||
mapM (parseFromString (many plain)) cols
|
mapM (parseFromString (many plain)) cols
|
||||||
|
|
||||||
-- Calculate relative widths of table columns, based on indices
|
|
||||||
widthsFromIndices :: Int -- Number of columns on terminal
|
|
||||||
-> [Int] -- Indices
|
|
||||||
-> [Double] -- Fractional relative sizes of columns
|
|
||||||
widthsFromIndices _ [] = []
|
|
||||||
widthsFromIndices numColumns indices =
|
|
||||||
let lengths' = zipWith (-) indices (0:indices)
|
|
||||||
lengths = reverse $
|
|
||||||
case reverse lengths' of
|
|
||||||
[] -> []
|
|
||||||
[x] -> [x]
|
|
||||||
-- compensate for the fact that intercolumn
|
|
||||||
-- spaces are counted in widths of all columns
|
|
||||||
-- but the last...
|
|
||||||
(x:y:zs) -> if x < y && y - x <= 2
|
|
||||||
then y:y:zs
|
|
||||||
else x:y:zs
|
|
||||||
totLength = sum lengths
|
|
||||||
quotient = if totLength > numColumns
|
|
||||||
then fromIntegral totLength
|
|
||||||
else fromIntegral numColumns
|
|
||||||
fracs = map (\l -> (fromIntegral l) / quotient) lengths in
|
|
||||||
tail fracs
|
|
||||||
|
|
||||||
-- Parses a table caption: inlines beginning with 'Table:'
|
-- Parses a table caption: inlines beginning with 'Table:'
|
||||||
-- and followed by blank lines.
|
-- and followed by blank lines.
|
||||||
tableCaption :: GenParser Char ParserState [Inline]
|
tableCaption :: GenParser Char ParserState [Inline]
|
||||||
|
@ -803,27 +780,14 @@ tableCaption = try $ do
|
||||||
blanklines
|
blanklines
|
||||||
return $ normalizeSpaces result
|
return $ normalizeSpaces result
|
||||||
|
|
||||||
-- Parse a table using 'headerParser', 'lineParser', and 'footerParser'.
|
|
||||||
tableWith :: GenParser Char ParserState ([[Char]], [Alignment], [Int])
|
|
||||||
-> ([Int] -> GenParser Char ParserState [[Block]])
|
|
||||||
-> GenParser Char ParserState end
|
|
||||||
-> GenParser Char ParserState Block
|
|
||||||
tableWith headerParser lineParser footerParser = try $ do
|
|
||||||
(rawHeads, aligns, indices) <- headerParser
|
|
||||||
lines' <- many1Till (lineParser indices) footerParser
|
|
||||||
caption <- option [] tableCaption
|
|
||||||
heads <- mapM (parseFromString (many plain)) rawHeads
|
|
||||||
state <- getState
|
|
||||||
let numColumns = stateColumns state
|
|
||||||
let widths = widthsFromIndices numColumns indices
|
|
||||||
return $ Table caption aligns widths heads lines'
|
|
||||||
|
|
||||||
-- Parse a simple table with '---' header and one line per row.
|
-- Parse a simple table with '---' header and one line per row.
|
||||||
simpleTable :: Bool -- ^ Headerless table
|
simpleTable :: Bool -- ^ Headerless table
|
||||||
-> GenParser Char ParserState Block
|
-> GenParser Char ParserState Block
|
||||||
simpleTable headless = do
|
simpleTable headless = do
|
||||||
Table c a _w h l <- tableWith (simpleTableHeader headless) tableLine
|
Table c a _w h l <- tableWith (simpleTableHeader headless) tableLine
|
||||||
(if headless then tableFooter else tableFooter <|> blanklines)
|
(return ())
|
||||||
|
(if headless then tableFooter else tableFooter <|> blanklines)
|
||||||
|
tableCaption
|
||||||
-- Simple tables get 0s for relative column widths (i.e., use default)
|
-- Simple tables get 0s for relative column widths (i.e., use default)
|
||||||
return $ Table c a (replicate (length a) 0) h l
|
return $ Table c a (replicate (length a) 0) h l
|
||||||
|
|
||||||
|
@ -834,10 +798,10 @@ simpleTable headless = do
|
||||||
multilineTable :: Bool -- ^ Headerless table
|
multilineTable :: Bool -- ^ Headerless table
|
||||||
-> GenParser Char ParserState Block
|
-> GenParser Char ParserState Block
|
||||||
multilineTable headless =
|
multilineTable headless =
|
||||||
tableWith (multilineTableHeader headless) multilineRow tableFooter
|
tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter tableCaption
|
||||||
|
|
||||||
multilineTableHeader :: Bool -- ^ Headerless table
|
multilineTableHeader :: Bool -- ^ Headerless table
|
||||||
-> GenParser Char ParserState ([String], [Alignment], [Int])
|
-> GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||||
multilineTableHeader headless = try $ do
|
multilineTableHeader headless = try $ do
|
||||||
if headless
|
if headless
|
||||||
then return '\n'
|
then return '\n'
|
||||||
|
@ -861,7 +825,9 @@ multilineTableHeader headless = try $ do
|
||||||
let rawHeads = if headless
|
let rawHeads = if headless
|
||||||
then replicate (length dashes) ""
|
then replicate (length dashes) ""
|
||||||
else map (intercalate " ") rawHeadsList
|
else map (intercalate " ") rawHeadsList
|
||||||
return ((map removeLeadingTrailingSpace rawHeads), aligns, indices)
|
heads <- mapM (parseFromString (many plain)) $
|
||||||
|
map removeLeadingTrailingSpace rawHeads
|
||||||
|
return (heads, aligns, indices)
|
||||||
|
|
||||||
-- Returns an alignment type for a table, based on a list of strings
|
-- Returns an alignment type for a table, based on a list of strings
|
||||||
-- (the rows of the column header) and a number (the length of the
|
-- (the rows of the column header) and a number (the length of the
|
||||||
|
@ -881,9 +847,15 @@ alignType strLst len =
|
||||||
(True, True) -> AlignCenter
|
(True, True) -> AlignCenter
|
||||||
(False, False) -> AlignDefault
|
(False, False) -> AlignDefault
|
||||||
|
|
||||||
|
gridTable :: Bool -- ^ Headerless table
|
||||||
|
-> GenParser Char ParserState Block
|
||||||
|
gridTable = gridTableWith block tableCaption
|
||||||
|
|
||||||
|
-- TODO - add grid tables here...add tests for markdown grid tables...document markdown grid tables.
|
||||||
table :: GenParser Char ParserState Block
|
table :: GenParser Char ParserState Block
|
||||||
table = multilineTable False <|> simpleTable True <|>
|
table = multilineTable False <|> simpleTable True <|>
|
||||||
simpleTable False <|> multilineTable True <?> "table"
|
simpleTable False <|> multilineTable True <|>
|
||||||
|
gridTable False <|> gridTable True <?> "table"
|
||||||
|
|
||||||
--
|
--
|
||||||
-- inline
|
-- inline
|
||||||
|
|
|
@ -636,32 +636,8 @@ simpleTableSplitLine indices line =
|
||||||
map removeLeadingTrailingSpace
|
map removeLeadingTrailingSpace
|
||||||
$ tail $ splitByIndices (init indices) line
|
$ tail $ splitByIndices (init indices) line
|
||||||
|
|
||||||
-- Calculate relative widths of table columns, based on indices
|
|
||||||
widthsFromIndices :: Int -- Number of columns on terminal
|
|
||||||
-> [Int] -- Indices
|
|
||||||
-> [Double] -- Fractional relative sizes of columns
|
|
||||||
widthsFromIndices _ [] = []
|
|
||||||
widthsFromIndices numColumns indices =
|
|
||||||
let lengths' = zipWith (-) indices (0:indices)
|
|
||||||
lengths = reverse $
|
|
||||||
case reverse lengths' of
|
|
||||||
[] -> []
|
|
||||||
[x] -> [x]
|
|
||||||
-- compensate for the fact that intercolumn
|
|
||||||
-- spaces are counted in widths of all columns
|
|
||||||
-- but the last...
|
|
||||||
(x:y:zs) -> if x < y && y - x <= 2
|
|
||||||
then y:y:zs
|
|
||||||
else x:y:zs
|
|
||||||
totLength = sum lengths
|
|
||||||
quotient = if totLength > numColumns
|
|
||||||
then fromIntegral totLength
|
|
||||||
else fromIntegral numColumns
|
|
||||||
fracs = map (\l -> (fromIntegral l) / quotient) lengths in
|
|
||||||
tail fracs
|
|
||||||
|
|
||||||
simpleTableHeader :: Bool -- ^ Headerless table
|
simpleTableHeader :: Bool -- ^ Headerless table
|
||||||
-> GenParser Char ParserState ([[Char]], [Alignment], [Int])
|
-> GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||||
simpleTableHeader headless = try $ do
|
simpleTableHeader headless = try $ do
|
||||||
optional blanklines
|
optional blanklines
|
||||||
rawContent <- if headless
|
rawContent <- if headless
|
||||||
|
@ -675,45 +651,23 @@ simpleTableHeader headless = try $ do
|
||||||
let rawHeads = if headless
|
let rawHeads = if headless
|
||||||
then replicate (length dashes) ""
|
then replicate (length dashes) ""
|
||||||
else simpleTableSplitLine indices rawContent
|
else simpleTableSplitLine indices rawContent
|
||||||
return (rawHeads, aligns, indices)
|
heads <- mapM (parseFromString (many plain)) $
|
||||||
|
map removeLeadingTrailingSpace rawHeads
|
||||||
-- Parse a table using 'headerParser', 'lineParser', and 'footerParser'.
|
return (heads, aligns, indices)
|
||||||
tableWith :: GenParser Char ParserState ([[Char]], [Alignment], [Int])
|
|
||||||
-> ([Int]
|
|
||||||
-> GenParser Char ParserState [[Block]])
|
|
||||||
-> GenParser Char ParserState sep
|
|
||||||
-> GenParser Char ParserState end
|
|
||||||
-> GenParser Char ParserState Block
|
|
||||||
tableWith headerParser rowParser lineParser footerParser = try $ do
|
|
||||||
(rawHeads, aligns, indices) <- headerParser
|
|
||||||
lines' <- rowParser indices `sepEndBy` lineParser
|
|
||||||
footerParser
|
|
||||||
heads <- mapM (parseFromString (many plain)) rawHeads
|
|
||||||
state <- getState
|
|
||||||
let captions = [] -- no notion of captions in RST
|
|
||||||
let numColumns = stateColumns state
|
|
||||||
let widths = widthsFromIndices numColumns indices
|
|
||||||
return $ Table captions aligns widths heads lines'
|
|
||||||
|
|
||||||
-- Parse a simple table with '---' header and one line per row.
|
-- Parse a simple table with '---' header and one line per row.
|
||||||
simpleTable :: Bool -- ^ Headerless table
|
simpleTable :: Bool -- ^ Headerless table
|
||||||
-> GenParser Char ParserState Block
|
-> GenParser Char ParserState Block
|
||||||
simpleTable headless = do
|
simpleTable headless = do
|
||||||
Table c a _w h l <- tableWith (simpleTableHeader headless) simpleTableRow sep simpleTableFooter
|
Table c a _w h l <- tableWith (simpleTableHeader headless) simpleTableRow sep simpleTableFooter (return [])
|
||||||
-- Simple tables get 0s for relative column widths (i.e., use default)
|
-- Simple tables get 0s for relative column widths (i.e., use default)
|
||||||
return $ Table c a (replicate (length a) 0) h l
|
return $ Table c a (replicate (length a) 0) h l
|
||||||
where
|
where
|
||||||
sep = return () -- optional (simpleTableSep '-')
|
sep = return () -- optional (simpleTableSep '-')
|
||||||
|
|
||||||
-- Parse a grid table: starts with row of '-' on top, then header
|
|
||||||
-- (which may be grid), then the rows,
|
|
||||||
-- which may be grid, separated by blank lines, and
|
|
||||||
-- ending with a footer (dashed line followed by blank line).
|
|
||||||
gridTable :: Bool -- ^ Headerless table
|
gridTable :: Bool -- ^ Headerless table
|
||||||
-> GenParser Char ParserState Block
|
-> GenParser Char ParserState Block
|
||||||
gridTable headless =
|
gridTable = gridTableWith block (return [])
|
||||||
tableWith (gridTableHeader headless) (gridTableRow block) (gridTableSep '-') gridTableFooter
|
|
||||||
|
|
||||||
|
|
||||||
table :: GenParser Char ParserState Block
|
table :: GenParser Char ParserState Block
|
||||||
table = gridTable False <|> simpleTable False <|>
|
table = gridTable False <|> simpleTable False <|>
|
||||||
|
|
Loading…
Add table
Reference in a new issue