module Text.Roundtrip.Parser (
module Text.Parsec, Pos.newPos, Pos.initialPos,
PParser, parsecApply, parsecConcat, parsecAlternative1Lookahead,
parsecAlternativeInfLookahead, parsecEmpty, parsecPure,
runStringParser, P.runParser, mkParseError
) where
import Control.Monad.Identity (Identity, runIdentity)
import Text.Parsec hiding (runParser)
import qualified Text.Parsec as P
import Text.Parsec.Char
import qualified Text.Parsec.Pos as Pos
import qualified Text.Parsec.Prim as Prim
import qualified Text.Parsec.Error as Perror
import Text.Parsec.Prim ()
import Text.Roundtrip
type PParser s u m = ParsecT s u m
parsecApply :: Iso a b -> PParser s u m a -> PParser s u m b
parsecApply iso p =
do a <- p
case apply iso a of
Just b -> return b
Nothing -> fail $ isoFailedErrorMessageL iso a
parsecConcat :: PParser s u m a -> PParser s u m b -> PParser s u m (a, b)
parsecConcat p q =
do x <- p
y <- q
return (x, y)
parsecAlternative1Lookahead :: PParser s u m a -> PParser s u m a -> PParser s u m a
parsecAlternative1Lookahead p q = p P.<|> q
parsecAlternativeInfLookahead :: PParser s u m a -> PParser s u m a -> PParser s u m a
parsecAlternativeInfLookahead p q = try p P.<|> q
parsecEmpty :: PParser s u m a
parsecEmpty = parserZero
parsecPure :: a -> PParser s u m a
parsecPure x = return x
instance Monad m => IsoFunctor (PParser s u m) where
(<$>) = parsecApply
instance Monad m => ProductFunctor (PParser s u m) where
(<*>) = parsecConcat
instance Monad m => Alternative (PParser s u m) where
(<|>) = parsecAlternative1Lookahead
(<||>) = parsecAlternativeInfLookahead
empty = parsecEmpty
instance Monad m => Syntax (PParser s u m) where
pure = parsecPure
instance (Monad m, Stream s m Char) => StringSyntax (PParser s u m) where
token f = Prim.tokenPrim showChar nextPos testChar
where
showChar x = '\'' : x : ['\'']
testChar x = if f x then Just x else Nothing
nextPos pos x _ = Pos.updatePosChar pos x
runStringParser :: Stream s Identity Char => PParser s () Identity a -> SourceName -> s -> Either ParseError a
runStringParser p src s = runIdentity $ Prim.runParserT p () src s
mkParseError :: SourcePos -> String -> ParseError
mkParseError pos msg = Perror.newErrorMessage (Perror.Message msg) pos