Drop stacks of source positions

Author: mrkkrp

CHANGELOG.md

@@ -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`.
 

Text/Megaparsec.hs

@@ -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.
 --

Text/Megaparsec/Error.hs

@@ -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.

Text/Megaparsec/Error/Builder.hs

@@ -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

Text/Megaparsec/Internal.hs

@@ -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 ->