diff options
| -rw-r--r-- | src/Text/Pandoc/Parsing.hs | 49 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 12 |
2 files changed, 35 insertions, 26 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index a6d3cd46a..e0c0e36d6 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -762,21 +762,22 @@ lineBlockLines = try $ do -- | Parse a table using 'headerParser', 'rowParser', -- 'lineParser', and 'footerParser'. -tableWith :: Stream s m Char - => ParserT s ParserState m ([Blocks], [Alignment], [Int]) - -> ([Int] -> ParserT s ParserState m [Blocks]) - -> ParserT s ParserState m sep - -> ParserT s ParserState m end - -> ParserT s ParserState m Blocks +tableWith :: (Stream s m Char, HasReaderOptions st, + Functor mf, Applicative mf, Monad mf) + => ParserT s st m (mf [Blocks], [Alignment], [Int]) + -> ([Int] -> ParserT s st m (mf [Blocks])) + -> ParserT s st m sep + -> ParserT s st m end + -> ParserT s st m (mf Blocks) tableWith headerParser rowParser lineParser footerParser = try $ do (heads, aligns, indices) <- headerParser - lines' <- rowParser indices `sepEndBy1` lineParser + lines' <- sequence <$> rowParser indices `sepEndBy1` lineParser footerParser numColumns <- getOption readerColumns let widths = if (indices == []) then replicate (length aligns) 0.0 else widthsFromIndices numColumns indices - return $ B.table mempty (zip aligns widths) heads lines' + return $ B.table mempty (zip aligns widths) <$> heads <*> lines' -- Calculate relative widths of table columns, based on indices widthsFromIndices :: Int -- Number of columns on terminal @@ -809,10 +810,11 @@ widthsFromIndices numColumns' indices = -- (which may be grid), then the rows, -- which may be grid, separated by blank lines, and -- ending with a footer (dashed line followed by blank line). -gridTableWith :: Stream [Char] m Char - => ParserT [Char] ParserState m Blocks -- ^ Block list parser - -> Bool -- ^ Headerless table - -> ParserT [Char] ParserState m Blocks +gridTableWith :: (Stream [Char] m Char, HasReaderOptions st, + Functor mf, Applicative mf, Monad mf) + => ParserT [Char] st m (mf Blocks) -- ^ Block list parser + -> Bool -- ^ Headerless table + -> ParserT [Char] st m (mf Blocks) gridTableWith blocks headless = tableWith (gridTableHeader headless blocks) (gridTableRow blocks) (gridTableSep '-') gridTableFooter @@ -835,14 +837,14 @@ removeFinalBar = reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse -- | Separator between rows of grid table. -gridTableSep :: Stream s m Char => Char -> ParserT s ParserState m Char +gridTableSep :: Stream s m Char => Char -> ParserT s st m Char gridTableSep ch = try $ gridDashedLines ch >> return '\n' -- | Parse header for a grid table. -gridTableHeader :: Stream [Char] m Char +gridTableHeader :: (Stream [Char] m Char, Functor mf, Applicative mf, Monad mf) => Bool -- ^ Headerless table - -> ParserT [Char] ParserState m Blocks - -> ParserT [Char] ParserState m ([Blocks], [Alignment], [Int]) + -> ParserT [Char] st m (mf Blocks) + -> ParserT [Char] st m (mf [Blocks], [Alignment], [Int]) gridTableHeader headless blocks = try $ do optional blanklines dashes <- gridDashedLines '-' @@ -862,25 +864,26 @@ gridTableHeader headless blocks = try $ do then replicate (length dashes) "" else map (intercalate " ") $ transpose $ map (gridTableSplitLine indices) rawContent - heads <- mapM (parseFromString blocks) $ map trim rawHeads + heads <- fmap sequence . mapM (parseFromString blocks) $ map trim rawHeads return (heads, aligns, indices) -gridTableRawLine :: Stream s m Char => [Int] -> ParserT s ParserState m [String] +gridTableRawLine :: Stream s m Char => [Int] -> ParserT s st m [String] gridTableRawLine indices = do char '|' line <- many1Till anyChar newline return (gridTableSplitLine indices line) -- | Parse row of grid table. -gridTableRow :: Stream [Char] m Char - => ParserT [Char] ParserState m Blocks +gridTableRow :: (Stream [Char] m Char, Functor mf, Applicative mf, Monad mf) + => ParserT [Char] st m (mf Blocks) -> [Int] - -> ParserT [Char] ParserState m [Blocks] + -> ParserT [Char] st m (mf [Blocks]) gridTableRow blocks indices = do colLines <- many1 (gridTableRawLine indices) let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $ transpose colLines - mapM (liftM compactifyCell . parseFromString blocks) cols + cells <- sequence <$> mapM (parseFromString blocks) cols + return $ fmap (map compactifyCell) cells removeOneLeadingSpace :: [String] -> [String] removeOneLeadingSpace xs = @@ -894,7 +897,7 @@ compactifyCell :: Blocks -> Blocks compactifyCell bs = head $ compactify [bs] -- | Parse footer for a grid table. -gridTableFooter :: Stream s m Char => ParserT s ParserState m [Char] +gridTableFooter :: Stream s m Char => ParserT s st m [Char] gridTableFooter = blanklines --- diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 7564998ff..628351f36 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -32,6 +32,7 @@ Conversion from reStructuredText to 'Pandoc' document. -} module Text.Pandoc.Readers.RST ( readRST ) where import Control.Monad (guard, liftM, mzero, when) +import Control.Monad.Identity (Identity(..)) import Control.Monad.Except (throwError) import Data.Char (isHexDigit, isSpace, toLower, toUpper) import Data.List (deleteFirstsBy, findIndex, intercalate, isInfixOf, isSuffixOf, @@ -1119,8 +1120,12 @@ simpleTable :: PandocMonad m => Bool -- ^ Headerless table -> RSTParser m Blocks simpleTable headless = do - tbl <- tableWith (simpleTableHeader headless) simpleTableRow - sep simpleTableFooter + let wrapIdFst (a, b, c) = (Identity a, b, c) + wrapId = fmap Identity + tbl <- runIdentity <$> tableWith + (wrapIdFst <$> simpleTableHeader headless) + (wrapId <$> simpleTableRow) + sep simpleTableFooter -- Simple tables get 0s for relative column widths (i.e., use default) case B.toList tbl of [Table c a _w h l] -> return $ B.singleton $ @@ -1134,7 +1139,8 @@ simpleTable headless = do gridTable :: PandocMonad m => Bool -- ^ Headerless table -> RSTParser m Blocks -gridTable headerless = gridTableWith parseBlocks headerless +gridTable headerless = runIdentity <$> + gridTableWith (Identity <$> parseBlocks) headerless table :: PandocMonad m => RSTParser m Blocks table = gridTable False <|> simpleTable False <|> |