Add markup support for tables

Tables are composed by an optional header and body. The header is
composed by a single row. The body is composed by a non-empty list of
rows.

Example table with header:

    +----------+----------+
    | /32bit/  |   64bit  |
    +==========+==========+
    |  0x0000  | @0x0000@ |
    +----------+----------+

See #530

Author: potomak

haddock-library/src/Documentation/Haddock/Parser.hs

@@ -78,6 +78,7 @@ overIdentifier f d = g d
     g (DocAName x) = DocAName x
     g (DocProperty x) = DocProperty x
     g (DocExamples x) = DocExamples x
+    g (DocTable (Table h c)) = DocTable $ Table (fmap g <$> h) (fmap g <$> c)
     g (DocHeader (Header l x)) = DocHeader . Header l $ g x
 
 parse :: Parser a -> BS.ByteString -> (ParserState, a)
@@ -251,7 +252,7 @@ markdownImage = fromHyperlink <$> ("!" *> linkParser)
 
 -- | Paragraph parser, called by 'parseParas'.
 paragraph :: Parser (DocH mod Identifier)
-paragraph = examples <|> do
+paragraph = examples <|> table <|> do
   indent <- takeIndent
   choice
     [ since
@@ -422,6 +423,55 @@ takeIndent = do
   indent <- takeHorizontalSpace
   "\n" *> takeIndent <|> return indent
 
+-- | Provides support for simple tables.
+--
+-- Tables are composed by an optional header and body. The header is composed by
+-- a single row. The body is composed by a non-empty list of rows.
+--
+-- Example table with header:
+--
+-- > +----------+----------+
+-- > | /32bit/  |   64bit  |
+-- > +==========+==========+
+-- > |  0x0000  | @0x0000@ |
+-- > +----------+----------+
+table :: Parser (DocH mod Identifier)
+table = do
+  parseTableRowDivider
+  mHeader <- optional parseTableHeader
+  content <- parseTableContent
+  return $ DocTable (Table mHeader content)
+
+parseTableHeader :: Parser [DocH mod Identifier]
+parseTableHeader = parseTableRow <* parseTableHeaderDivider
+
+parseTableContent :: Parser [[DocH mod Identifier]]
+parseTableContent = many1 (parseTableRow <* parseTableRowDivider)
+
+parseTableRow :: Parser [DocH mod Identifier]
+parseTableRow = skipHorizontalSpace *> manyTill columnValue endOfRow
+  where
+    columnValue = parseStringBS . bsStrip <$> ("|" *> takeWhile_ (/= '|'))
+    endOfRow = "|" *> skipHorizontalSpace *> "\n"
+    bsStrip = bsDropWhile isSpace . bsDropWhileEnd isSpace
+    bsDropWhile c = snd . BS.span c
+    bsDropWhileEnd c = fst . BS.spanEnd c
+
+parseTableRowDivider :: Parser ()
+parseTableRowDivider = parseTableDivider "-"
+
+parseTableHeaderDivider :: Parser ()
+parseTableHeaderDivider = parseTableDivider "="
+
+parseTableDivider :: Parser BS.ByteString -> Parser ()
+parseTableDivider c = void $
+       skipHorizontalSpace
+    *> many1 (columnDivider c) *> "+"
+    *> skipHorizontalSpace *> "\n"
+  where
+    columnDivider :: Parser BS.ByteString -> Parser [BS.ByteString]
+    columnDivider d = "+" *> many1 d
+
 -- | Blocks of text of the form:
 --
 -- >> foo

haddock-library/src/Documentation/Haddock/Types.hs

@@ -53,6 +53,11 @@ data Example = Example
   , exampleResult     :: [String]
   } deriving (Eq, Show)
 
+data Table id = Table
+  { tableHeader :: Maybe [id]
+  , tableBody   :: [[id]]
+  } deriving (Eq, Show, Functor, Foldable, Traversable)
+
 data DocH mod id
   = DocEmpty
   | DocAppend (DocH mod id) (DocH mod id)
@@ -76,5 +81,6 @@ data DocH mod id
   | DocAName String
   | DocProperty String
   | DocExamples [Example]
+  | DocTable (Table (DocH mod id))
   | DocHeader (Header (DocH mod id))
   deriving (Eq, Show, Functor, Foldable, Traversable)

haddock-library/test/Documentation/Haddock/ParserSpec.hs

@@ -649,6 +649,50 @@ spec = do
             , " bar"
             ] `shouldParseTo` DocExamples [Example "foo" [" bar"]]
 
+    context "when parsing tables" $ do
+      let simpleTable :: Maybe [DocH () String] -> [[DocH () String]] -> Doc String
+          simpleTable header rows = DocTable (Table header rows)
+          table :: Maybe [DocH () a] -> [[DocH () a]] -> Doc a
+          table header rows = DocTable (Table header rows)
+
+      it "parses a table with a header" $
+        "+----------+----------+\n\
+        \|  32bit   |   64bit  |\n\
+        \+==========+==========+\n\
+        \|  0x0000  |  0x0000  |\n\
+        \+----------+----------+"
+          `shouldParseTo`
+            simpleTable (Just ["32bit", "64bit"]) [["0x0000", "0x0000"]]
+
+      it "parses a table without header" $
+        "+----------+----------+\n\
+        \|  32bit   |   64bit  |\n\
+        \+----------+----------+\n\
+        \|  0x0000  |  0x0000  |\n\
+        \+----------+----------+"
+          `shouldParseTo`
+            simpleTable Nothing [["32bit", "64bit"], ["0x0000", "0x0000"]]
+
+      it "parses a table that contains formatted elements" $
+        "+----------+----------+\n\
+        \| /32bit/  |   64bit  |\n\
+        \+----------+----------+\n\
+        \|  0x0000  | @0x0000@ |\n\
+        \+----------+----------+"
+          `shouldParseTo`
+            table Nothing [
+                [ DocEmphasis (DocString "32bit"), DocString "64bit" ]
+              , [ DocString "0x0000", DocMonospaced (DocString "0x0000") ]
+              ]
+
+      it "can deal with whitespace before and after each line" $
+        "  +----------+----------+  \n\
+        \  |  32bit   |   64bit  |  \n\
+        \  +----------+----------+  \n\
+        \  |  0x0000  |  0x0000  |  \n\
+        \  +----------+----------+  "
+          `shouldParseTo`
+            simpleTable Nothing [["32bit", "64bit"], ["0x0000", "0x0000"]]
 
     context "when parsing paragraphs nested in lists" $ do
       it "can nest the same type of list" $ do