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,
|
||||
orderedListMarker,
|
||||
charRef,
|
||||
gridTableHeader,
|
||||
gridTableRow,
|
||||
gridTableSep,
|
||||
gridTableFooter,
|
||||
tableWith,
|
||||
gridTableWith,
|
||||
readWith,
|
||||
testStringWith,
|
||||
ParserState (..),
|
||||
|
@ -408,7 +406,58 @@ charRef = do
|
|||
c <- characterReference
|
||||
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 indices line =
|
||||
|
@ -433,8 +482,9 @@ gridTableSep ch = try $ gridDashedLines ch >> return '\n'
|
|||
|
||||
-- | Parse header for a grid table.
|
||||
gridTableHeader :: Bool -- ^ Headerless table
|
||||
-> GenParser Char ParserState ([String], [Alignment], [Int])
|
||||
gridTableHeader headless = try $ do
|
||||
-> GenParser Char ParserState Block
|
||||
-> GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||
gridTableHeader headless block = try $ do
|
||||
optional blanklines
|
||||
dashes <- gridDashedLines '-'
|
||||
rawContent <- if headless
|
||||
|
@ -453,7 +503,9 @@ gridTableHeader headless = try $ do
|
|||
then replicate (length dashes) ""
|
||||
else map (intercalate " ") $ transpose
|
||||
$ 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 indices = do
|
||||
|
|
|
@ -717,7 +717,7 @@ dashedLine ch = do
|
|||
-- Parse a table header with dashed lines of '-' preceded by
|
||||
-- one (or zero) line of text.
|
||||
simpleTableHeader :: Bool -- ^ Headerless table
|
||||
-> GenParser Char ParserState ([[Char]], [Alignment], [Int])
|
||||
-> GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||
simpleTableHeader headless = try $ do
|
||||
rawContent <- if headless
|
||||
then return ""
|
||||
|
@ -736,7 +736,9 @@ simpleTableHeader headless = try $ do
|
|||
let rawHeads' = if headless
|
||||
then replicate (length dashes) ""
|
||||
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.
|
||||
tableFooter :: GenParser Char ParserState [Char]
|
||||
|
@ -765,34 +767,9 @@ multilineRow :: [Int]
|
|||
-> GenParser Char ParserState [[Block]]
|
||||
multilineRow indices = do
|
||||
colLines <- many1 (rawTableLine indices)
|
||||
optional blanklines
|
||||
let cols = map unlines $ transpose colLines
|
||||
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:'
|
||||
-- and followed by blank lines.
|
||||
tableCaption :: GenParser Char ParserState [Inline]
|
||||
|
@ -803,27 +780,14 @@ tableCaption = try $ do
|
|||
blanklines
|
||||
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.
|
||||
simpleTable :: Bool -- ^ Headerless table
|
||||
-> GenParser Char ParserState Block
|
||||
simpleTable headless = do
|
||||
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)
|
||||
return $ Table c a (replicate (length a) 0) h l
|
||||
|
||||
|
@ -834,10 +798,10 @@ simpleTable headless = do
|
|||
multilineTable :: Bool -- ^ Headerless table
|
||||
-> GenParser Char ParserState Block
|
||||
multilineTable headless =
|
||||
tableWith (multilineTableHeader headless) multilineRow tableFooter
|
||||
tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter tableCaption
|
||||
|
||||
multilineTableHeader :: Bool -- ^ Headerless table
|
||||
-> GenParser Char ParserState ([String], [Alignment], [Int])
|
||||
-> GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||
multilineTableHeader headless = try $ do
|
||||
if headless
|
||||
then return '\n'
|
||||
|
@ -861,7 +825,9 @@ multilineTableHeader headless = try $ do
|
|||
let rawHeads = if headless
|
||||
then replicate (length dashes) ""
|
||||
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
|
||||
-- (the rows of the column header) and a number (the length of the
|
||||
|
@ -881,9 +847,15 @@ alignType strLst len =
|
|||
(True, True) -> AlignCenter
|
||||
(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 = multilineTable False <|> simpleTable True <|>
|
||||
simpleTable False <|> multilineTable True <?> "table"
|
||||
simpleTable False <|> multilineTable True <|>
|
||||
gridTable False <|> gridTable True <?> "table"
|
||||
|
||||
--
|
||||
-- inline
|
||||
|
|
|
@ -636,32 +636,8 @@ simpleTableSplitLine indices line =
|
|||
map removeLeadingTrailingSpace
|
||||
$ 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
|
||||
-> GenParser Char ParserState ([[Char]], [Alignment], [Int])
|
||||
-> GenParser Char ParserState ([[Block]], [Alignment], [Int])
|
||||
simpleTableHeader headless = try $ do
|
||||
optional blanklines
|
||||
rawContent <- if headless
|
||||
|
@ -675,45 +651,23 @@ simpleTableHeader headless = try $ do
|
|||
let rawHeads = if headless
|
||||
then replicate (length dashes) ""
|
||||
else simpleTableSplitLine indices rawContent
|
||||
return (rawHeads, aligns, indices)
|
||||
|
||||
-- Parse a table using 'headerParser', 'lineParser', and 'footerParser'.
|
||||
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'
|
||||
heads <- mapM (parseFromString (many plain)) $
|
||||
map removeLeadingTrailingSpace rawHeads
|
||||
return (heads, aligns, indices)
|
||||
|
||||
-- Parse a simple table with '---' header and one line per row.
|
||||
simpleTable :: Bool -- ^ Headerless table
|
||||
-> GenParser Char ParserState Block
|
||||
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)
|
||||
return $ Table c a (replicate (length a) 0) h l
|
||||
where
|
||||
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
|
||||
-> GenParser Char ParserState Block
|
||||
gridTable headless =
|
||||
tableWith (gridTableHeader headless) (gridTableRow block) (gridTableSep '-') gridTableFooter
|
||||
|
||||
gridTable = gridTableWith block (return [])
|
||||
|
||||
table :: GenParser Char ParserState Block
|
||||
table = gridTable False <|> simpleTable False <|>
|
||||
|
|
Loading…
Reference in a new issue