diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,23 @@
 *Megaparsec follows [SemVer](https://semver.org/).*
 
+## Megaparsec 9.3.0
+
+* Now `label` can override more than one group of hints in the parser it
+  wraps. [Issue 482](https://github.com/mrkkrp/megaparsec/issues/482).
+
+* `takeP n` now returns the empty chunk of the input stream when `n` is
+  negative, similar to when `n == 0`. [Issue
+  497](https://github.com/mrkkrp/megaparsec/issues/497).
+
+* Added the `MonadParsecDbg` type class in `Text.Megaparsec.Debug`. The type
+  class allows us to use `dbg` in MTL monad transformers. [Issue
+  488](https://github.com/mrkkrp/megaparsec/issues/488).
+
+* Introduced the `ShareInput` and `NoShareInput` newtype wrappers in
+  `Text.Megaparsec.Stream` in order to allow the user to choose how the
+  input should be sliced and shared during the parsing. [Issue
+  492](https://github.com/mrkkrp/megaparsec/issues/492).
+
 ## Megaparsec 9.2.2
 
 * Fixed a space leak in the implementations of the `reachOffset` and
diff --git a/Text/Megaparsec.hs b/Text/Megaparsec.hs
--- a/Text/Megaparsec.hs
+++ b/Text/Megaparsec.hs
@@ -370,7 +370,7 @@
 -- wrapper. This applies to both normal and delayed 'ParseError's.
 --
 -- As a side-effect of the implementation the inner computation will start
--- with empty collection of delayed errors and they will be updated and
+-- with an empty collection of delayed errors and they will be updated and
 -- “restored” on the way out of 'region'.
 --
 -- @since 5.3.0
diff --git a/Text/Megaparsec/Char/Lexer.hs b/Text/Megaparsec/Char/Lexer.hs
--- a/Text/Megaparsec/Char/Lexer.hs
+++ b/Text/Megaparsec/Char/Lexer.hs
@@ -229,9 +229,8 @@
 -- the “reference” token. The reference token can influence parsing, see
 -- 'IndentOpt' for more information.
 --
--- Tokens /must not/ consume newlines after them. On the other hand, the
--- first argument of this function /must/ consume newlines among other white
--- space characters.
+-- __Note__: the first argument of this function /must/ consume newlines
+-- among other white space characters.
 --
 -- @since 4.3.0
 indentBlock ::
diff --git a/Text/Megaparsec/Debug.hs b/Text/Megaparsec/Debug.hs
--- a/Text/Megaparsec/Debug.hs
+++ b/Text/Megaparsec/Debug.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE Unsafe #-}
 
@@ -15,103 +17,227 @@
 --
 -- @since 7.0.0
 module Text.Megaparsec.Debug
-  ( dbg,
+  ( MonadParsecDbg (..),
     dbg',
   )
 where
 
+import Control.Monad.Identity (IdentityT, mapIdentityT)
+import qualified Control.Monad.Trans.RWS.Lazy as L
+import qualified Control.Monad.Trans.RWS.Strict as S
+import qualified Control.Monad.Trans.Reader as L
+import qualified Control.Monad.Trans.State.Lazy as L
+import qualified Control.Monad.Trans.State.Strict as S
+import qualified Control.Monad.Trans.Writer.Lazy as L
+import qualified Control.Monad.Trans.Writer.Strict as S
+import Data.Bifunctor (Bifunctor (first))
 import qualified Data.List.NonEmpty as NE
 import Data.Proxy
 import Debug.Trace
+import Text.Megaparsec.Class (MonadParsec)
 import Text.Megaparsec.Error
 import Text.Megaparsec.Internal
 import Text.Megaparsec.State
 import Text.Megaparsec.Stream
 
--- | @'dbg' label p@ parser works exactly like @p@, but when it's evaluated
--- it prints information useful for debugging. The @label@ is only used to
--- refer to this parser in the debugging output. This combinator uses the
--- 'trace' function from "Debug.Trace" under the hood.
+-- | Type class describing parser monads that can trace during evaluation.
 --
--- Typical usage is to wrap every sub-parser in misbehaving parser with
--- 'dbg' assigning meaningful labels. Then give it a shot and go through the
--- print-out. As of current version, this combinator prints all available
--- information except for /hints/, which are probably only interesting to
--- the maintainer of Megaparsec itself and may be quite verbose to output in
--- general. Let me know if you would like to be able to see hints in the
--- debugging output.
+-- @since 9.3.0
+class MonadParsec e s m => MonadParsecDbg e s m where
+  -- | @'dbg' label p@ parser works exactly like @p@, but when it's evaluated
+  -- it prints information useful for debugging. The @label@ is only used to
+  -- refer to this parser in the debugging output. This combinator uses the
+  -- 'trace' function from "Debug.Trace" under the hood.
+  --
+  -- Typical usage is to wrap every sub-parser in misbehaving parser with
+  -- 'dbg' assigning meaningful labels. Then give it a shot and go through the
+  -- print-out. As of current version, this combinator prints all available
+  -- information except for /hints/, which are probably only interesting to
+  -- the maintainer of Megaparsec itself and may be quite verbose to output in
+  -- general. Let me know if you would like to be able to see hints in the
+  -- debugging output.
+  --
+  -- The output itself is pretty self-explanatory, although the following
+  -- abbreviations should be clarified (they are derived from the low-level
+  -- source code):
+  --
+  --     * @COK@—“consumed OK”. The parser consumed input and succeeded.
+  --     * @CERR@—“consumed error”. The parser consumed input and failed.
+  --     * @EOK@—“empty OK”. The parser succeeded without consuming input.
+  --     * @EERR@—“empty error”. The parser failed without consuming input.
+  --
+  -- __Note__: up until the version /9.3.0/ this was a non-polymorphic
+  -- function that worked only in 'ParsecT'. It was first introduced in the
+  -- version /7.0.0/.
+  dbg ::
+    Show a =>
+    -- | Debugging label
+    String ->
+    -- | Parser to debug
+    m a ->
+    -- | Parser that prints debugging messages
+    m a
+
+-- | @dbg (p :: StateT st m)@ prints state __after__ running @p@:
 --
--- The output itself is pretty self-explanatory, although the following
--- abbreviations should be clarified (they are derived from the low-level
--- source code):
+-- >>> p = modify succ >> dbg "a" (single 'a' >> modify succ)
+-- >>> parseTest (runStateT p 0) "a"
+-- a> IN: 'a'
+-- a> MATCH (COK): 'a'
+-- a> VALUE: () (STATE: 2)
+-- ((),2)
+instance
+  (Show st, MonadParsecDbg e s m) =>
+  MonadParsecDbg e s (L.StateT st m)
+  where
+  dbg str sma = L.StateT $ \s ->
+    dbgWithComment "STATE" str $ L.runStateT sma s
+
+-- | @dbg (p :: StateT st m)@ prints state __after__ running @p@:
 --
---     * @COK@—“consumed OK”. The parser consumed input and succeeded.
---     * @CERR@—“consumed error”. The parser consumed input and failed.
---     * @EOK@—“empty OK”. The parser succeeded without consuming input.
---     * @EERR@—“empty error”. The parser failed without consuming input.
+-- >>> p = modify succ >> dbg "a" (single 'a' >> modify succ)
+-- >>> parseTest (runStateT p 0) "a"
+-- a> IN: 'a'
+-- a> MATCH (COK): 'a'
+-- a> VALUE: () (STATE: 2)
+-- ((),2)
+instance
+  (Show st, MonadParsecDbg e s m) =>
+  MonadParsecDbg e s (S.StateT st m)
+  where
+  dbg str sma = S.StateT $ \s ->
+    dbgWithComment "STATE" str $ S.runStateT sma s
+
+instance
+  MonadParsecDbg e s m =>
+  MonadParsecDbg e s (L.ReaderT r m)
+  where
+  dbg = L.mapReaderT . dbg
+
+-- | @dbg (p :: WriterT st m)@ prints __only__ log produced by @p@:
 --
--- Finally, it's not possible to lift this function into some monad
--- transformers without introducing surprising behavior (e.g. unexpected
--- state backtracking) or adding otherwise redundant constraints (e.g.
--- 'Show' instance for state), so this helper is only available for
--- 'ParsecT' monad, not any instance of 'Text.Megaparsec.MonadParsec' in
--- general.
-dbg ::
-  forall e s m a.
-  ( VisualStream s,
-    ShowErrorComponent e,
-    Show a
-  ) =>
-  -- | Debugging label
-  String ->
-  -- | Parser to debug
-  ParsecT e s m a ->
-  -- | Parser that prints debugging messages
-  ParsecT e s m a
-dbg lbl p = ParsecT $ \s cok cerr eok eerr ->
-  let l = dbgLog lbl :: DbgItem s e a -> String
-      unfold = streamTake 40
-      cok' x s' hs =
-        flip trace (cok x s' hs) $
-          l (DbgIn (unfold (stateInput s)))
-            ++ l (DbgCOK (streamTake (streamDelta s s') (stateInput s)) x)
-      cerr' err s' =
-        flip trace (cerr err s') $
-          l (DbgIn (unfold (stateInput s)))
-            ++ l (DbgCERR (streamTake (streamDelta s s') (stateInput s)) err)
-      eok' x s' hs =
-        flip trace (eok x s' hs) $
-          l (DbgIn (unfold (stateInput s)))
-            ++ l (DbgEOK (streamTake (streamDelta s s') (stateInput s)) x)
-      eerr' err s' =
-        flip trace (eerr err s') $
-          l (DbgIn (unfold (stateInput s)))
-            ++ l (DbgEERR (streamTake (streamDelta s s') (stateInput s)) err)
-   in unParser p s cok' cerr' eok' eerr'
+-- >>> p = tell [0] >> dbg "a" (single 'a' >> tell [1])
+-- >>> parseTest (runWriterT p) "a"
+-- a> IN: 'a'
+-- a> MATCH (COK): 'a'
+-- a> VALUE: () (LOG: [1])
+-- ((),[0,1])
+instance
+  (Monoid w, Show w, MonadParsecDbg e s m) =>
+  MonadParsecDbg e s (L.WriterT w m)
+  where
+  dbg str wma = L.WriterT $ dbgWithComment "LOG" str $ L.runWriterT wma
 
--- | Just like 'dbg', but doesn't require the return value of the parser to
--- be 'Show'-able.
+-- | @dbg (p :: WriterT st m)@ prints __only__ log produced by @p@:
 --
--- @since 9.1.0
-dbg' ::
-  forall e s m a.
-  ( VisualStream s,
-    ShowErrorComponent e
-  ) =>
-  -- | Debugging label
+-- >>> p = tell [0] >> dbg "a" (single 'a' >> tell [1])
+-- >>> parseTest (runWriterT p) "a"
+-- a> IN: 'a'
+-- a> MATCH (COK): 'a'
+-- a> VALUE: () (LOG: [1])
+-- ((),[0,1])
+instance
+  (Monoid w, Show w, MonadParsecDbg e s m) =>
+  MonadParsecDbg e s (S.WriterT w m)
+  where
+  dbg str wma = S.WriterT $ dbgWithComment "LOG" str $ S.runWriterT wma
+
+-- | @RWST@ works like @StateT@ inside a @WriterT@: subparser's log and its
+-- final state is printed:
+--
+-- >>> p = tell [0] >> modify succ >> dbg "a" (single 'a' >> tell [1] >> modify succ)
+-- >>> parseTest (runRWST p () 0) "a"
+-- a> IN: 'a'
+-- a> MATCH (COK): 'a'
+-- a> VALUE: () (STATE: 2) (LOG: [1])
+-- ((),2,[0,1])
+instance
+  (Monoid w, Show w, Show st, MonadParsecDbg e s m) =>
+  MonadParsecDbg e s (L.RWST r w st m)
+  where
+  dbg str sma = L.RWST $ \r s -> do
+    let smth =
+          (\(a, st, w) -> ShowComment "LOG" (ShowComment "STATE" (a, st), w))
+            <$> L.runRWST sma r s
+    ((a, st), w) <- first unComment . unComment <$> dbg str smth
+    pure (a, st, w)
+
+-- | @RWST@ works like @StateT@ inside a @WriterT@: subparser's log and its
+-- final state is printed:
+--
+-- >>> p = tell [0] >> modify succ >> dbg "a" (single 'a' >> tell [1] >> modify succ)
+-- >>> parseTest (runRWST p () 0) "a"
+-- a> IN: 'a'
+-- a> MATCH (COK): 'a'
+-- a> VALUE: () (STATE: 2) (LOG: [1])
+-- ((),2,[0,1])
+instance
+  (Monoid w, Show w, Show st, MonadParsecDbg e s m) =>
+  MonadParsecDbg e s (S.RWST r w st m)
+  where
+  dbg str sma = S.RWST $ \r s -> do
+    let smth =
+          (\(a, st, w) -> ShowComment "LOG" (ShowComment "STATE" (a, st), w))
+            <$> S.runRWST sma r s
+    ((a, st), w) <- first unComment . unComment <$> dbg str smth
+    pure (a, st, w)
+
+instance MonadParsecDbg e s m => MonadParsecDbg e s (IdentityT m) where
+  dbg = mapIdentityT . dbg
+
+-- | @'dbgWithComment' label_a label_c m@ traces the first component of the
+-- result produced by @m@ with @label_a@ and the second component with
+-- @label_b@.
+dbgWithComment ::
+  (MonadParsecDbg e s m, Show a, Show c) =>
+  -- | Debugging label (for @a@)
   String ->
+  -- | Extra component label (for @c@)
+  String ->
   -- | Parser to debug
-  ParsecT e s m a ->
+  m (a, c) ->
   -- | Parser that prints debugging messages
-  ParsecT e s m a
-dbg' lbl p = unBlind <$> dbg lbl (Blind <$> p)
+  m (a, c)
+dbgWithComment lbl str ma =
+  unComment <$> dbg str (ShowComment lbl <$> ma)
 
--- | A wrapper type with a dummy 'Show' instance.
-newtype Blind x = Blind {unBlind :: x}
+-- | A wrapper with a special show instance:
+--
+-- >>> show (ShowComment "STATE" ("Hello, world!", 42))
+-- Hello, world! (STATE: 42)
+data ShowComment c a = ShowComment String (a, c)
 
-instance Show (Blind x) where
-  show _ = "NOT SHOWN"
+unComment :: ShowComment c a -> (a, c)
+unComment (ShowComment _ val) = val
 
+instance (Show c, Show a) => Show (ShowComment c a) where
+  show (ShowComment lbl (a, c)) = show a ++ " (" ++ lbl ++ ": " ++ show c ++ ")"
+
+instance
+  (VisualStream s, ShowErrorComponent e) =>
+  MonadParsecDbg e s (ParsecT e s m)
+  where
+  dbg lbl p = ParsecT $ \s cok cerr eok eerr ->
+    let l = dbgLog lbl
+        unfold = streamTake 40
+        cok' x s' hs =
+          flip trace (cok x s' hs) $
+            l (DbgIn (unfold (stateInput s)))
+              ++ l (DbgCOK (streamTake (streamDelta s s') (stateInput s)) x)
+        cerr' err s' =
+          flip trace (cerr err s') $
+            l (DbgIn (unfold (stateInput s)))
+              ++ l (DbgCERR (streamTake (streamDelta s s') (stateInput s)) err)
+        eok' x s' hs =
+          flip trace (eok x s' hs) $
+            l (DbgIn (unfold (stateInput s)))
+              ++ l (DbgEOK (streamTake (streamDelta s s') (stateInput s)) x)
+        eerr' err s' =
+          flip trace (eerr err s') $
+            l (DbgIn (unfold (stateInput s)))
+              ++ l (DbgEERR (streamTake (streamDelta s s') (stateInput s)) err)
+     in unParser p s cok' cerr' eok' eerr'
+
 -- | A single piece of info to be rendered with 'dbgLog'.
 data DbgItem s e a
   = DbgIn [Token s]
@@ -172,3 +298,23 @@
   case fst <$> takeN_ n s of
     Nothing -> []
     Just chk -> chunkToTokens (Proxy :: Proxy s) chk
+
+-- | Just like 'dbg', but doesn't require the return value of the parser to
+-- be 'Show'-able.
+--
+-- @since 9.1.0
+dbg' ::
+  MonadParsecDbg e s m =>
+  -- | Debugging label
+  String ->
+  -- | Parser to debug
+  m a ->
+  -- | Parser that prints debugging messages
+  m a
+dbg' lbl p = unBlind <$> dbg lbl (Blind <$> p)
+
+-- | A wrapper type with a dummy 'Show' instance.
+newtype Blind x = Blind {unBlind :: x}
+
+instance Show (Blind x) where
+  show _ = "NOT SHOWN"
diff --git a/Text/Megaparsec/Internal.hs b/Text/Megaparsec/Internal.hs
--- a/Text/Megaparsec/Internal.hs
+++ b/Text/Megaparsec/Internal.hs
@@ -36,7 +36,7 @@
     toHints,
     withHints,
     accHints,
-    refreshLastHint,
+    refreshHints,
     runParsecT,
     withParsecT,
   )
@@ -85,12 +85,12 @@
 -- 1:2:
 -- unexpected 'a'
 -- expecting 'r' or end of input
-newtype Hints t = Hints [Set (ErrorItem t)]
+newtype Hints t = Hints (Set (ErrorItem t))
 
-instance Semigroup (Hints t) where
+instance Ord t => Semigroup (Hints t) where
   Hints xs <> Hints ys = Hints $ xs <> ys
 
-instance Monoid (Hints t) where
+instance Ord t => Monoid (Hints t) where
   mempty = Hints mempty
 
 -- | All information available after parsing. This includes consumption of
@@ -170,7 +170,7 @@
   p1 *> p2 = p1 `pBind` const p2
   p1 <* p2 = do x1 <- p1; void p2; return x1
 
-pPure :: a -> ParsecT e s m a
+pPure :: Stream s => a -> ParsecT e s m a
 pPure x = ParsecT $ \s _ _ eok _ -> eok x s mempty
 {-# INLINE pPure #-}
 
@@ -267,7 +267,7 @@
     runParsecT p s `catchError` \e ->
       runParsecT (h e) s
 
-mkPT :: Monad m => (State s e -> m (Reply e s a)) -> ParsecT e s m a
+mkPT :: (Stream s, Monad m) => (State s e -> m (Reply e s a)) -> ParsecT e s m a
 mkPT k = ParsecT $ \s cok cerr eok eerr -> do
   (Reply s' consumption result) <- k s
   case consumption of
@@ -364,9 +364,9 @@
   let el = Label <$> NE.nonEmpty l
       cok' x s' hs =
         case el of
-          Nothing -> cok x s' (refreshLastHint hs Nothing)
+          Nothing -> cok x s' (refreshHints hs Nothing)
           Just _ -> cok x s' hs
-      eok' x s' hs = eok x s' (refreshLastHint hs el)
+      eok' x s' hs = eok x s' (refreshHints hs el)
       eerr' err = eerr $
         case err of
           (TrivialError pos us _) ->
@@ -381,7 +381,7 @@
    in unParser p s cok eerr' eok eerr'
 {-# INLINE pTry #-}
 
-pLookAhead :: ParsecT e s m a -> ParsecT e s m a
+pLookAhead :: Stream s => ParsecT e s m a -> ParsecT e s m a
 pLookAhead p = ParsecT $ \s _ cerr eok eerr ->
   let eok' a _ _ = eok a s mempty
    in unParser p s eok' cerr eok' eerr
@@ -504,7 +504,7 @@
       hs =
         case ml >>= NE.nonEmpty of
           Nothing -> mempty
-          Just l -> (Hints . pure . E.singleton . Label) l
+          Just l -> (Hints . E.singleton . Label) l
    in if chunkEmpty pxy ts
         then eok ts (State input' (o + len) pst de) hs
         else cok ts (State input' (o + len) pst de) hs
@@ -524,7 +524,7 @@
       hs =
         case el of
           Nothing -> mempty
-          Just l -> (Hints . pure . E.singleton) l
+          Just l -> (Hints . E.singleton) l
    in if chunkEmpty pxy ts
         then
           let us = pure $
@@ -544,8 +544,9 @@
   Maybe String ->
   Int ->
   ParsecT e s m (Tokens s)
-pTakeP ml n = ParsecT $ \s@(State input o pst de) cok _ _ eerr ->
-  let pxy = Proxy :: Proxy s
+pTakeP ml n' = ParsecT $ \s@(State input o pst de) cok _ _ eerr ->
+  let n = max 0 n'
+      pxy = Proxy :: Proxy s
       el = Label <$> (ml >>= NE.nonEmpty)
       ps = maybe E.empty E.singleton el
    in case takeN_ n input of
@@ -561,11 +562,11 @@
                 else cok ts (State input' (o + len) pst de) mempty
 {-# INLINE pTakeP #-}
 
-pGetParserState :: ParsecT e s m (State s e)
+pGetParserState :: Stream s => ParsecT e s m (State s e)
 pGetParserState = ParsecT $ \s _ _ eok _ -> eok s s mempty
 {-# INLINE pGetParserState #-}
 
-pUpdateParserState :: (State s e -> State s e) -> ParsecT e s m ()
+pUpdateParserState :: Stream s => (State s e -> State s e) -> ParsecT e s m ()
 pUpdateParserState f = ParsecT $ \s _ _ eok _ -> eok () (f s) mempty
 {-# INLINE pUpdateParserState #-}
 
@@ -591,7 +592,7 @@
     -- there might have been backtracking with 'try' and in that case we
     -- must not convert such a parse error to hints.
     if streamPos == errOffset
-      then Hints (if E.null ps then [] else [ps])
+      then Hints (if E.null ps then E.empty else ps)
       else mempty
   FancyError _ _ -> mempty
 {-# INLINE toHints #-}
@@ -613,30 +614,32 @@
   m b
 withHints (Hints ps') c e =
   case e of
-    TrivialError pos us ps -> c (TrivialError pos us (E.unions (ps : ps')))
+    TrivialError pos us ps -> c (TrivialError pos us (E.union ps ps'))
     _ -> c e
 {-# INLINE withHints #-}
 
 -- | @'accHints' hs c@ results in “OK” continuation that will add given
 -- hints @hs@ to third argument of original continuation @c@.
 accHints ::
+  Stream s =>
   -- | 'Hints' to add
-  Hints t ->
+  Hints (Token s) ->
   -- | An “OK” continuation to alter
-  (a -> State s e -> Hints t -> m b) ->
+  (a -> State s e -> Hints (Token s) -> m b) ->
   -- | Altered “OK” continuation
-  (a -> State s e -> Hints t -> m b)
+  (a -> State s e -> Hints (Token s) -> m b)
 accHints hs1 c x s hs2 = c x s (hs1 <> hs2)
 {-# INLINE accHints #-}
 
--- | Replace the most recent group of hints (if any) with the given
--- 'ErrorItem' (or delete it if 'Nothing' is given). This is used in the
--- 'label' primitive.
-refreshLastHint :: Hints t -> Maybe (ErrorItem t) -> Hints t
-refreshLastHint (Hints []) _ = Hints []
-refreshLastHint (Hints (_ : xs)) Nothing = Hints xs
-refreshLastHint (Hints (_ : xs)) (Just m) = Hints (E.singleton m : xs)
-{-# INLINE refreshLastHint #-}
+-- | Replace the hints with the given 'ErrorItem' (or delete it if 'Nothing'
+-- is given). This is used in the 'label' primitive.
+refreshHints :: Hints t -> Maybe (ErrorItem t) -> Hints t
+refreshHints (Hints _) Nothing = Hints E.empty
+refreshHints (Hints hs) (Just m) =
+  if E.null hs
+    then Hints hs
+    else Hints (E.singleton m)
+{-# INLINE refreshHints #-}
 
 -- | Low-level unpacking of the 'ParsecT' type.
 runParsecT ::
diff --git a/Text/Megaparsec/Stream.hs b/Text/Megaparsec/Stream.hs
--- a/Text/Megaparsec/Stream.hs
+++ b/Text/Megaparsec/Stream.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE Safe #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- |
 -- Module      :  Text.Megaparsec.Stream
@@ -25,11 +26,14 @@
 -- @since 6.0.0
 module Text.Megaparsec.Stream
   ( Stream (..),
+    ShareInput (..),
+    NoShareInput (..),
     VisualStream (..),
     TraversableStream (..),
   )
 where
 
+import Data.Bifunctor (second)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as BL
@@ -50,6 +54,12 @@
 
 -- | Type class for inputs that can be consumed by the library.
 --
+-- Note that the 'Stream' instances for 'Text' and 'ByteString' (strict and
+-- lazy) default to "input sharing" (see 'ShareInput', 'NoShareInput'). We plan
+-- to move away from input sharing in a future major release; if you want to
+-- retain the current behaviour and are concerned with maximum performance you
+-- should consider using the 'ShareInput' wrapper explicitly.
+--
 -- __Note__: before the version /9.0.0/ the class included the methods from
 -- 'VisualStream' and 'TraversableStream'.
 class (Ord (Token s), Ord (Tokens s)) => Stream s where
@@ -154,65 +164,246 @@
     | otherwise = Just (S.splitAt n s)
   takeWhile_ = S.spanl
 
-instance Stream B.ByteString where
-  type Token B.ByteString = Word8
-  type Tokens B.ByteString = B.ByteString
+-- | This wrapper selects the input-sharing 'Stream' implementation for
+-- 'T.Text' ('TL.Text') and 'B.ByteString' ('BL.ByteString'). By input
+-- sharing we mean that our parsers will use slices whenever possible to
+-- avoid having to copy parts of the input. See also the documentation of
+-- 'T.split'.
+--
+-- Note that using slices is in general faster than copying; on the other
+-- hand it also has the potential for causing surprising memory leaks: if
+-- any slice of the input survives in the output, holding on to the output
+-- will force the entire input 'T.Text'/'B.ByteString' to stay in memory!
+-- Even when using lazy 'TL.Text'/'BL.ByteString' we will hold on to whole
+-- chunks at a time leading to to significantly worse memory residency in
+-- some cases.
+--
+-- See 'NoShareInput' for a somewhat slower implementation that avoids this
+-- memory leak scenario.
+--
+-- @since 9.3.0
+newtype ShareInput a = ShareInput {unShareInput :: a}
+
+instance Stream (ShareInput B.ByteString) where
+  type Token (ShareInput B.ByteString) = Word8
+  type Tokens (ShareInput B.ByteString) = B.ByteString
   tokenToChunk Proxy = B.singleton
   tokensToChunk Proxy = B.pack
   chunkToTokens Proxy = B.unpack
   chunkLength Proxy = B.length
   chunkEmpty Proxy = B.null
-  take1_ = B.uncons
-  takeN_ n s
-    | n <= 0 = Just (B.empty, s)
+  take1_ (ShareInput s) = second ShareInput <$> B.uncons s
+  takeN_ n (ShareInput s)
+    | n <= 0 = Just (B.empty, ShareInput s)
     | B.null s = Nothing
-    | otherwise = Just (B.splitAt n s)
-  takeWhile_ = B.span
+    | otherwise = Just . second ShareInput $ B.splitAt n s
+  takeWhile_ p (ShareInput s) = second ShareInput $ B.span p s
 
-instance Stream BL.ByteString where
-  type Token BL.ByteString = Word8
-  type Tokens BL.ByteString = BL.ByteString
+instance Stream (ShareInput BL.ByteString) where
+  type Token (ShareInput BL.ByteString) = Word8
+  type Tokens (ShareInput BL.ByteString) = BL.ByteString
   tokenToChunk Proxy = BL.singleton
   tokensToChunk Proxy = BL.pack
   chunkToTokens Proxy = BL.unpack
   chunkLength Proxy = fromIntegral . BL.length
   chunkEmpty Proxy = BL.null
-  take1_ = BL.uncons
-  takeN_ n s
-    | n <= 0 = Just (BL.empty, s)
+  take1_ (ShareInput s) = second ShareInput <$> BL.uncons s
+  takeN_ n (ShareInput s)
+    | n <= 0 = Just (BL.empty, ShareInput s)
     | BL.null s = Nothing
-    | otherwise = Just (BL.splitAt (fromIntegral n) s)
-  takeWhile_ = BL.span
+    | otherwise = Just . second ShareInput $ BL.splitAt (fromIntegral n) s
+  takeWhile_ p (ShareInput s) = second ShareInput $ BL.span p s
 
-instance Stream T.Text where
-  type Token T.Text = Char
-  type Tokens T.Text = T.Text
+instance Stream (ShareInput T.Text) where
+  type Token (ShareInput T.Text) = Char
+  type Tokens (ShareInput T.Text) = T.Text
   tokenToChunk Proxy = T.singleton
   tokensToChunk Proxy = T.pack
   chunkToTokens Proxy = T.unpack
   chunkLength Proxy = T.length
   chunkEmpty Proxy = T.null
-  take1_ = T.uncons
-  takeN_ n s
-    | n <= 0 = Just (T.empty, s)
+  take1_ (ShareInput s) = second ShareInput <$> T.uncons s
+  takeN_ n (ShareInput s)
+    | n <= 0 = Just (T.empty, ShareInput s)
     | T.null s = Nothing
-    | otherwise = Just (T.splitAt n s)
-  takeWhile_ = T.span
+    | otherwise = Just . second ShareInput $ T.splitAt n s
+  takeWhile_ p (ShareInput s) = second ShareInput $ T.span p s
 
-instance Stream TL.Text where
-  type Token TL.Text = Char
-  type Tokens TL.Text = TL.Text
+instance Stream (ShareInput TL.Text) where
+  type Token (ShareInput TL.Text) = Char
+  type Tokens (ShareInput TL.Text) = TL.Text
   tokenToChunk Proxy = TL.singleton
   tokensToChunk Proxy = TL.pack
   chunkToTokens Proxy = TL.unpack
   chunkLength Proxy = fromIntegral . TL.length
   chunkEmpty Proxy = TL.null
-  take1_ = TL.uncons
-  takeN_ n s
-    | n <= 0 = Just (TL.empty, s)
+  take1_ (ShareInput s) = second ShareInput <$> TL.uncons s
+  takeN_ n (ShareInput s)
+    | n <= 0 = Just (TL.empty, ShareInput s)
     | TL.null s = Nothing
-    | otherwise = Just (TL.splitAt (fromIntegral n) s)
-  takeWhile_ = TL.span
+    | otherwise = Just . second ShareInput $ TL.splitAt (fromIntegral n) s
+  takeWhile_ p (ShareInput s) = second ShareInput $ TL.span p s
+
+-- | This wrapper selects the no-input-sharing 'Stream' implementation for
+-- 'T.Text' ('TL.Text') and 'B.ByteString' ('BL.ByteString'). This means
+-- that our parsers will create independent copies rather than using slices
+-- of the input. See also the documentation of 'T.copy'.
+--
+-- More importantly, any parser output will be independent of the input, and
+-- holding on to parts of the output will never prevent the input from being
+-- garbage collected.
+--
+-- For maximum performance you might consider using 'ShareInput' instead,
+-- but beware of its pitfalls!
+--
+-- @since 9.3.0
+newtype NoShareInput a = NoShareInput {unNoShareInput :: a}
+
+instance Stream (NoShareInput B.ByteString) where
+  type Token (NoShareInput B.ByteString) = Word8
+  type Tokens (NoShareInput B.ByteString) = B.ByteString
+  tokenToChunk Proxy = B.singleton
+  tokensToChunk Proxy = B.pack
+  chunkToTokens Proxy = B.unpack
+  chunkLength Proxy = B.length
+  chunkEmpty Proxy = B.null
+  take1_ (NoShareInput s) = second NoShareInput <$> B.uncons s
+  takeN_ n (NoShareInput s)
+    | n <= 0 = Just (B.empty, NoShareInput s)
+    | B.null s = Nothing
+    | otherwise =
+        let (result, rest) = B.splitAt n s
+            -- To avoid sharing the entire input we create a clean copy of the result.
+            unSharedResult = B.copy result
+         in Just (unSharedResult, NoShareInput rest)
+  takeWhile_ p (NoShareInput s) =
+    let (result, rest) = B.span p s
+        -- Ditto.
+        unSharedResult = B.copy result
+     in (unSharedResult, NoShareInput rest)
+
+instance Stream (NoShareInput BL.ByteString) where
+  type Token (NoShareInput BL.ByteString) = Word8
+  type Tokens (NoShareInput BL.ByteString) = BL.ByteString
+  tokenToChunk Proxy = BL.singleton
+  tokensToChunk Proxy = BL.pack
+  chunkToTokens Proxy = BL.unpack
+  chunkLength Proxy = fromIntegral . BL.length
+  chunkEmpty Proxy = BL.null
+  take1_ (NoShareInput s) = second NoShareInput <$> BL.uncons s
+  takeN_ n (NoShareInput s)
+    | n <= 0 = Just (BL.empty, NoShareInput s)
+    | BL.null s = Nothing
+    | otherwise =
+        let (result, rest) = BL.splitAt (fromIntegral n) s
+            -- To avoid sharing the entire input we create a clean copy of the result.
+            unSharedResult = BL.copy result
+         in Just (unSharedResult, NoShareInput rest)
+  takeWhile_ p (NoShareInput s) =
+    let (result, rest) = BL.span p s
+        -- Ditto.
+        unSharedResult = BL.copy result
+     in (unSharedResult, NoShareInput rest)
+
+instance Stream (NoShareInput T.Text) where
+  type Token (NoShareInput T.Text) = Char
+  type Tokens (NoShareInput T.Text) = T.Text
+  tokenToChunk Proxy = T.singleton
+  tokensToChunk Proxy = T.pack
+  chunkToTokens Proxy = T.unpack
+  chunkLength Proxy = T.length
+  chunkEmpty Proxy = T.null
+  take1_ (NoShareInput s) = second NoShareInput <$> T.uncons s
+  takeN_ n (NoShareInput s)
+    | n <= 0 = Just (T.empty, NoShareInput s)
+    | T.null s = Nothing
+    | otherwise =
+        let (result, rest) = T.splitAt n s
+            -- To avoid sharing the entire input we create a clean copy of the result.
+            unSharedResult = T.copy result
+         in Just (unSharedResult, NoShareInput rest)
+  takeWhile_ p (NoShareInput s) =
+    let (result, rest) = T.span p s
+        unSharedResult = T.copy result
+     in (unSharedResult, NoShareInput rest)
+
+instance Stream (NoShareInput TL.Text) where
+  type Token (NoShareInput TL.Text) = Char
+  type Tokens (NoShareInput TL.Text) = TL.Text
+  tokenToChunk Proxy = TL.singleton
+  tokensToChunk Proxy = TL.pack
+  chunkToTokens Proxy = TL.unpack
+  chunkLength Proxy = fromIntegral . TL.length
+  chunkEmpty Proxy = TL.null
+  take1_ (NoShareInput s) = second NoShareInput <$> TL.uncons s
+  takeN_ n (NoShareInput s)
+    | n <= 0 = Just (TL.empty, NoShareInput s)
+    | TL.null s = Nothing
+    | otherwise =
+        let (result, rest) = TL.splitAt (fromIntegral n) s
+            -- To avoid sharing the entire input we create a clean copy of the result.
+            unSharedResult = tlCopy result
+         in Just (unSharedResult, NoShareInput rest)
+  takeWhile_ p (NoShareInput s) =
+    let (result, rest) = TL.span p s
+        unSharedResult = tlCopy result
+     in (unSharedResult, NoShareInput rest)
+
+-- | Create an independent copy of a TL.Text, akin to BL.copy.
+tlCopy :: TL.Text -> TL.Text
+tlCopy = TL.fromStrict . T.copy . TL.toStrict
+{-# INLINE tlCopy #-}
+
+-- Since we are using @{-# LANGUAGE Safe #-}@ we can't use deriving via in
+-- these cases.
+
+instance Stream B.ByteString where
+  type Token B.ByteString = Token (ShareInput B.ByteString)
+  type Tokens B.ByteString = Tokens (ShareInput B.ByteString)
+  tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput B.ByteString))
+  tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput B.ByteString))
+  chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput B.ByteString))
+  chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput B.ByteString))
+  chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput B.ByteString))
+  take1_ s = second unShareInput <$> take1_ (ShareInput s)
+  takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s)
+  takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s)
+
+instance Stream BL.ByteString where
+  type Token BL.ByteString = Token (ShareInput BL.ByteString)
+  type Tokens BL.ByteString = Tokens (ShareInput BL.ByteString)
+  tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput BL.ByteString))
+  tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput BL.ByteString))
+  chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput BL.ByteString))
+  chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput BL.ByteString))
+  chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput BL.ByteString))
+  take1_ s = second unShareInput <$> take1_ (ShareInput s)
+  takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s)
+  takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s)
+
+instance Stream T.Text where
+  type Token T.Text = Token (ShareInput T.Text)
+  type Tokens T.Text = Tokens (ShareInput T.Text)
+  tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput T.Text))
+  tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput T.Text))
+  chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput T.Text))
+  chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput T.Text))
+  chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput T.Text))
+  take1_ s = second unShareInput <$> take1_ (ShareInput s)
+  takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s)
+  takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s)
+
+instance Stream TL.Text where
+  type Token TL.Text = Token (ShareInput TL.Text)
+  type Tokens TL.Text = Tokens (ShareInput TL.Text)
+  tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput TL.Text))
+  tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput TL.Text))
+  chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput TL.Text))
+  chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput TL.Text))
+  chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput TL.Text))
+  take1_ s = second unShareInput <$> take1_ (ShareInput s)
+  takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s)
+  takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s)
 
 -- | Type class for inputs that can also be used for debugging.
 --
diff --git a/megaparsec.cabal b/megaparsec.cabal
--- a/megaparsec.cabal
+++ b/megaparsec.cabal
@@ -1,6 +1,6 @@
 cabal-version:   2.4
 name:            megaparsec
-version:         9.2.2
+version:         9.3.0
 license:         BSD-2-Clause
 license-file:    LICENSE.md
 maintainer:      Mark Karpov <markkarpov92@gmail.com>