Added support for markdown-extra tables in the markdown parser

Only tables whose lines begin with a "|" are supported.
There are 2 warnings about unused variables when compiling.

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"

src/Text/Pandoc/Parsing.hs

@@ -56,6 +56,7 @@ module Text.Pandoc.Parsing ( (>>~),
                              orderedListMarker,
                              charRef,
                              tableWith,
+                             extraTableWith,
                              gridTableWith,
                              readWith,
                              testStringWith,
@@ -487,7 +488,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
@@ -515,6 +518,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

src/Text/Pandoc/Readers/Markdown.hs

@@ -899,6 +899,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
           -> GenParser Char ParserState Block
 gridTable = gridTableWith block tableCaption
@@ -906,6 +910,7 @@ gridTable = gridTableWith block tableCaption
 table :: GenParser Char ParserState Block
 table = multilineTable False <|> simpleTable True <|>
         simpleTable False <|> multilineTable True <|>
+        extraTable False <|> extraTable True <|>
         gridTable False <|> gridTable True <?> "table"
 
 --