Muse reader: add grid tables support

1 files changed, 31 insertions, 2 deletions

diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index e3c8392e6..2ddaffabd 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -32,8 +32,6 @@ Conversion of Muse text to 'Pandoc' document.
 -}
 {-
 TODO:
-- Org tables
-- table.el tables
 - <cite> tag
 -}
 module Text.Pandoc.Readers.Muse (readMuse) where
@@ -335,6 +333,7 @@ blockElements = (mempty <$ blankline)
             <|> playTag
             <|> verseTag
             <|> lineBlock
+            <|> museGridTable
             <|> table
             <|> commentTag
 
@@ -681,6 +680,36 @@ elementsToTable :: [MuseTableElement] -> MuseTable
 elementsToTable = foldr museAppendElement emptyTable
   where emptyTable = MuseTable mempty mempty mempty mempty
 
+museGridPart :: PandocMonad m => MuseParser m Int
+museGridPart = try $ length <$> many1 (char '-') <* char '+'
+
+museGridTableHeader :: PandocMonad m => MuseParser m [Int]
+museGridTableHeader = try $ char '+' *> many1 museGridPart <* manyTill spaceChar eol
+
+museGridTableRow :: PandocMonad m
+                 => Int
+                 -> [Int]
+                 -> MuseParser m (F [Blocks])
+museGridTableRow indent indices = try $ do
+  lns <- many1 $ try (indentWith indent *> museGridTableRawLine indices)
+  let cols = map unlines $ transpose lns
+  indentWith indent *> museGridTableHeader
+  sequence <$> mapM (parseFromString parseBlocks) cols
+
+museGridTableRawLine :: PandocMonad m
+                     => [Int]
+                     -> MuseParser m [String]
+museGridTableRawLine indices =
+  char '|' *> forM indices (\n -> count n anyChar <* char '|') <* manyTill spaceChar eol
+
+museGridTable :: PandocMonad m => MuseParser m (F Blocks)
+museGridTable = try $ do
+  indent <- getIndent
+  indices <- museGridTableHeader
+  fmap rowsToTable . sequence <$> many1 (museGridTableRow indent indices)
+  where rowsToTable rows = B.table mempty attrs [] rows
+                           where attrs = const (AlignDefault, 0.0) <$> transpose rows
+
 -- | Parse a table.
 table :: PandocMonad m => MuseParser m (F Blocks)
 table = try $ fmap (museToPandocTable . elementsToTable) <$> tableElements