summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2012-07-22 22:09:15 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2012-07-22 22:09:15 -0700
commitd2cc56a46a5a3c657429e8df5b93c82f3f9ed9fb (patch)
tree7ebcea15a84f048197dbfb29867dc6b8346c91d5 /src
parented4039c3d7a77b4dbdb67e0463629a9ea563edd5 (diff)
Revised code for pipe tables.
* All tables now require at least one body row. * Renamed from 'extra' to 'pipe' tables. * Moved functions from Parsing to Readers.Markdown. * Cleaned up code; revised to parse in one pass rather than parsing a raw string, splitting it, and parsing the components. * Allow pipe tables without pipes on the ends (as PHP Markdown Extra does).
Diffstat (limited to 'src')
-rw-r--r--src/Tests/Old.hs4
-rw-r--r--src/Text/Pandoc/Parsing.hs98
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs56
3 files changed, 57 insertions, 101 deletions
diff --git a/src/Tests/Old.hs b/src/Tests/Old.hs
index 8a88e4034..e60f390df 100644
--- a/src/Tests/Old.hs
+++ b/src/Tests/Old.hs
@@ -56,8 +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"]
- "extra-tables.markdown" "extra-tables.native"
+ , test "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"]
+ "pipe-tables.txt" "pipe-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 61c47b730..e7ca8ccf3 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -57,7 +57,6 @@ module Text.Pandoc.Parsing ( (>>~),
orderedListMarker,
charRef,
tableWith,
- extraTableWith,
gridTableWith,
readWith,
testStringWith,
@@ -108,9 +107,11 @@ module Text.Pandoc.Parsing ( (>>~),
(<?>),
choice,
try,
- sepBy1,
sepBy,
+ sepBy1,
sepEndBy,
+ sepEndBy1,
+ endBy,
endBy1,
option,
optional,
@@ -536,7 +537,7 @@ tableWith :: Parsec [Char] ParserState ([[Block]], [Alignment], [Int])
tableWith headerParser rowParser lineParser footerParser captionParser = try $ do
caption' <- option [] captionParser
(heads, aligns, indices) <- headerParser
- lines' <- rowParser indices `sepEndBy` lineParser
+ lines' <- rowParser indices `sepEndBy1` lineParser
footerParser
caption <- if null caption'
then option [] captionParser
@@ -573,97 +574,6 @@ 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
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 34a6cf7ce..1786c7f45 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -901,18 +901,64 @@ 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
+pipeTable :: Bool -- ^ Headerless table
+ -> Parser [Char] ParserState Block
+pipeTable headless = tableWith (pipeTableHeader headless)
+ (\_ -> pipeTableRow) (return ()) blanklines tableCaption
+
+-- | Parse header for an pipe table.
+pipeTableHeader :: Bool -- ^ Headerless table
+ -> Parser [Char] ParserState ([[Block]], [Alignment], [Int])
+pipeTableHeader headless = try $ do
+ optional blanklines
+ heads <- if headless
+ then return $ repeat []
+ else pipeTableRow
+ aligns <- nonindentSpaces >> optional (char '|') >>
+ pipeTableHeaderPart `sepBy1` sepPipe
+ optional (char '|')
+ newline
+ let cols = length aligns
+ return (take cols heads, aligns, [])
+
+sepPipe :: Parser [Char] ParserState ()
+sepPipe = try $ char '|' >> notFollowedBy blankline
+
+pipeTableRow :: Parser [Char] ParserState [[Block]]
+pipeTableRow = do
+ nonindentSpaces
+ optional (char '|')
+ let cell = many (notFollowedBy (blankline <|> char '|') >> inline)
+ first <- cell
+ sepPipe
+ rest <- cell `sepBy1` sepPipe
+ optional (char '|')
+ blankline
+ return $ map (\ils ->
+ if null ils
+ then []
+ else [Plain $ normalizeSpaces ils]) (first:rest)
+
+pipeTableHeaderPart :: Parser [Char] st Alignment
+pipeTableHeaderPart = do
+ left <- optionMaybe (char ':')
+ many1 (char '-')
+ right <- optionMaybe (char ':')
+ return $
+ case (left,right) of
+ (Nothing,Nothing) -> AlignDefault
+ (Just _,Nothing) -> AlignLeft
+ (Nothing,Just _) -> AlignRight
+ (Just _,Just _) -> AlignCenter
+
table :: Parser [Char] ParserState Block
table = multilineTable False <|> simpleTable True <|>
simpleTable False <|> multilineTable True <|>
- extraTable False <|> extraTable True <|>
+ pipeTable False <|> pipeTable True <|>
gridTable False <|> gridTable True <?> "table"
--