Generalised readWith to readWithM

This commit is contained in:
Matthew Pickering 2014-07-20 17:04:18 +01:00
parent 5debb492ef
commit e045b1d5f2

View file

@ -64,6 +64,7 @@ module Text.Pandoc.Parsing ( anyLine,
widthsFromIndices, widthsFromIndices,
gridTableWith, gridTableWith,
readWith, readWith,
readWithM,
testStringWith, testStringWith,
guardEnabled, guardEnabled,
guardDisabled, guardDisabled,
@ -825,15 +826,16 @@ gridTableFooter = blanklines
--- ---
-- | Parse a string with a given parser and state. -- | Removes the ParsecT layer from the monad transformer stack
readWith :: (Stream [Char] Identity Char) readWithM :: (Monad m, Functor m)
=> ParserT [Char] st Identity a -- ^ parser => ParserT [Char] st m a -- ^ parser
-> st -- ^ initial state -> st -- ^ initial state
-> [Char] -- ^ input -> String -- ^ input
-> a -> m a
readWith parser state input = readWithM parser state input =
case runParser parser state "source" input of handleError <$> (runParserT parser state "source" input)
Left err' -> where
handleError (Left err') =
let errPos = errorPos err' let errPos = errorPos err'
errLine = sourceLine errPos errLine = sourceLine errPos
errColumn = sourceColumn errPos errColumn = sourceColumn errPos
@ -841,7 +843,14 @@ readWith parser state input =
in error $ "\nError at " ++ show err' ++ "\n" ++ in error $ "\nError at " ++ show err' ++ "\n" ++
theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++ theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++
"^" "^"
Right result -> result handleError (Right result) = result
-- | Parse a string with a given parser and state
readWith :: Parser [Char] st a
-> st
-> String
-> a
readWith p t inp = runIdentity $ readWithM p t inp
-- | Parse a string with @parser@ (for testing). -- | Parse a string with @parser@ (for testing).
testStringWith :: (Show a, Stream [Char] Identity Char) testStringWith :: (Show a, Stream [Char] Identity Char)