{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Text.Megaparsec
(
module Text.Megaparsec.Pos,
module Text.Megaparsec.Error,
module Text.Megaparsec.Stream,
module Control.Monad.Combinators,
State (..),
PosState (..),
Parsec,
ParsecT,
parse,
parseMaybe,
parseTest,
runParser,
runParser',
runParserT,
runParserT',
MonadParsec (..),
failure,
fancyFailure,
unexpected,
customFailure,
region,
registerParseError,
registerFailure,
registerFancyFailure,
single,
satisfy,
anySingle,
anySingleBut,
oneOf,
noneOf,
chunk,
(<?>),
match,
takeRest,
atEnd,
getInput,
setInput,
getSourcePos,
getOffset,
setOffset,
setParserState,
)
where
import Control.Monad.Combinators
import Control.Monad.Identity
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromJust)
import Data.Set (Set)
import qualified Data.Set as E
import Text.Megaparsec.Class
import Text.Megaparsec.Error
import Text.Megaparsec.Internal
import Text.Megaparsec.Pos
import Text.Megaparsec.State
import Text.Megaparsec.Stream
type Parsec e s = ParsecT e s Identity
parse ::
Parsec e s a ->
String ->
s ->
Either (ParseErrorBundle s e) a
parse :: forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse = forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser
parseMaybe :: (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe :: forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec e s a
p s
s =
case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec e s a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" s
s of
Left ParseErrorBundle s e
_ -> forall a. Maybe a
Nothing
Right a
x -> forall a. a -> Maybe a
Just a
x
parseTest ::
( ShowErrorComponent e,
Show a,
VisualStream s,
TraversableStream s
) =>
Parsec e s a ->
s ->
IO ()
parseTest :: forall e a s.
(ShowErrorComponent e, Show a, VisualStream s,
TraversableStream s) =>
Parsec e s a -> s -> IO ()
parseTest Parsec e s a
p s
input =
case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec e s a
p String
"" s
input of
Left ParseErrorBundle s e
e -> String -> IO ()
putStr (forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle s e
e)
Right a
x -> forall a. Show a => a -> IO ()
print a
x
runParser ::
Parsec e s a ->
String ->
s ->
Either (ParseErrorBundle s e) a
runParser :: forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec e s a
p String
name s
s = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
runParser' Parsec e s a
p (forall s e. String -> s -> State s e
initialState String
name s
s)
runParser' ::
Parsec e s a ->
State s e ->
(State s e, Either (ParseErrorBundle s e) a)
runParser' :: forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
runParser' Parsec e s a
p = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> State s e -> m (State s e, Either (ParseErrorBundle s e) a)
runParserT' Parsec e s a
p
runParserT ::
(Monad m) =>
ParsecT e s m a ->
String ->
s ->
m (Either (ParseErrorBundle s e) a)
runParserT :: forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT ParsecT e s m a
p String
name s
s = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> State s e -> m (State s e, Either (ParseErrorBundle s e) a)
runParserT' ParsecT e s m a
p (forall s e. String -> s -> State s e
initialState String
name s
s)
runParserT' ::
(Monad m) =>
ParsecT e s m a ->
State s e ->
m (State s e, Either (ParseErrorBundle s e) a)
runParserT' :: forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> State s e -> m (State s e, Either (ParseErrorBundle s e) a)
runParserT' ParsecT e s m a
p State s e
s = do
(Reply State s e
s' Consumption
_ Result s e a
result) <- forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a -> State s e -> m (Reply e s a)
runParsecT ParsecT e s m a
p State s e
s
let toBundle :: NonEmpty (ParseError s e) -> ParseErrorBundle s e
toBundle NonEmpty (ParseError s e)
es =
ParseErrorBundle
{ bundleErrors :: NonEmpty (ParseError s e)
bundleErrors =
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NE.sortWith forall s e. ParseError s e -> Int
errorOffset NonEmpty (ParseError s e)
es,
bundlePosState :: PosState s
bundlePosState = forall s e. State s e -> PosState s
statePosState State s e
s
}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Result s e a
result of
OK Hints (Token s)
_ a
x ->
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (forall s e. State s e -> [ParseError s e]
stateParseErrors State s e
s') of
Maybe (NonEmpty (ParseError s e))
Nothing -> (State s e
s', forall a b. b -> Either a b
Right a
x)
Just NonEmpty (ParseError s e)
de -> (State s e
s', forall a b. a -> Either a b
Left (NonEmpty (ParseError s e) -> ParseErrorBundle s e
toBundle NonEmpty (ParseError s e)
de))
Error ParseError s e
e ->
(State s e
s', forall a b. a -> Either a b
Left (NonEmpty (ParseError s e) -> ParseErrorBundle s e
toBundle (ParseError s e
e forall a. a -> [a] -> NonEmpty a
:| forall s e. State s e -> [ParseError s e]
stateParseErrors State s e
s')))
initialState :: String -> s -> State s e
initialState :: forall s e. String -> s -> State s e
initialState String
name s
s =
State
{ stateInput :: s
stateInput = s
s,
stateOffset :: Int
stateOffset = Int
0,
statePosState :: PosState s
statePosState =
PosState
{ pstateInput :: s
pstateInput = s
s,
pstateOffset :: Int
pstateOffset = Int
0,
pstateSourcePos :: SourcePos
pstateSourcePos = String -> SourcePos
initialPos String
name,
pstateTabWidth :: Pos
pstateTabWidth = Pos
defaultTabWidth,
pstateLinePrefix :: String
pstateLinePrefix = String
""
},
stateParseErrors :: [ParseError s e]
stateParseErrors = []
}
failure ::
(MonadParsec e s m) =>
Maybe (ErrorItem (Token s)) ->
Set (ErrorItem (Token s)) ->
m a
failure :: forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure Maybe (ErrorItem (Token s))
us Set (ErrorItem (Token s))
ps = do
Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
o Maybe (ErrorItem (Token s))
us Set (ErrorItem (Token s))
ps)
{-# INLINE failure #-}
fancyFailure ::
(MonadParsec e s m) =>
Set (ErrorFancy e) ->
m a
fancyFailure :: forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure Set (ErrorFancy e)
xs = do
Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o Set (ErrorFancy e)
xs)
{-# INLINE fancyFailure #-}
unexpected :: (MonadParsec e s m) => ErrorItem (Token s) -> m a
unexpected :: forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected ErrorItem (Token s)
item = forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure (forall a. a -> Maybe a
Just ErrorItem (Token s)
item) forall a. Set a
E.empty
{-# INLINE unexpected #-}
customFailure :: (MonadParsec e s m) => e -> m a
customFailure :: forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure = forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Set a
E.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. e -> ErrorFancy e
ErrorCustom
{-# INLINE customFailure #-}
region ::
(MonadParsec e s m) =>
(ParseError s e -> ParseError s e) ->
m a ->
m a
region :: forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region ParseError s e -> ParseError s e
f m a
m = do
[ParseError s e]
deSoFar <- forall s e. State s e -> [ParseError s e]
stateParseErrors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState forall a b. (a -> b) -> a -> b
$ \State s e
s ->
State s e
s {stateParseErrors :: [ParseError s e]
stateParseErrors = []}
Either (ParseError s e) a
r <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Either (ParseError s e) a)
observing m a
m
forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState forall a b. (a -> b) -> a -> b
$ \State s e
s ->
State s e
s {stateParseErrors :: [ParseError s e]
stateParseErrors = (ParseError s e -> ParseError s e
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e. State s e -> [ParseError s e]
stateParseErrors State s e
s) forall a. [a] -> [a] -> [a]
++ [ParseError s e]
deSoFar}
case Either (ParseError s e) a
r of
Left ParseError s e
err -> forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (ParseError s e -> ParseError s e
f ParseError s e
err)
Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
{-# INLINEABLE region #-}
registerParseError :: (MonadParsec e s m) => ParseError s e -> m ()
registerParseError :: forall e s (m :: * -> *).
MonadParsec e s m =>
ParseError s e -> m ()
registerParseError ParseError s e
e = forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState forall a b. (a -> b) -> a -> b
$ \State s e
s ->
State s e
s {stateParseErrors :: [ParseError s e]
stateParseErrors = ParseError s e
e forall a. a -> [a] -> [a]
: forall s e. State s e -> [ParseError s e]
stateParseErrors State s e
s}
{-# INLINE registerParseError #-}
registerFailure ::
(MonadParsec e s m) =>
Maybe (ErrorItem (Token s)) ->
Set (ErrorItem (Token s)) ->
m ()
registerFailure :: forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m ()
registerFailure Maybe (ErrorItem (Token s))
us Set (ErrorItem (Token s))
ps = do
Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall e s (m :: * -> *).
MonadParsec e s m =>
ParseError s e -> m ()
registerParseError (forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError Int
o Maybe (ErrorItem (Token s))
us Set (ErrorItem (Token s))
ps)
{-# INLINE registerFailure #-}
registerFancyFailure ::
(MonadParsec e s m) =>
Set (ErrorFancy e) ->
m ()
registerFancyFailure :: forall e s (m :: * -> *).
MonadParsec e s m =>
Set (ErrorFancy e) -> m ()
registerFancyFailure Set (ErrorFancy e)
xs = do
Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall e s (m :: * -> *).
MonadParsec e s m =>
ParseError s e -> m ()
registerParseError (forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o Set (ErrorFancy e)
xs)
{-# INLINE registerFancyFailure #-}
single ::
(MonadParsec e s m) =>
Token s ->
m (Token s)
single :: forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Token s
t = forall e s (m :: * -> *) a.
MonadParsec e s m =>
(Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> m a
token Token s -> Maybe (Token s)
testToken Set (ErrorItem (Token s))
expected
where
testToken :: Token s -> Maybe (Token s)
testToken Token s
x = if Token s
x forall a. Eq a => a -> a -> Bool
== Token s
t then forall a. a -> Maybe a
Just Token s
x else forall a. Maybe a
Nothing
expected :: Set (ErrorItem (Token s))
expected = forall a. a -> Set a
E.singleton (forall t. NonEmpty t -> ErrorItem t
Tokens (Token s
t forall a. a -> [a] -> NonEmpty a
:| []))
{-# INLINE single #-}
satisfy ::
(MonadParsec e s m) =>
(Token s -> Bool) ->
m (Token s)
satisfy :: forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Token s -> Bool
f = forall e s (m :: * -> *) a.
MonadParsec e s m =>
(Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> m a
token Token s -> Maybe (Token s)
testChar forall a. Set a
E.empty
where
testChar :: Token s -> Maybe (Token s)
testChar Token s
x = if Token s -> Bool
f Token s
x then forall a. a -> Maybe a
Just Token s
x else forall a. Maybe a
Nothing
{-# INLINE satisfy #-}
anySingle :: (MonadParsec e s m) => m (Token s)
anySingle :: forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall a b. a -> b -> a
const Bool
True)
{-# INLINE anySingle #-}
anySingleBut ::
(MonadParsec e s m) =>
Token s ->
m (Token s)
anySingleBut :: forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
anySingleBut Token s
t = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall a. Eq a => a -> a -> Bool
/= Token s
t)
{-# INLINE anySingleBut #-}
oneOf ::
(Foldable f, MonadParsec e s m) =>
f (Token s) ->
m (Token s)
oneOf :: forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf f (Token s)
cs = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` f (Token s)
cs)
{-# INLINE oneOf #-}
noneOf ::
(Foldable f, MonadParsec e s m) =>
f (Token s) ->
m (Token s)
noneOf :: forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf f (Token s)
cs = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` f (Token s)
cs)
{-# INLINE noneOf #-}
chunk ::
(MonadParsec e s m) =>
Tokens s ->
m (Tokens s)
chunk :: forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk = forall e s (m :: * -> *).
MonadParsec e s m =>
(Tokens s -> Tokens s -> Bool) -> Tokens s -> m (Tokens s)
tokens forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE chunk #-}
infix 0 <?>
(<?>) :: (MonadParsec e s m) => m a -> String -> m a
<?> :: forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
(<?>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label
{-# INLINE (<?>) #-}
match :: (MonadParsec e s m) => m a -> m (Tokens s, a)
match :: forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match m a
p = do
Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
s
s <- forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
a
r <- m a
p
Int
o' <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) (forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ (Int
o' forall a. Num a => a -> a -> a
- Int
o) s
s), a
r)
{-# INLINEABLE match #-}
takeRest :: (MonadParsec e s m) => m (Tokens s)
takeRest :: forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a b. a -> b -> a
const Bool
True)
{-# INLINE takeRest #-}
atEnd :: (MonadParsec e s m) => m Bool
atEnd :: forall e s (m :: * -> *). MonadParsec e s m => m Bool
atEnd = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
{-# INLINE atEnd #-}
getInput :: (MonadParsec e s m) => m s
getInput :: forall e s (m :: * -> *). MonadParsec e s m => m s
getInput = forall s e. State s e -> s
stateInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
{-# INLINE getInput #-}
setInput :: (MonadParsec e s m) => s -> m ()
setInput :: forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
setInput s
s = forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState (\(State s
_ Int
o PosState s
pst [ParseError s e]
de) -> forall s e. s -> Int -> PosState s -> [ParseError s e] -> State s e
State s
s Int
o PosState s
pst [ParseError s e]
de)
{-# INLINE setInput #-}
getSourcePos :: (TraversableStream s, MonadParsec e s m) => m SourcePos
getSourcePos :: forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos = do
State s e
st <- forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
let pst :: PosState s
pst = forall s. TraversableStream s => Int -> PosState s -> PosState s
reachOffsetNoLine (forall s e. State s e -> Int
stateOffset State s e
st) (forall s e. State s e -> PosState s
statePosState State s e
st)
forall e s (m :: * -> *). MonadParsec e s m => State s e -> m ()
setParserState State s e
st {statePosState :: PosState s
statePosState = PosState s
pst}
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. PosState s -> SourcePos
pstateSourcePos PosState s
pst)
{-# INLINE getSourcePos #-}
getOffset :: (MonadParsec e s m) => m Int
getOffset :: forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset = forall s e. State s e -> Int
stateOffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
{-# INLINE getOffset #-}
setOffset :: (MonadParsec e s m) => Int -> m ()
setOffset :: forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o = forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState forall a b. (a -> b) -> a -> b
$ \(State s
s Int
_ PosState s
pst [ParseError s e]
de) ->
forall s e. s -> Int -> PosState s -> [ParseError s e] -> State s e
State s
s Int
o PosState s
pst [ParseError s e]
de
{-# INLINE setOffset #-}
setParserState :: (MonadParsec e s m) => State s e -> m ()
setParserState :: forall e s (m :: * -> *). MonadParsec e s m => State s e -> m ()
setParserState State s e
st = forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState (forall a b. a -> b -> a
const State s e
st)
{-# INLINE setParserState #-}