T.P.Parsing: Generalize readWithM to any Char Stream.

[API change]

2 files changed, 14 insertions, 6 deletions

diff --git a/pandoc.cabal b/pandoc.cabal
index 0f6cdbf75..a6bf04296 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -394,7 +394,8 @@ library
                  http-types >= 0.8 && < 0.13,
                  case-insensitive >= 1.2 && < 1.3,
                  unicode-transforms >= 0.3 && < 0.4,
-                 HsYAML >= 0.1.1.1 && < 0.2
+                 HsYAML >= 0.1.1.1 && < 0.2,
+                 monad-loops >= 0.4 && < 0.5
   if impl(ghc < 8.0)
     build-depends: semigroups == 0.18.*,
                    -- basement 0.0.8 and foundation 0.0.21, transitive
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index a9f323863..d53ea129b 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -198,6 +198,7 @@ where
 
 import Prelude
 import Control.Monad.Identity
+import Control.Monad.Loops (unfoldM)
 import Control.Monad.Reader
 import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper,
                   isPunctuation, isSpace, ord, toLower, toUpper)
@@ -221,6 +222,7 @@ import Text.Pandoc.Shared
 import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
 import Text.Pandoc.XML (fromEntities)
 import Text.Parsec hiding (token)
+import qualified Text.Parsec (uncons)
 import Text.Parsec.Pos (initialPos, newPos, updatePosString)
 
 import Control.Monad.Except
@@ -1044,13 +1046,18 @@ gridTableFooter = blanklines
 ---
 
 -- | Removes the ParsecT layer from the monad transformer stack
-readWithM :: Monad m
-          => ParserT [Char] st m a    -- ^ parser
+readWithM :: (Monad m, Stream s m Char)
+          => ParserT s st m a         -- ^ parser
           -> st                       -- ^ initial state
-          -> String                   -- ^ input
+          -> s                        -- ^ input
           -> m (Either PandocError a)
-readWithM parser state input =
-    mapLeft (PandocParsecError input) `liftM` runParserT parser state "source" input
+readWithM parser state input = do
+  res <- runParserT parser state "source" input
+  case res of
+    Right x -> return $ Right x
+    Left e  -> do
+      inp <- map fst <$> unfoldM (Text.Parsec.uncons input)
+      return $ Left $ PandocParsecError inp e
 
 
 -- | Parse a string with a given parser and state