3 files changed, 85 insertions, 113 deletions
diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs
index 2f76fc1a0..b593c4cc8 100644
--- a/src/Text/Pandoc/Readers/Haddock.hs
+++ b/src/Text/Pandoc/Readers/Haddock.hs
@@ -19,7 +19,7 @@ import Data.List (intersperse, stripPrefix)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text, unpack)
 import Documentation.Haddock.Parser
-import Documentation.Haddock.Types
+import Documentation.Haddock.Types as H
 import Text.Pandoc.Builder (Blocks, Inlines)
 import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Class (PandocMonad)
@@ -85,6 +85,18 @@ docHToBlocks d' =
     DocProperty s -> B.codeBlockWith ("",["property","haskell"],[]) (trim s)
     DocExamples es -> mconcat $ map (\e ->
        makeExample ">>>" (exampleExpression e) (exampleResult e)) es
+    DocTable H.Table{ tableHeaderRows = headerRows
+                    , tableBodyRows = bodyRows
+                    }
+      -> let toCells = map (docHToBlocks . tableCellContents) . tableRowCells
+             (header, body) =
+               if null headerRows
+                  then ([], map toCells bodyRows)
+                  else (toCells (head headerRows),
+                        map toCells (tail headerRows ++ bodyRows))
+             colspecs = replicate (maximum (map length body))
+                             (AlignDefault, 0.0)
+         in  B.table mempty colspecs header body
 
   where inlineFallback = B.plain $ docHToInlines False d'
         consolidatePlains = B.fromList . consolidatePlains' . B.toList
@@ -133,6 +145,7 @@ docHToInlines isCode d' =
     DocAName s -> B.spanWith (s,["anchor"],[]) mempty
     DocProperty _ -> mempty
     DocExamples _ -> mempty
+    DocTable _ -> mempty
 
 -- | Create an 'Example', stripping superfluous characters as appropriate
 makeExample :: String -> String -> [String] -> Blocks
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 688c1f390..3f96f5802 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -35,7 +35,6 @@ Haddock:  <http://www.haskell.org/haddock/doc/html/>
 module Text.Pandoc.Writers.Haddock (writeHaddock) where
 import Control.Monad.State.Strict
 import Data.Default
-import Data.List (intersperse, transpose)
 import Data.Text (Text)
 import Text.Pandoc.Class (PandocMonad, report)
 import Text.Pandoc.Definition
@@ -136,29 +135,15 @@ blockToHaddock _ (CodeBlock (_,_,_) str) =
 -- Nothing in haddock corresponds to block quotes:
 blockToHaddock opts (BlockQuote blocks) =
   blockListToHaddock opts blocks
--- Haddock doesn't have tables.  Use haddock tables in code.
 blockToHaddock opts (Table caption aligns widths headers rows) = do
   caption' <- inlineListToHaddock opts caption
   let caption'' = if null caption
                      then empty
                      else blankline <> caption' <> blankline
-  rawHeaders <- mapM (blockListToHaddock opts) headers
-  rawRows <- mapM (mapM (blockListToHaddock opts)) rows
-  let isSimple = all (==0) widths
-  let isPlainBlock (Plain _) = True
-      isPlainBlock _         = False
-  let hasBlocks = not (all isPlainBlock $ concat . concat $ headers:rows)
-  (nst,tbl) <- case True of
-                _ | isSimple -> (nest 2,) <$>
-                         pandocTable opts (all null headers) aligns widths
-                             rawHeaders rawRows
-                  | not hasBlocks -> (nest 2,) <$>
-                         pandocTable opts (all null headers) aligns widths
-                             rawHeaders rawRows
-                  | otherwise -> (id,) <$>
-                         gridTable opts blockListToHaddock
-                          (all null headers) aligns widths headers rows
-  return $ prefixed "> " (nst $ tbl $$ blankline $$ caption'') $$ blankline
+  tbl <- gridTable opts blockListToHaddock
+              (all null headers) (map (\_ -> AlignDefault) aligns)
+                widths headers rows
+  return $ prefixed "> " (tbl $$ blankline $$ caption'') $$ blankline
 blockToHaddock opts (BulletList items) = do
   contents <- mapM (bulletListItemToHaddock opts) items
   return $ cat contents <> blankline
