summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2012-07-22 18:40:18 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2012-07-22 18:40:18 -0700
commit511f5e891dcba126bf6159bb1f816a3d25895f00 (patch)
tree6cf33d0adcd0902c543117929dce8ad562955e7b /src
parent1d194005721bd6fba1586abe6bdd2c5510a96eed (diff)
parenta922bd6d8e06673b9bb1ff807734c7090c6516c0 (diff)
Merge pull request #510 from mytskine/markdown-extra
Markdown extra tables [part of the multi-markdown syntax for tables]
Diffstat (limited to 'src')
-rw-r--r--src/Tests/Old.hs2
-rw-r--r--src/Text/Pandoc/Parsing.hs98
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs5
3 files changed, 104 insertions, 1 deletions
diff --git a/src/Tests/Old.hs b/src/Tests/Old.hs
index 30537c6ff..3315bb74e 100644
--- a/src/Tests/Old.hs
+++ b/src/Tests/Old.hs
@@ -56,6 +56,8 @@ tests = [ testGroup "markdown"
"testsuite.txt" "testsuite.native"
, test "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
"tables.txt" "tables.native"
+ , test "extratables" ["-r", "markdown", "-w", "native", "--columns=80"]
+ "markdown-tables.txt" "markdown-tables.native"
, test "more" ["-r", "markdown", "-w", "native", "-S"]
"markdown-reader-more.txt" "markdown-reader-more.native"
, lhsReaderTest "markdown+lhs"
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index bea38e633..61c47b730 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -57,6 +57,7 @@ module Text.Pandoc.Parsing ( (>>~),
orderedListMarker,
charRef,
tableWith,
+ extraTableWith,
gridTableWith,
readWith,
testStringWith,
@@ -542,7 +543,9 @@ tableWith headerParser rowParser lineParser footerParser captionParser = try $ d
else return caption'
state <- getState
let numColumns = stateColumns state
- let widths = widthsFromIndices numColumns indices
+ let widths = if (indices == [])
+ then replicate (length aligns) 0.0
+ else widthsFromIndices numColumns indices
return $ Table caption aligns widths heads lines'
-- Calculate relative widths of table columns, based on indices
@@ -570,6 +573,99 @@ widthsFromIndices numColumns' indices =
fracs = map (\l -> (fromIntegral l) / quotient) lengths in
tail fracs
+
+-- Parse an extra table (php-markdown): each line starts and ends with '|',
+-- with a mandatory line of '--' to separate the (optionnal) headers from content.
+extraTableWith :: GenParser Char ParserState Block -- ^ Block parser
+ -> GenParser Char ParserState [Inline] -- ^ Caption parser
+ -> Bool -- ^ Headerless table
+ -> GenParser Char ParserState Block
+extraTableWith block tableCaption headless =
+ tableWith (extraTableHeader headless block) (extraTableRow block) (extraTableSep '-') extraTableFooter tableCaption
+
+-- | Parse header for an extra table.
+extraTableHeader :: Bool -- ^ Headerless table
+ -> GenParser Char ParserState Block
+ -> GenParser Char ParserState ([[Block]], [Alignment], [Int])
+extraTableHeader headless block = try $ do
+ optional blanklines
+ rawContent <- if headless
+ then return $ repeat ""
+ else many1
+ (notFollowedBy (extraTableHeaderSep) >> char '|' >>
+ many1Till anyChar newline)
+ aligns <- extraTableHeaderDashedLine
+ let indices = []
+ let rawHeads = if headless
+ then replicate (length aligns) ""
+ else map (intercalate " ") $ transpose
+ $ map (extraTableSplitLine )
+ $ map (trimOnceBy '|') rawContent
+ heads <- mapM (parseFromString $ many block) $
+ map removeLeadingTrailingSpace rawHeads
+ return (heads, aligns, indices)
+
+extraTableHeaderPart :: GenParser Char st Alignment
+extraTableHeaderPart = do
+ left <- optionMaybe (char ':')
+ many1 (char '-')
+ right <- optionMaybe (char ':')
+ char '|'
+ return $
+ case (left,right) of
+ (Nothing,Nothing) -> AlignDefault
+ (Just _,Nothing) -> AlignLeft
+ (Nothing,Just _) -> AlignRight
+ (Just _,Just _) -> AlignCenter
+
+extraTableHeaderDashedLine :: GenParser Char st [Alignment]
+extraTableHeaderDashedLine = try $ char '|' >> many1 (extraTableHeaderPart) >>~ blankline
+
+extraTableHeaderSep :: GenParser Char ParserState Char
+extraTableHeaderSep = try $ extraTableHeaderDashedLine >> return '\n'
+
+-- | Split a header or data line in an extra table.
+-- | The line must contain only *inside* separators.
+extraTableSplitLine :: String -> [String]
+extraTableSplitLine line = map removeLeadingSpace $
+ splitBy (== '|') $ removeTrailingSpace line
+
+-- Remove, if present, a character from both ends of a string
+trimOnceBy :: Char -> String -> String
+trimOnceBy ch s =
+ if (head s == ch) && (last s == ch)
+ then init $ tail s
+ else s
+trimEndOnceBy :: Char -> String -> String
+trimEndOnceBy ch s =
+ if (last s == ch)
+ then init s
+ else s
+
+-- | Parse row of an extra table.
+extraTableRow :: GenParser Char ParserState Block
+ -> [Int]
+ -> GenParser Char ParserState [[Block]]
+extraTableRow block indices = do
+ cols <- extraTableRawLine
+ mapM (liftM compactifyCell . parseFromString (many block)) cols
+
+extraTableRawLine :: GenParser Char ParserState [String]
+extraTableRawLine = do
+ char '|'
+ line <- many1Till anyChar newline
+ return (extraTableSplitLine $ trimEndOnceBy '|' line)
+
+-- | Separator between rows of an extra table.
+extraTableSep :: Char -> GenParser Char ParserState Char
+extraTableSep ch = do return '\n'
+
+-- | Parse footer for an extra table.
+extraTableFooter :: GenParser Char ParserState [Char]
+extraTableFooter = blanklines
+
+---
+
-- 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
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index faa1e3145..34a6cf7ce 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -901,6 +901,10 @@ alignType strLst len =
(True, True) -> AlignCenter
(False, False) -> AlignDefault
+extraTable :: Bool -- ^ Headerless table
+ -> GenParser Char ParserState Block
+extraTable = extraTableWith block tableCaption
+
gridTable :: Bool -- ^ Headerless table
-> Parser [Char] ParserState Block
gridTable = gridTableWith block tableCaption
@@ -908,6 +912,7 @@ gridTable = gridTableWith block tableCaption
table :: Parser [Char] ParserState Block
table = multilineTable False <|> simpleTable True <|>
simpleTable False <|> multilineTable True <|>
+ extraTable False <|> extraTable True <|>
gridTable False <|> gridTable True <?> "table"
--