Allow alignments to be specified in Markdown grid tables.

MANUAL.txt

@@ -2356,11 +2356,28 @@ Grid tables look like this:
 The row of `=`s separates the header from the table body, and can be
 omitted for a headerless table. The cells of grid tables may contain
 arbitrary block elements (multiple paragraphs, code blocks, lists,
-etc.). Alignments are not supported, nor are cells that span multiple
+etc.). Cells that span multiple columns or rows are not
-columns or rows. Grid tables can be created easily using [Emacs table mode].
+supported. Grid tables can be created easily using [Emacs table mode].
 
 [Emacs table mode]: http://table.sourceforge.net/
 
+Alignments can be specified as with pipe tables, by putting
+colons at the boundaries of the separator line after the
+header:
+
+    +---------------+---------------+--------------------+
+    | Right         | Left          | Centered           |
+    +==============:+:==============+:==================:+
+    | Bananas       | $1.34         | built-in wrapper   |
+    +---------------+---------------+--------------------+
+
+For headerless tables, the colons go on the top line instead:
+
+    +--------------:+:--------------+:------------------:+
+    | Right         | Left          | Centered           |
+    +---------------+---------------+--------------------+
+
+
 #### Extension: `pipe_tables` ####
 
 Pipe tables look like this:

src/Text/Pandoc/Readers/Markdown.hs

@@ -1271,14 +1271,22 @@ gridTableSplitLine :: [Int] -> String -> [String]
 gridTableSplitLine indices line = map removeFinalBar $ tail $
   splitStringByIndices (init indices) $ trimr line
 
-gridPart :: Char -> Parser [Char] st (Int, Int)
+gridPart :: Char -> Parser [Char] st ((Int, Int), Alignment)
 gridPart ch = do
+  leftColon <- option False (True <$ char ':')
   dashes <- many1 (char ch)
+  rightColon <- option False (True <$ char ':')
   char '+'
-  let lengthDashes = length dashes
+  let lengthDashes = length dashes + (if leftColon then 1 else 0) +
-  return (lengthDashes, lengthDashes + 1)
+                       (if rightColon then 1 else 0)
+  let alignment = case (leftColon, rightColon) of
+                       (True, True)   -> AlignCenter
+                       (True, False)  -> AlignLeft
+                       (False, True)  -> AlignRight
+                       (False, False) -> AlignDefault
+  return ((lengthDashes, lengthDashes + 1), alignment)
 
-gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]
+gridDashedLines :: Char -> Parser [Char] st [((Int, Int), Alignment)]
 gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
 
 removeFinalBar :: String -> String
@@ -1296,19 +1304,17 @@ gridTableHeader headless = try $ do
   optional blanklines
   dashes <- gridDashedLines '-'
   rawContent  <- if headless
-                    then return $ repeat ""
+                    then return []
-                    else many1
+                    else many1 (try (char '|' >> anyLine))
-                         (notFollowedBy (gridTableSep '=') >> char '|' >>
+  underDashes <- if headless
-                           many1Till anyChar newline)
+                    then return dashes
-  if headless
+                    else gridDashedLines '='
-     then return ()
+  guard $ length dashes == length underDashes
-     else gridTableSep '=' >> return ()
+  let lines'   = map (snd . fst) underDashes
-  let lines'   = map snd dashes
   let indices  = scanl (+) 0 lines'
