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