From d2cc56a46a5a3c657429e8df5b93c82f3f9ed9fb Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 22 Jul 2012 22:09:15 -0700 Subject: 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). --- pandoc.cabal | 4 +- src/Tests/Old.hs | 4 +- src/Text/Pandoc/Parsing.hs | 98 ++----------------------------------- src/Text/Pandoc/Readers/Markdown.hs | 56 +++++++++++++++++++-- tests/extra-tables.markdown | 34 ------------- tests/extra-tables.native | 60 ----------------------- tests/pipe-tables.native | 70 ++++++++++++++++++++++++++ tests/pipe-tables.txt | 42 ++++++++++++++++ 8 files changed, 171 insertions(+), 197 deletions(-) delete mode 100644 tests/extra-tables.markdown delete mode 100644 tests/extra-tables.native create mode 100644 tests/pipe-tables.native create mode 100644 tests/pipe-tables.txt diff --git a/pandoc.cabal b/pandoc.cabal index afc6a65f4..ea49fc78e 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -175,8 +175,8 @@ Extra-Source-Files: tests/lhs-test.html, tests/lhs-test.html+lhs, tests/lhs-test.fragment.html+lhs, - tests/extra-tables.markdown, - tests/extra-tables.native + tests/pipe-tables.txt, + tests/pipe-tables.native Extra-Tmp-Files: man/man1/pandoc.1, man/man5/pandoc_markdown.5 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" -- diff --git a/tests/extra-tables.markdown b/tests/extra-tables.markdown deleted file mode 100644 index 69a18113b..000000000 --- a/tests/extra-tables.markdown +++ /dev/null @@ -1,34 +0,0 @@ -Simplest table without caption: - -| Default1 | Default2 | Default3 | -|----------|----------|----------| -|12|12|12| -|123|123|123| -|1|1|1| - -Simple table with caption: - -| Right | Left | Default | Center | -|------:|:-----|---------|:------:| -| 12 | 12 | 12 | 12 | -| 123 | 123 | 123 | 123 | -| 1 | 1 | 1 | 1 | - - : Demonstration of simple table syntax. - -Simple table without caption: - -| Right | Left | Center | -|------:|:-----|:------:| -|12|12|12| -|123|123|123| -|1|1|1| - - -Headerless table without caption: - -|------:|:-----|:------:| -|12|12|12| -|123|123|123| -|1|1|1| - diff --git a/tests/extra-tables.native b/tests/extra-tables.native deleted file mode 100644 index f9580a8cb..000000000 --- a/tests/extra-tables.native +++ /dev/null @@ -1,60 +0,0 @@ -[Para [Str "Simplest",Space,Str "table",Space,Str "without",Space,Str "caption",Str ":"] -,Table [] [AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0] - [[Plain [Str "Default1"]] - ,[Plain [Str "Default2"]] - ,[Plain [Str "Default3"]]] - [[[Plain [Str "12"]] - ,[Plain [Str "12"]] - ,[Plain [Str "12"]]] - ,[[Plain [Str "123"]] - ,[Plain [Str "123"]] - ,[Plain [Str "123"]]] - ,[[Plain [Str "1"]] - ,[Plain [Str "1"]] - ,[Plain [Str "1"]]]] -,Para [Str "Simple",Space,Str "table",Space,Str "with",Space,Str "caption",Str ":"] -,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax",Str "."] [AlignRight,AlignLeft,AlignDefault,AlignCenter] [0.0,0.0,0.0,0.0] - [[Plain [Str "Right"]] - ,[Plain [Str "Left"]] - ,[Plain [Str "Default"]] - ,[Plain [Str "Center"]]] - [[[Plain [Str "12"]] - ,[Plain [Str "12"]] - ,[Plain [Str "12"]] - ,[Plain [Str "12"]]] - ,[[Plain [Str "123"]] - ,[Plain [Str "123"]] - ,[Plain [Str "123"]] - ,[Plain [Str "123"]]] - ,[[Plain [Str "1"]] - ,[Plain [Str "1"]] - ,[Plain [Str "1"]] - ,[Plain [Str "1"]]]] -,Para [Str "Simple",Space,Str "table",Space,Str "without",Space,Str "caption",Str ":"] -,Table [] [AlignRight,AlignLeft,AlignCenter] [0.0,0.0,0.0] - [[Plain [Str "Right"]] - ,[Plain [Str "Left"]] - ,[Plain [Str "Center"]]] - [[[Plain [Str "12"]] - ,[Plain [Str "12"]] - ,[Plain [Str "12"]]] - ,[[Plain [Str "123"]] - ,[Plain [Str "123"]] - ,[Plain [Str "123"]]] - ,[[Plain [Str "1"]] - ,[Plain [Str "1"]] - ,[Plain [Str "1"]]]] -,Para [Str "Headerless",Space,Str "table",Space,Str "without",Space,Str "caption",Str ":"] -,Table [] [AlignRight,AlignLeft,AlignCenter] [0.0,0.0,0.0] - [[] - ,[] - ,[]] - [[[Plain [Str "12"]] - ,[Plain [Str "12"]] - ,[Plain [Str "12"]]] - ,[[Plain [Str "123"]] - ,[Plain [Str "123"]] - ,[Plain [Str "123"]]] - ,[[Plain [Str "1"]] - ,[Plain [Str "1"]] - ,[Plain [Str "1"]]]]] diff --git a/tests/pipe-tables.native b/tests/pipe-tables.native new file mode 100644 index 000000000..2826c7236 --- /dev/null +++ b/tests/pipe-tables.native @@ -0,0 +1,70 @@ +[Para [Str "Simplest",Space,Str "table",Space,Str "without",Space,Str "caption",Str ":"] +,Table [] [AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0] + [[Plain [Str "Default1"]] + ,[Plain [Str "Default2"]] + ,[Plain [Str "Default3"]]] + [[[Plain [Str "12"]] + ,[Plain [Str "12"]] + ,[Plain [Str "12"]]] + ,[[Plain [Str "123"]] + ,[Plain [Str "123"]] + ,[Plain [Str "123"]]] + ,[[Plain [Str "1"]] + ,[Plain [Str "1"]] + ,[Plain [Str "1"]]]] +,Para [Str "Simple",Space,Str "table",Space,Str "with",Space,Str "caption",Str ":"] +,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax",Str "."] [AlignRight,AlignLeft,AlignDefault,AlignCenter] [0.0,0.0,0.0,0.0] + [[Plain [Str "Right"]] + ,[Plain [Str "Left"]] + ,[Plain [Str "Default"]] + ,[Plain [Str "Center"]]] + [[[Plain [Str "12"]] + ,[Plain [Str "12"]] + ,[Plain [Str "12"]] + ,[Plain [Str "12"]]] + ,[[Plain [Str "123"]] + ,[Plain [Str "123"]] + ,[Plain [Str "123"]] + ,[Plain [Str "123"]]] + ,[[Plain [Str "1"]] + ,[Plain [Str "1"]] + ,[Plain [Str "1"]] + ,[Plain [Str "1"]]]] +,Para [Str "Simple",Space,Str "table",Space,Str "without",Space,Str "caption",Str ":"] +,Table [] [AlignRight,AlignLeft,AlignCenter] [0.0,0.0,0.0] + [[Plain [Str "Right"]] + ,[Plain [Str "Left"]] + ,[Plain [Str "Center"]]] + [[[Plain [Str "12"]] + ,[Plain [Str "12"]] + ,[Plain [Str "12"]]] + ,[[Plain [Str "123"]] + ,[Plain [Str "123"]] + ,[Plain [Str "123"]]] + ,[[Plain [Str "1"]] + ,[Plain [Str "1"]] + ,[Plain [Str "1"]]]] +,Para [Str "Headerless",Space,Str "table",Space,Str "without",Space,Str "caption",Str ":"] +,Table [] [AlignRight,AlignLeft,AlignCenter] [0.0,0.0,0.0] + [[] + ,[] + ,[]] + [[[Plain [Str "12"]] + ,[Plain [Str "12"]] + ,[Plain [Str "12"]]] + ,[[Plain [Str "123"]] + ,[Plain [Str "123"]] + ,[Plain [Str "123"]]] + ,[[Plain [Str "1"]] + ,[Plain [Str "1"]] + ,[Plain [Str "1"]]]] +,Para [Str "Table",Space,Str "without",Space,Str "sides",Str ":"] +,Table [] [AlignDefault,AlignRight] [0.0,0.0] + [[Plain [Str "Fruit"]] + ,[Plain [Str "Quantity"]]] + [[[Plain [Str "apple"]] + ,[Plain [Str "5"]]] + ,[[Plain [Str "orange"]] + ,[Plain [Str "17"]]] + ,[[Plain [Str "pear"]] + ,[Plain [Str "302"]]]]] diff --git a/tests/pipe-tables.txt b/tests/pipe-tables.txt new file mode 100644 index 000000000..929038ebb --- /dev/null +++ b/tests/pipe-tables.txt @@ -0,0 +1,42 @@ +Simplest table without caption: + +| Default1 | Default2 | Default3 | +|----------|----------|----------| +|12|12|12| +|123|123|123| +|1|1|1| + +Simple table with caption: + +| Right | Left | Default | Center | +|------:|:-----|---------|:------:| +| 12 | 12 | 12 | 12 | +| 123 | 123 | 123 | 123 | +| 1 | 1 | 1 | 1 | + + : Demonstration of simple table syntax. + +Simple table without caption: + +| Right | Left | Center | +|------:|:-----|:------:| +|12|12|12| +|123|123|123| +|1|1|1| + + +Headerless table without caption: + +|------:|:-----|:------:| +|12|12|12| +|123|123|123| +|1|1|1| + +Table without sides: + +Fruit |Quantity +------|-------: +apple | 5 +orange| 17 +pear | 302 + -- cgit v1.2.3