-  let aligns   = replicate (length lines') AlignDefault
+  let aligns   = map snd underDashes
-  -- RST does not have a notion of alignments
   let rawHeads = if headless
-                    then replicate (length dashes) ""
+                    then replicate (length underDashes) ""
                     else map (unlines . map trim) $ transpose
                        $ map (gridTableSplitLine indices) rawContent
   heads <- fmap sequence $ mapM (parseFromString parseBlocks . trim) rawHeads
@@ -1317,7 +1323,7 @@ gridTableHeader headless = try $ do
 gridTableRawLine :: [Int] -> MarkdownParser [String]
 gridTableRawLine indices = do
   char '|'
-  line <- many1Till anyChar newline
+  line <- anyLine
   return (gridTableSplitLine indices line)
 
 -- | Parse row of grid table.

src/Text/Pandoc/Writers/Markdown.hs

@@ -632,12 +632,13 @@ pandocTable opts headless aligns widths rawHeaders rawRows =  do
 
 gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
           -> [Doc] -> [[Doc]] -> MD Doc
-gridTable opts headless _aligns widths headers' rawRows =  do
+gridTable opts headless aligns widths headers' rawRows =  do
   let numcols = length headers'
   let widths' = if all (==0) widths
                    then replicate numcols (1.0 / fromIntegral numcols)
                    else widths
-  let widthsInChars = map (floor . (fromIntegral (writerColumns opts) *)) widths'
+  let widthsInChars = map
+         ((\x -> x - 1) . floor . (fromIntegral (writerColumns opts) *)) widths'
   let hpipeBlocks blocks = hcat [beg, middle, end]
         where h       = maximum (1 : map height blocks)
               sep'    = lblock 3 $ vcat (map text $ replicate h " | ")
@@ -647,15 +648,34 @@ gridTable opts headless _aligns widths headers' rawRows =  do
   let makeRow = hpipeBlocks . zipWith lblock widthsInChars
   let head' = makeRow headers'
   let rows' = map (makeRow . map chomp) rawRows
-  let border ch = char '+' <> char ch <>
+  let borderpart ch align widthInChars =
-                  (hcat $ intersperse (char ch <> char '+' <> char ch) $
+        let widthInChars' = if widthInChars < 1 then 1 else widthInChars
-                          map (\l -> text $ replicate l ch) widthsInChars) <>
+        in (if (align == AlignLeft || align == AlignCenter)
-                  char ch <> char '+'
+               then char ':'
-  let body = vcat $ intersperse (border '-') rows'
+               else char ch) <>
+           text (replicate widthInChars' ch) <>
+           (if (align == AlignRight || align == AlignCenter)
+               then char ':'
+               else char ch)
+  let border ch aligns' widthsInChars' =
+        char '+' <>
+        hcat (intersperse (char '+') (zipWith (borderpart ch)
+                aligns' widthsInChars')) <> char '+'
+  let body = vcat $ intersperse (border '-' (repeat AlignDefault) widthsInChars)
+                    rows'
   let head'' = if headless
                   then empty
-                  else head' $$ border '='
+                  else head' $$ border '=' aligns widthsInChars
-  return $ border '-' $$ head'' $$ body $$ border '-'
+  if headless
+     then return $
+           border '-' aligns widthsInChars $$
+           body $$
+           border '-' (repeat AlignDefault) widthsInChars
+     else return $
+           border '-' (repeat AlignDefault) widthsInChars $$
+           head'' $$
+           body $$
+           border '-' (repeat AlignDefault) widthsInChars
 
 itemEndsWithTightList :: [Block] -> Bool
 itemEndsWithTightList bs =

tests/markdown-reader-more.native

@@ -116,6 +116,28 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "Author",S
  ,[[Para [Str "r2",Space,Str "d"]]
   ,[Para [Str "e"]]
   ,[Para [Str "f"]]]]
+,Para [Str "With",Space,Str "alignments"]
+,Table [] [AlignRight,AlignLeft,AlignCenter] [0.2638888888888889,0.16666666666666666,0.18055555555555555]
+ [[Plain [Str "col",Space,Str "1"]]
+ ,[Plain [Str "col",Space,Str "2"]]
+ ,[Plain [Str "col",Space,Str "3"]]]
+ [[[Para [Str "r1",Space,Str "a",SoftBreak,Str "r1",Space,Str "bis"]]
+  ,[Para [Str "b",SoftBreak,Str "b",Space,Str "2"]]
+  ,[Para [Str "c",SoftBreak,Str "c",Space,Str "2"]]]
+ ,[[Para [Str "r2",Space,Str "d"]]
+  ,[Para [Str "e"]]
+  ,[Para [Str "f"]]]]
+,Para [Str "Headless",Space,Str "with",Space,Str "alignments"]
+,Table [] [AlignRight,AlignLeft,AlignCenter] [0.2638888888888889,0.16666666666666666,0.18055555555555555]
+ [[]
+ ,[]
+ ,[]]
+ [[[Para [Str "r1",Space,Str "a",SoftBreak,Str "r1",Space,Str "bis"]]
+  ,[Para [Str "b",SoftBreak,Str "b",Space,Str "2"]]
+  ,[Para [Str "c",SoftBreak,Str "c",Space,Str "2"]]]
+ ,[[Para [Str "r2",Space,Str "d"]]
+  ,[Para [Str "e"]]
+  ,[Para [Str "f"]]]]
 ,Para [Str "Spaces",Space,Str "at",Space,Str "ends",Space,Str "of",Space,Str "lines"]
 ,Table [] [AlignDefault,AlignDefault,AlignDefault] [0.2638888888888889,0.16666666666666666,0.18055555555555555]
  [[]

tests/markdown-reader-more.txt

@@ -220,6 +220,26 @@ Headless
 | r2 d             | e         | f          |
 +------------------+-----------+------------+
 
+With alignments
+
++------------------+-----------+------------+
+| col 1            | col 2     | col 3      |
++=================:+:==========+:==========:+
+| r1 a             | b         | c          |
+| r1 bis           | b 2       | c 2        |
++------------------+-----------+------------+
+| r2 d             | e         | f          |
++------------------+-----------+------------+
+
+Headless with alignments
+
++-----------------:+:----------+:----------:+
+| r1 a             | b         | c          |
+| r1 bis           | b 2       | c 2        |
++------------------+-----------+------------+
+| r2 d             | e         | f          |
++------------------+-----------+------------+
+
 Spaces at ends of lines
 
 +------------------+-----------+------------+