Permalink
Browse files

Drop stacks of source positions

  • Loading branch information...
mrkkrp committed Apr 20, 2018
1 parent cdbbe5c commit 7120bae9b27f4367ea802935217f71a78c3c2756
@@ -30,6 +30,14 @@
makes sense because the collection of expected items cannot depend on what
we see in the input stream.
* Dropped stacks of source positions. Thus the field `statePos` in `State`
has the type `SourcePos` instead of `NonEmpty SourcePos`. Accordingly, the
functions `pushPosition` and `popPosition` from `Text.Megaparsec` and
`sourcePosStackPretty` from `Text.Megaparsec.Error` were removed.
The reason for this simplification is that I could not find any code that
uses the feature and it makes manipulation of source positions hairy.
* The debugging function `dbg` has been moved from `Text.Megaparsec` to its
own module `Text.Megaparsec.Debug`.
@@ -108,8 +108,6 @@ module Text.Megaparsec
, getPosition
, getNextTokenPosition
, setPosition
, pushPosition
, popPosition
, getTokensProcessed
, setTokensProcessed
, getTabWidth
@@ -129,8 +127,7 @@ 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
import qualified Data.Set as E
-- $reexports
--
@@ -292,7 +289,7 @@ runParserT' p s = do
initialState :: String -> s -> State s
initialState name s = State
{ stateInput = s
, statePos = initialPos name :| []
, statePos = initialPos name
, stateTokensProcessed = 0
, stateTabWidth = defaultTabWidth }
@@ -540,7 +537,7 @@ setInput s = updateParserState (\(State _ pos tp w) -> State s pos tp w)
-- See also: 'getNextTokenPosition'.
getPosition :: MonadParsec e s m => m SourcePos
getPosition = NE.head . statePos <$> getParserState
getPosition = statePos <$> getParserState
-- | Get the position where the next token in the stream begins. If the
-- stream is empty, return 'Nothing'.
@@ -552,7 +549,7 @@ getPosition = NE.head . statePos <$> getParserState
getNextTokenPosition :: forall e s m. MonadParsec e s m => m (Maybe SourcePos)
getNextTokenPosition = do
State {..} <- getParserState
let f = positionAt1 (Proxy :: Proxy s) (NE.head statePos)
let f = positionAt1 (Proxy :: Proxy s) statePos
return (f . fst <$> take1_ stateInput)
{-# INLINEABLE getNextTokenPosition #-}
@@ -561,33 +558,8 @@ getNextTokenPosition = do
-- See also: 'getPosition', 'pushPosition', 'popPosition', and 'SourcePos'.
setPosition :: MonadParsec e s m => SourcePos -> m ()
setPosition pos = updateParserState $ \(State s (_:|z) tp w) ->
State s (pos:|z) tp w
-- | Push a position to the stack of positions and continue parsing working
-- with this position. Useful for working with include files and the like.
--
-- See also: 'popPosition'.
--
-- @since 5.0.0
pushPosition :: MonadParsec e s m => SourcePos -> m ()
pushPosition pos = updateParserState $ \(State s z tp w) ->
State s (NE.cons pos z) tp w
-- | Pop a position from the stack of positions unless it only contains one
-- element (in that case the stack of positions remains the same). This is
-- how to return to previous source file after 'pushPosition'.
--
-- See also: 'pushPosition'.
--
-- @since 5.0.0
popPosition :: MonadParsec e s m => m ()
popPosition = updateParserState $ \(State s z tp w) ->
case snd (NE.uncons z) of
Nothing -> State s z tp w
Just z' -> State s z' tp w
setPosition pos = updateParserState $ \(State s _ tp w) ->
State s pos tp w
-- | Get the number of tokens processed so far.
--
@@ -36,7 +36,6 @@ module Text.Megaparsec.Error
, parseErrorPretty
, parseErrorPretty'
, parseErrorPretty_
, sourcePosStackPretty
, parseErrorTextPretty )
where
@@ -115,12 +114,16 @@ instance NFData a => NFData (ErrorFancy a) where
-- @since 6.0.0
data ParseError t e
= TrivialError (NonEmpty SourcePos) (Maybe (ErrorItem t)) (Set (ErrorItem t))
= TrivialError SourcePos (Maybe (ErrorItem t)) (Set (ErrorItem t))
-- ^ Trivial errors, generated by Megaparsec's machinery. The data
-- constructor includes the stack of source positions, unexpected token
-- constructor includes the source position of error, unexpected token
-- (if any), and expected tokens.
| FancyError (NonEmpty SourcePos) (Set (ErrorFancy e))
--
-- Type of the first argument was changed in the version /7.0.0/.
| FancyError SourcePos (Set (ErrorFancy e))
-- ^ Fancy, custom errors.
--
-- Type of the first argument was changed in the version /7.0.0/.
deriving (Show, Read, Eq, Data, Typeable, Generic)
instance (NFData t, NFData e) => NFData (ParseError t e)
@@ -130,7 +133,7 @@ instance (Ord t, Ord e) => Semigroup (ParseError t e) where
{-# INLINE (<>) #-}
instance (Ord t, Ord e) => Monoid (ParseError t e) where
mempty = TrivialError (initialPos "" :| []) Nothing E.empty
mempty = TrivialError (initialPos "") Nothing E.empty
mappend = (<>)
{-# INLINE mappend #-}
@@ -148,7 +151,7 @@ instance ( Show t
--
-- @since 6.0.0
errorPos :: ParseError t e -> NonEmpty SourcePos
errorPos :: ParseError t e -> SourcePos
errorPos (TrivialError p _ _) = p
errorPos (FancyError p _) = p
@@ -278,7 +281,7 @@ parseErrorPretty
=> ParseError t e -- ^ Parse error to render
-> String -- ^ Result of rendering
parseErrorPretty e =
sourcePosStackPretty (errorPos e) <> ":\n" <> parseErrorTextPretty e
sourcePosPretty (errorPos e) <> ":\n" <> parseErrorTextPretty e
-- | Pretty-print a 'ParseError' and display the line on which the parse
-- error occurred. The rendered 'String' always ends with a newline.
@@ -319,13 +322,13 @@ parseErrorPretty_
-> ParseError (Token s) e -- ^ Parse error to render
-> String -- ^ Result of rendering
parseErrorPretty_ w s e =
sourcePosStackPretty (errorPos e) <> ":\n" <>
sourcePosPretty (errorPos e) <> ":\n" <>
padding <> "|\n" <>
lineNumber <> " | " <> rline <> "\n" <>
padding <> "| " <> rpadding <> "^\n" <>
parseErrorTextPretty e
where
epos = NE.last (errorPos e)
epos = errorPos e
lineNumber = (show . unPos . sourceLine) epos
padding = replicate (length lineNumber + 1) ' '
rpadding = replicate (unPos (sourceColumn epos) - 1) ' '
@@ -336,17 +339,6 @@ parseErrorPretty_ w s e =
rline' = fmap tokenAsChar . chunkToTokens (Proxy :: Proxy s) $
selectLine (sourceLine epos) s
-- | Pretty-print a stack of source positions.
--
-- @since 5.0.0
sourcePosStackPretty :: NonEmpty SourcePos -> String
sourcePosStackPretty ms = mconcat (f <$> rest) <> sourcePosPretty pos
where
(pos :| rest') = ms
rest = reverse rest'
f p = "in file included from " <> sourcePosPretty p <> ",\n"
-- | Pretty-print a textual part of a 'ParseError', that is, everything
-- except stack of source positions. The rendered staring always ends with a
-- new line.
@@ -97,15 +97,15 @@ instance Ord e => Monoid (EF e) where
-- provided by this module, see below.
err
:: NonEmpty SourcePos -- ^ 'ParseError' position
:: SourcePos -- ^ 'ParseError' position
-> ET t -- ^ Error components
-> ParseError t e -- ^ Resulting 'ParseError'
err pos (ET us ps) = TrivialError pos us ps
-- | Like 'err', but constructs a “fancy” 'ParseError'.
errFancy
:: NonEmpty SourcePos -- ^ 'ParseError' position
:: SourcePos -- ^ 'ParseError' position
-> EF e -- ^ Error components
-> ParseError t e -- ^ Resulting 'ParseError'
errFancy pos (EF xs) = FancyError pos xs
@@ -115,21 +115,21 @@ errFancy pos (EF xs) = FancyError pos xs
-- | Initial source position with empty file name.
posI :: NonEmpty SourcePos
posI = initialPos "" :| []
posI :: SourcePos
posI = initialPos ""
-- | @'posN' n s@ returns source position achieved by applying 'advanceN'
-- method corresponding to the type of stream @s@.
posN :: forall s. Stream s
=> Int
-> s
-> NonEmpty SourcePos
-> SourcePos
posN n s =
case takeN_ n s of
Nothing -> posI
Just (ts, _) ->
advanceN (Proxy :: Proxy s) defaultTabWidth (initialPos "") ts :| []
advanceN (Proxy :: Proxy s) defaultTabWidth (initialPos "") ts
----------------------------------------------------------------------------
-- Error components
@@ -409,44 +409,44 @@ pObserving p = ParsecT $ \s cok _ eok _ ->
{-# INLINE pObserving #-}
pEof :: forall e s m. Stream s => ParsecT e s m ()
pEof = ParsecT $ \s@(State input (pos:|z) tp w) _ _ eok eerr ->
pEof = ParsecT $ \s@(State input pos tp w) _ _ eok eerr ->
case take1_ input of
Nothing -> eok () s mempty
Just (x,_) ->
let !apos = positionAt1 (Proxy :: Proxy s) pos x
us = (pure . Tokens . nes) x
ps = E.singleton EndOfInput
in eerr (TrivialError (apos:|z) us ps)
(State input (apos:|z) tp w)
in eerr (TrivialError apos us ps)
(State input apos tp w)
{-# INLINE pEof #-}
pToken :: forall e s m a. Stream s
=> (Token s -> Maybe a)
-> Set (ErrorItem (Token s))
-> ParsecT e s m a
pToken test ps = ParsecT $ \s@(State input (pos:|z) tp w) cok _ _ eerr ->
pToken test ps = ParsecT $ \s@(State input pos tp w) cok _ _ eerr ->
case take1_ input of
Nothing ->
let us = pure EndOfInput
in eerr (TrivialError (pos:|z) us ps) s
in eerr (TrivialError pos us ps) s
Just (c,cs) ->
case test c of
Nothing ->
let !apos = positionAt1 (Proxy :: Proxy s) pos c
us = (Just . Tokens . nes) c
in eerr (TrivialError (apos:|z) us ps)
(State input (apos:|z) tp w)
in eerr (TrivialError apos us ps)
(State input apos tp w)
Just x ->
let !npos = advance1 (Proxy :: Proxy s) w pos c
newstate = State cs (npos:|z) (tp + 1) w
newstate = State cs npos (tp + 1) w
in cok x newstate mempty
{-# INLINE pToken #-}
pTokens :: forall e s m. Stream s
=> (Tokens s -> Tokens s -> Bool)
-> Tokens s
-> ParsecT e s m (Tokens s)
pTokens f tts = ParsecT $ \s@(State input (pos:|z) tp w) cok _ eok eerr ->
pTokens f tts = ParsecT $ \s@(State input pos tp w) cok _ eok eerr ->
let pxy = Proxy :: Proxy s
unexpect pos' u =
let us = pure u
@@ -455,24 +455,24 @@ pTokens f tts = ParsecT $ \s@(State input (pos:|z) tp w) cok _ eok eerr ->
len = chunkLength pxy tts
in case takeN_ len input of
Nothing ->
eerr (unexpect (pos:|z) EndOfInput) s
eerr (unexpect pos EndOfInput) s
Just (tts', input') ->
if f tts tts'
then let !npos = advanceN pxy w pos tts'
st = State input' (npos:|z) (tp + len) w
st = State input' npos (tp + len) w
in if chunkEmpty pxy tts
then eok tts' st mempty
else cok tts' st mempty
else let !apos = positionAtN pxy pos tts'
ps = (Tokens . NE.fromList . chunkToTokens pxy) tts'
in eerr (unexpect (apos:|z) ps) (State input (apos:|z) tp w)
in eerr (unexpect apos ps) (State input apos tp w)
{-# INLINE pTokens #-}
pTakeWhileP :: forall e s m. Stream s
=> Maybe String
-> (Token s -> Bool)
-> ParsecT e s m (Tokens s)
pTakeWhileP ml f = ParsecT $ \(State input (pos:|z) tp w) cok _ eok _ ->
pTakeWhileP ml f = ParsecT $ \(State input pos tp w) cok _ eok _ ->
let pxy = Proxy :: Proxy s
(ts, input') = takeWhile_ f input
!npos = advanceN pxy w pos ts
@@ -482,15 +482,15 @@ pTakeWhileP ml f = ParsecT $ \(State input (pos:|z) tp w) cok _ eok _ ->
Nothing -> mempty
Just l -> (Hints . pure . E.singleton . Label) l
in if chunkEmpty pxy ts
then eok ts (State input' (npos:|z) (tp + len) w) hs
else cok ts (State input' (npos:|z) (tp + len) w) hs
then eok ts (State input' npos (tp + len) w) hs
else cok ts (State input' npos (tp + len) w) hs
{-# INLINE pTakeWhileP #-}
pTakeWhile1P :: forall e s m. Stream s
=> Maybe String
-> (Token s -> Bool)
-> ParsecT e s m (Tokens s)
pTakeWhile1P ml f = ParsecT $ \(State input (pos:|z) tp w) cok _ _ eerr ->
pTakeWhile1P ml f = ParsecT $ \(State input pos tp w) cok _ _ eerr ->
let pxy = Proxy :: Proxy s
(ts, input') = takeWhile_ f input
len = chunkLength pxy ts
@@ -506,31 +506,31 @@ pTakeWhile1P ml f = ParsecT $ \(State input (pos:|z) tp w) cok _ _ eerr ->
Nothing -> EndOfInput
Just (t,_) -> Tokens (nes t)
ps = maybe E.empty E.singleton el
in eerr (TrivialError (apos:|z) us ps)
(State input (apos:|z) tp w)
in eerr (TrivialError apos us ps)
(State input apos tp w)
else let !npos = advanceN pxy w pos ts
in cok ts (State input' (npos:|z) (tp + len) w) hs
in cok ts (State input' npos (tp + len) w) hs
{-# INLINE pTakeWhile1P #-}
pTakeP :: forall e s m. Stream s
=> Maybe String
-> Int
-> ParsecT e s m (Tokens s)
pTakeP ml n = ParsecT $ \s@(State input (pos:|z) tp w) cok _ _ eerr ->
pTakeP ml n = ParsecT $ \s@(State input pos tp w) cok _ _ eerr ->
let pxy = Proxy :: Proxy s
el = Label <$> (ml >>= NE.nonEmpty)
ps = maybe E.empty E.singleton el
in case takeN_ n input of
Nothing ->
eerr (TrivialError (pos:|z) (pure EndOfInput) ps) s
eerr (TrivialError pos (pure EndOfInput) ps) s
Just (ts, input') ->
let len = chunkLength pxy ts
!apos = positionAtN pxy pos ts
!npos = advanceN pxy w pos ts
in if len /= n
then eerr (TrivialError (npos:|z) (pure EndOfInput) ps)
(State input (apos:|z) tp w)
else cok ts (State input' (npos:|z) (tp + len) w) mempty
then eerr (TrivialError npos (pure EndOfInput) ps)
(State input apos tp w)
else cok ts (State input' npos (tp + len) w) mempty
{-# INLINE pTakeP #-}
pGetParserState :: ParsecT e s m (State s)
@@ -551,8 +551,8 @@ nes x = x :| []
-- | Convert 'ParseError' record into 'Hints'.
toHints
:: NonEmpty SourcePos -- ^ Current position in input stream
-> ParseError t e -- ^ Parse error to convert
:: SourcePos -- ^ Current position in input stream
-> ParseError t e -- ^ Parse error to convert
-> Hints t
toHints streamPos = \case
TrivialError errPos _ ps ->
Oops, something went wrong.

0 comments on commit 7120bae

Please sign in to comment.