@@ -174,46 +159,6 @@ blockToHaddock opts (DefinitionList items) = do
   contents <- mapM (definitionListItemToHaddock opts) items
   return $ cat contents <> blankline
 
-pandocTable :: PandocMonad m
-            => WriterOptions -> Bool -> [Alignment] -> [Double]
-            -> [Doc] -> [[Doc]] -> StateT WriterState m Doc
-pandocTable opts headless aligns widths rawHeaders rawRows =  do
-  let isSimple = all (==0) widths
-  let alignHeader alignment = case alignment of
-                                AlignLeft    -> lblock
-                                AlignCenter  -> cblock
-                                AlignRight   -> rblock
-                                AlignDefault -> lblock
-  let numChars = maximum . map offset
-  let widthsInChars = if isSimple
-                         then map ((+2) . numChars)
-                              $ transpose (rawHeaders : rawRows)
-                         else map
-                              (floor . (fromIntegral (writerColumns opts) *))
-                              widths
-  let makeRow = hcat . intersperse (lblock 1 (text " ")) .
-                   zipWith3 alignHeader aligns widthsInChars
-  let rows' = map makeRow rawRows
-  let head' = makeRow rawHeaders
-  let maxRowHeight = maximum $ map height (head':rows')
-  let underline = cat $ intersperse (text " ") $
-                  map (\width -> text (replicate width '-')) widthsInChars
-  let border
-        | maxRowHeight > 1 = text (replicate (sum widthsInChars +
-                 length widthsInChars - 1) '-')
-        | headless = underline
-        | otherwise = empty
-  let head'' = if headless
-                  then empty
-                  else border <> cr <> head'
-  let body = if maxRowHeight > 1
-                then vsep rows'
-                else vcat rows'
-  let bottom = if headless
-                  then underline
-                  else border
-  return $ head'' $$ underline $$ body $$ bottom
-
 -- | Convert bullet list item (list of blocks) to haddock
 bulletListItemToHaddock :: PandocMonad m
                         => WriterOptions -> [Block] -> StateT WriterState m Doc
diff --git a/test/tables.haddock b/test/tables.haddock
index 84a15cce8..678c5c15a 100644
--- a/test/tables.haddock
+++ b/test/tables.haddock
@@ -1,76 +1,90 @@
 Simple table with caption:
 
->     Right Left    Center  Default
->   ------- ------ -------- ---------
->        12 12        12    12
->       123 123      123    123
->         1 1         1     1
+> +-------+------+--------+---------+
+> | Right | Left | Center | Default |
+> +=======+======+========+=========+
+> | 12    | 12   | 12     | 12      |
+> +-------+------+--------+---------+
+> | 123   | 123  | 123    | 123     |
+> +-------+------+--------+---------+
+> | 1     | 1    | 1      | 1       |
+> +-------+------+--------+---------+
 >
->   Demonstration of simple table syntax.
+> Demonstration of simple table syntax.
 
 Simple table without caption:
 
->     Right Left    Center  Default
->   ------- ------ -------- ---------
->        12 12        12    12
->       123 123      123    123
->         1 1         1     1
+> +-------+------+--------+---------+
+> | Right | Left | Center | Default |
+> +=======+======+========+=========+
+> | 12    | 12   | 12     | 12      |
+> +-------+------+--------+---------+
+> | 123   | 123  | 123    | 123     |
+> +-------+------+--------+---------+
+> | 1     | 1    | 1      | 1       |
+> +-------+------+--------+---------+
 
 Simple table indented two spaces:
 
