Add DokuWiki table alignment for #5202 (#7908)

Closes #5202.

Within each cell, determine the cell alignment as per
https://www.dokuwiki.org/wiki:syntax#tables. The current approach, as
per the issue treats the first row's alignment as determining
that of the entire column. Given this, it wastes some work in
determining an alignment for every cell.

2 files changed, 52 insertions, 12 deletions

diff --git a/src/Text/Pandoc/Readers/DokuWiki.hs b/src/Text/Pandoc/Readers/DokuWiki.hs
index db98ac8de..82df2784e 100644
--- a/src/Text/Pandoc/Readers/DokuWiki.hs
+++ b/src/Text/Pandoc/Readers/DokuWiki.hs
@@ -19,8 +19,8 @@ import Control.Monad
 import Control.Monad.Except (throwError)
 import Data.Char (isAlphaNum, isDigit)
 import qualified Data.Foldable as F
-import Data.List (transpose)
 import Data.Maybe (fromMaybe, catMaybes)
+import Data.Bifunctor (second)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Text.Pandoc.Builder as B
@@ -30,6 +30,8 @@ import Text.Pandoc.Error (PandocError (PandocParsecError))
 import Text.Pandoc.Options
 import Text.Pandoc.Parsing hiding (enclosed, nested)
 import Text.Pandoc.Shared (trim, stringify, tshow)
+import Data.List (isPrefixOf, isSuffixOf)
+import qualified Safe
 
 -- | Read DokuWiki from an input string and return a Pandoc document.
 readDokuWiki :: (PandocMonad m, ToSources a)
@@ -96,7 +98,11 @@ codeTag f tag = try $ f
 -- | Parse any inline element but softbreak.
 inline' :: PandocMonad m => DWParser m B.Inlines
 inline' = whitespace
-      <|> br
+      <|> inline''
+
+-- | Parse any inline element but whitespace.
+inline'' :: PandocMonad m => DWParser m B.Inlines
+inline'' = br
       <|> bold
       <|> italic
       <|> underlined
@@ -121,6 +127,10 @@ inline' = whitespace
       <|> symbol
       <?> "inline"
 
+-- | Parse any inline element but soft breaks and do not consolidate spaces.
+inlineUnconsolidatedWhitespace :: PandocMonad m => DWParser m B.Inlines
+inlineUnconsolidatedWhitespace = (B.space <$ spaceChar) <|> inline'
+
 -- | Parse any inline element, including soft break.
 inline :: PandocMonad m => DWParser m B.Inlines
 inline = endline <|> inline'
@@ -468,22 +478,28 @@ table :: PandocMonad m => DWParser m B.Blocks
 table = do
   firstSeparator <- lookAhead tableCellSeparator
   rows <- tableRows
+  let firstRow = fromMaybe [] . Safe.headMay $ rows
   let (headerRow, body) = if firstSeparator == '^'
-                            then (head rows, tail rows)
+                            then (firstRow, tail rows)
                             else ([], rows)
-  let attrs = (AlignDefault, ColWidthDefault) <$ transpose rows
+  -- Since Pandoc only has column level alignment, we have to make an arbitrary
+  -- choice of how to reconcile potentially different alignments in the row.
+  -- Here we end up assuming that the alignment of the header / first row is
+  -- what the user wants to apply to the whole thing.
+  let attrs =  map (\(a, _) -> (a, ColWidthDefault)) firstRow
   let toRow = Row nullAttr . map B.simpleCell
       toHeaderRow l = [toRow l | not (null l)]
   pure $ B.table B.emptyCaption
                  attrs
-                 (TableHead nullAttr $ toHeaderRow headerRow)
-                 [TableBody nullAttr 0 [] $ map toRow body]
+                 (TableHead nullAttr $ toHeaderRow (map snd headerRow))
+                 [TableBody nullAttr 0 [] $ map (toRow . (map snd)) body]
                  (TableFoot nullAttr [])
 
-tableRows :: PandocMonad m => DWParser m [[B.Blocks]]
+
+tableRows :: PandocMonad m => DWParser m [[(Alignment, B.Blocks)]]
 tableRows = many1 tableRow
 
-tableRow :: PandocMonad m => DWParser m [B.Blocks]
+tableRow :: PandocMonad m => DWParser m [(Alignment, B.Blocks)]
 tableRow = many1Till tableCell tableRowEnd
 
 tableRowEnd :: PandocMonad m => DWParser m Char
@@ -492,11 +508,23 @@ tableRowEnd = try $ tableCellSeparator <* manyTill spaceChar eol
 tableCellSeparator :: PandocMonad m => DWParser m Char
 tableCellSeparator = char '|' <|> char '^'
 
-tableCell :: PandocMonad m => DWParser m B.Blocks
-tableCell = try $ B.plain . B.trimInlines . mconcat <$> (normalCell <|> headerCell)
+tableCell :: PandocMonad m => DWParser m (Alignment, B.Blocks)
+tableCell = try $ (second (B.plain . B.trimInlines . mconcat)) <$> cellContent
   where
-    normalCell = char '|' *> manyTill inline' (lookAhead tableCellSeparator)
-    headerCell = char '^' *> manyTill inline' (lookAhead tableCellSeparator)
+    cellContent = do
+      -- https://www.dokuwiki.org/wiki:syntax#tables
+      -- DokuWiki represents the alignment of cells with two spaces padding.
+      tableCellSeparator
+      cellInline <- manyTill inlineUnconsolidatedWhitespace (lookAhead tableCellSeparator)
+      let left  = [B.space, B.space] `isPrefixOf` cellInline
+      let right = [B.space, B.space] `isSuffixOf` cellInline
+      let alignment = case (left, right) of
+                           (True, True)   -> AlignCenter
+                           (True, False)  -> AlignRight
+                           (False, True)  -> AlignLeft
+                           (False, False) -> AlignDefault
+      return (alignment, cellInline)
+
 
 blockCode :: PandocMonad m => DWParser m B.Blocks
 blockCode = codeTag B.codeBlockWith "code"
diff --git a/test/Tests/Readers/DokuWiki.hs b/test/Tests/Readers/DokuWiki.hs
index 84ba86d46..db52a34a6 100644
--- a/test/Tests/Readers/DokuWiki.hs
+++ b/test/Tests/Readers/DokuWiki.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {- |
    Module      : Tests.Readers.DokuWiki
    Copyright   : © 2018-2020 Alexander Krotov
@@ -300,6 +301,17 @@ tests = [ testGroup "inlines"
                     , "| bat | baz |"
                     ] =?>
           simpleTable [plain "foo", plain "bar"] [[plain "bat", plain "baz"]]
+        , "Table with alignment" =:
+          T.unlines [ "^ 0  ^  1  ^  2 ^ 3 ^"
+                    , "| a  | b   | c  |d  |"
+                    ] =?>
+          table emptyCaption 
+                (map (, ColWidthDefault) [AlignLeft, AlignCenter, AlignRight, AlignDefault])  
+                (TableHead nullAttr 
+                          [Row nullAttr . map (simpleCell . plain) $ ["0", "1", "2", "3"]])
+                [TableBody nullAttr 0 []
+                          [Row nullAttr . map (simpleCell . plain) $ ["a", "b", "c", "d"]]]
+                (TableFoot nullAttr []) 
         , "Table with colspan" =:
           T.unlines [ "^ 0,0 ^ 0,1 ^ 0,2 ^"
                     , "| 1,0 | 1,1 ||"