->     Right Left    Center  Default
->   ------- ------ -------- ---------
->        12 12        12    12
->       123 123      123    123
->         1 1         1     1
+> +-------+------+--------+---------+
+> | Right | Left | Center | Default |
+> +=======+======+========+=========+
+> | 12    | 12   | 12     | 12      |
+> +-------+------+--------+---------+
+> | 123   | 123  | 123    | 123     |
+> +-------+------+--------+---------+
+> | 1     | 1    | 1      | 1       |
+> +-------+------+--------+---------+
 >
->   Demonstration of simple table syntax.
+> Demonstration of simple table syntax.
 
 Multiline table with caption:
 
->   --------------------------------------------------------------
->    Centered   Left              Right Default aligned
->     Header    Aligned         Aligned 
->   ----------- ---------- ------------ --------------------------
->      First    row                12.0 Example of a row that
->                                       spans multiple lines.
+> +----------+---------+-----------+-------------------------+
+> | Centered | Left    | Right     | Default aligned         |
+> | Header   | Aligned | Aligned   |                         |
+> +==========+=========+===========+=========================+
+> | First    | row     | 12.0      | Example of a row that   |
+> |          |         |           | spans multiple lines.   |
+> +----------+---------+-----------+-------------------------+
+> | Second   | row     | 5.0       | Here’s another one.     |
+> |          |         |           | Note the blank line     |
+> |          |         |           | between rows.           |
+> +----------+---------+-----------+-------------------------+
 >
->     Second    row                 5.0 Here’s another one. Note
->                                       the blank line between
->                                       rows.
->   --------------------------------------------------------------
->
->   Here’s the caption. It may span multiple lines.
+> Here’s the caption. It may span multiple lines.
 
 Multiline table without caption:
 
->   --------------------------------------------------------------
->    Centered   Left              Right Default aligned
->     Header    Aligned         Aligned 
->   ----------- ---------- ------------ --------------------------
->      First    row                12.0 Example of a row that
->                                       spans multiple lines.
->
->     Second    row                 5.0 Here’s another one. Note
->                                       the blank line between
->                                       rows.
->   --------------------------------------------------------------
+> +----------+---------+-----------+-------------------------+
+> | Centered | Left    | Right     | Default aligned         |
+> | Header   | Aligned | Aligned   |                         |
+> +==========+=========+===========+=========================+
+> | First    | row     | 12.0      | Example of a row that   |
+> |          |         |           | spans multiple lines.   |
+> +----------+---------+-----------+-------------------------+
+> | Second   | row     | 5.0       | Here’s another one.     |
+> |          |         |           | Note the blank line     |
+> |          |         |           | between rows.           |
+> +----------+---------+-----------+-------------------------+
 
 Table without column headers:
 
->   ----- ----- ----- -----
->      12 12     12      12
->     123 123    123    123
->       1 1       1       1
->   ----- ----- ----- -----
+> +-----+-----+-----+-----+
+> | 12  | 12  | 12  | 12  |
+> +-----+-----+-----+-----+
+> | 123 | 123 | 123 | 123 |
+> +-----+-----+-----+-----+
+> | 1   | 1   | 1   | 1   |
+> +-----+-----+-----+-----+
 
 Multiline table without column headers:
 
->   ----------- ---------- ------------ --------------------------
->      First    row                12.0 Example of a row that
->                                       spans multiple lines.
->
->     Second    row                 5.0 Here’s another one. Note
->                                       the blank line between
->                                       rows.
->   ----------- ---------- ------------ --------------------------
+> +----------+---------+-----------+-------------------------+
+> | First    | row     | 12.0      | Example of a row that   |
+> |          |         |           | spans multiple lines.   |
+> +----------+---------+-----------+-------------------------+
+> | Second   | row     | 5.0       | Here’s another one.     |
+> |          |         |           | Note the blank line     |
+> |          |         |           | between rows.           |
+> +----------+---------+-----------+-------------------------+