{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Unsafe #-}

-- |
-- Module      :  Text.Megaparsec.Debug
-- Copyright   :  © 2015–present Megaparsec contributors
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Debugging helpers.
--
-- @since 7.0.0
module Text.Megaparsec.Debug
  ( 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 as List
import qualified Data.List.NonEmpty as NE
import Data.Proxy
import qualified Data.Set as E
import Debug.Trace
import Text.Megaparsec.Class (MonadParsec)
import Text.Megaparsec.Error
import Text.Megaparsec.Internal
import Text.Megaparsec.State
import Text.Megaparsec.Stream

-- | Type class describing parser monads that can trace during evaluation.
--
-- @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@:
--
-- >>> 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 :: forall a. Show a => String -> StateT st m a -> StateT st m a
dbg String
str StateT st m a
sma = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
L.StateT forall a b. (a -> b) -> a -> b
$ \st
s ->
    forall e s (m :: * -> *) a c.
(MonadParsecDbg e s m, Show a, Show c) =>
String -> String -> m (a, c) -> m (a, c)
dbgWithComment String
"STATE" String
str forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT StateT st m a
sma st
s

-- | @dbg (p :: StateT st m)@ prints state __after__ running @p@:
--
-- >>> 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 :: forall a. Show a => String -> StateT st m a -> StateT st m a
dbg String
str StateT st m a
sma = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT forall a b. (a -> b) -> a -> b
$ \st
s ->
    forall e s (m :: * -> *) a c.
(MonadParsecDbg e s m, Show a, Show c) =>
String -> String -> m (a, c) -> m (a, c)
dbgWithComment String
"STATE" String
str forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT st m a
sma st
s

instance
  (MonadParsecDbg e s m) =>
  MonadParsecDbg e s (L.ReaderT r m)
  where
  dbg :: forall a. Show a => String -> ReaderT r m a -> ReaderT r m a
dbg = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
L.mapReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a.
(MonadParsecDbg e s m, Show a) =>
String -> m a -> m a
dbg

-- | @dbg (p :: WriterT st m)@ prints __only__ log produced by @p@:
--
-- >>> 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 :: forall a. Show a => String -> WriterT w m a -> WriterT w m a
dbg String
str WriterT w m a
wma = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
L.WriterT forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a c.
(MonadParsecDbg e s m, Show a, Show c) =>
String -> String -> m (a, c) -> m (a, c)
dbgWithComment String
"LOG" String
str forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
L.runWriterT WriterT w m a
wma

-- | @dbg (p :: WriterT st m)@ prints __only__ log produced by @p@:
--
-- >>> 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 :: forall a. Show a => String -> WriterT w m a -> WriterT w m a
dbg String
str WriterT w m a
wma = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
S.WriterT forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a c.
(MonadParsecDbg e s m, Show a, Show c) =>
String -> String -> m (a, c) -> m (a, c)
dbgWithComment String
"LOG" String
str forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
S.runWriterT WriterT w m a
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 :: forall a. Show a => String -> RWST r w st m a -> RWST r w st m a
dbg String
str RWST r w st m a
sma = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
L.RWST forall a b. (a -> b) -> a -> b
$ \r
r st
s -> do
    let smth :: m (ShowComment w (ShowComment st a))
smth =
          (\(a
a, st
st, w
w) -> forall c a. String -> (a, c) -> ShowComment c a
ShowComment String
"LOG" (forall c a. String -> (a, c) -> ShowComment c a
ShowComment String
"STATE" (a
a, st
st), w
w))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST RWST r w st m a
sma r
r st
s
    ((a
a, st
st), w
w) <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall c a. ShowComment c a -> (a, c)
unComment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. ShowComment c a -> (a, c)
unComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsecDbg e s m, Show a) =>
String -> m a -> m a
dbg String
str m (ShowComment w (ShowComment st a))
smth
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, st
st, w
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 :: forall a. Show a => String -> RWST r w st m a -> RWST r w st m a
dbg String
str RWST r w st m a
sma = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
S.RWST forall a b. (a -> b) -> a -> b
$ \r
r st
s -> do
    let smth :: m (ShowComment w (ShowComment st a))
smth =
          (\(a
a, st
st, w
w) -> forall c a. String -> (a, c) -> ShowComment c a
ShowComment String
"LOG" (forall c a. String -> (a, c) -> ShowComment c a
ShowComment String
"STATE" (a
a, st
st), w
w))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST RWST r w st m a
sma r
r st
s
    ((a
a, st
st), w
w) <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall c a. ShowComment c a -> (a, c)
unComment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. ShowComment c a -> (a, c)
unComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsecDbg e s m, Show a) =>
String -> m a -> m a
dbg String
str m (ShowComment w (ShowComment st a))
smth
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, st
st, w
w)

instance (MonadParsecDbg e s m) => MonadParsecDbg e s (IdentityT m) where
  dbg :: forall a. Show a => String -> IdentityT m a -> IdentityT m a
dbg = forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a.
(MonadParsecDbg e s m, Show a) =>
String -> m a -> m a
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
  m (a, c) ->
  -- | Parser that prints debugging messages
  m (a, c)
dbgWithComment :: forall e s (m :: * -> *) a c.
(MonadParsecDbg e s m, Show a, Show c) =>
String -> String -> m (a, c) -> m (a, c)
dbgWithComment String
lbl String
str m (a, c)
ma =
  forall c a. ShowComment c a -> (a, c)
unComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsecDbg e s m, Show a) =>
String -> m a -> m a
dbg String
str (forall c a. String -> (a, c) -> ShowComment c a
ShowComment String
lbl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a, c)
ma)

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

unComment :: ShowComment c a -> (a, c)
unComment :: forall c a. ShowComment c a -> (a, c)
unComment (ShowComment String
_ (a, c)
val) = (a, c)
val

instance (Show c, Show a) => Show (ShowComment c a) where
  show :: ShowComment c a -> String
show (ShowComment String
lbl (a
a, c
c)) = forall a. Show a => a -> String
show a
a forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ String
lbl forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show c
c forall a. [a] -> [a] -> [a]
++ String
")"

instance
  (VisualStream s, ShowErrorComponent e) =>
  MonadParsecDbg e s (ParsecT e s m)
  where
  dbg :: forall a. Show a => String -> ParsecT e s m a -> ParsecT e s m a
dbg String
lbl ParsecT e s m a
p = forall e s (m :: * -> *) a.
(forall b.
 State s e
 -> (a -> State s e -> Hints (Token s) -> m b)
 -> (ParseError s e -> State s e -> m b)
 -> (a -> State s e -> Hints (Token s) -> m b)
 -> (ParseError s e -> State s e -> m b)
 -> m b)
-> ParsecT e s m a
ParsecT forall a b. (a -> b) -> a -> b
$ \State s e
s a -> State s e -> Hints (Token s) -> m b
cok ParseError s e -> State s e -> m b
cerr a -> State s e -> Hints (Token s) -> m b
eok ParseError s e -> State s e -> m b
eerr ->
    let l :: DbgItem s e a -> String
l = forall s e a.
(VisualStream s, ShowErrorComponent e, Show a) =>
String -> DbgItem s e a -> String
dbgLog String
lbl
        unfold :: s -> [Token s]
unfold = forall s. Stream s => Int -> s -> [Token s]
streamTake Int
40
        cok' :: a -> State s e -> Hints (Token s) -> m b
cok' a
x State s e
s' Hints (Token s)
hs =
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> a -> a
trace (a -> State s e -> Hints (Token s) -> m b
cok a
x State s e
s' Hints (Token s)
hs) forall a b. (a -> b) -> a -> b
$
            DbgItem s e a -> String
l (forall s e a. [Token s] -> DbgItem s e a
DbgIn (s -> [Token s]
unfold (forall s e. State s e -> s
stateInput State s e
s)))
              forall a. [a] -> [a] -> [a]
++ DbgItem s e a -> String
l (forall s e a. [Token s] -> a -> Hints (Token s) -> DbgItem s e a
DbgCOK (forall s. Stream s => Int -> s -> [Token s]
streamTake (forall s e. State s e -> State s e -> Int
streamDelta State s e
s State s e
s') (forall s e. State s e -> s
stateInput State s e
s)) a
x Hints (Token s)
hs)
        cerr' :: ParseError s e -> State s e -> m b
cerr' ParseError s e
err State s e
s' =
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> a -> a
trace (ParseError s e -> State s e -> m b
cerr ParseError s e
err State s e
s') forall a b. (a -> b) -> a -> b
$
            DbgItem s e a -> String
l (forall s e a. [Token s] -> DbgItem s e a
DbgIn (s -> [Token s]
unfold (forall s e. State s e -> s
stateInput State s e
s)))
              forall a. [a] -> [a] -> [a]
++ DbgItem s e a -> String
l (forall s e a. [Token s] -> ParseError s e -> DbgItem s e a
DbgCERR (forall s. Stream s => Int -> s -> [Token s]
streamTake (forall s e. State s e -> State s e -> Int
streamDelta State s e
s State s e
s') (forall s e. State s e -> s
stateInput State s e
s)) ParseError s e
err)
        eok' :: a -> State s e -> Hints (Token s) -> m b
eok' a
x State s e
s' Hints (Token s)
hs =
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> a -> a
trace (a -> State s e -> Hints (Token s) -> m b
eok a
x State s e
s' Hints (Token s)
hs) forall a b. (a -> b) -> a -> b
$
            DbgItem s e a -> String
l (forall s e a. [Token s] -> DbgItem s e a
DbgIn (s -> [Token s]
unfold (forall s e. State s e -> s
stateInput State s e
s)))
              forall a. [a] -> [a] -> [a]
++ DbgItem s e a -> String
l (forall s e a. [Token s] -> a -> Hints (Token s) -> DbgItem s e a
DbgEOK (forall s. Stream s => Int -> s -> [Token s]
streamTake (forall s e. State s e -> State s e -> Int
streamDelta State s e
s State s e
s') (forall s e. State s e -> s
stateInput State s e
s)) a
x Hints (Token s)
hs)
        eerr' :: ParseError s e -> State s e -> m b
eerr' ParseError s e
err State s e
s' =
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> a -> a
trace (ParseError s e -> State s e -> m b
eerr ParseError s e
err State s e
s') forall a b. (a -> b) -> a -> b
$
            DbgItem s e a -> String
l (forall s e a. [Token s] -> DbgItem s e a
DbgIn (s -> [Token s]
unfold (forall s e. State s e -> s
stateInput State s e
s)))
              forall a. [a] -> [a] -> [a]
++ DbgItem s e a -> String
l (forall s e a. [Token s] -> ParseError s e -> DbgItem s e a
DbgEERR (forall s. Stream s => Int -> s -> [Token s]
streamTake (forall s e. State s e -> State s e -> Int
streamDelta State s e
s State s e
s') (forall s e. State s e -> s
stateInput State s e
s)) ParseError s e
err)
     in forall e s (m :: * -> *) a.
ParsecT e s m a
-> forall b.
   State s e
   -> (a -> State s e -> Hints (Token s) -> m b)
   -> (ParseError s e -> State s e -> m b)
   -> (a -> State s e -> Hints (Token s) -> m b)
   -> (ParseError s e -> State s e -> m b)
   -> m b
unParser ParsecT e s m a
p State s e
s a -> State s e -> Hints (Token s) -> m b
cok' ParseError s e -> State s e -> m b
cerr' a -> State s e -> Hints (Token s) -> m b
eok' ParseError s e -> State s e -> m b
eerr'

-- | A single piece of info to be rendered with 'dbgLog'.
data DbgItem s e a
  = DbgIn [Token s]
  | DbgCOK [Token s] a (Hints (Token s))
  | DbgCERR [Token s] (ParseError s e)
  | DbgEOK [Token s] a (Hints (Token s))
  | DbgEERR [Token s] (ParseError s e)

-- | Render a single piece of debugging info.
dbgLog ::
  forall s e a.
  (VisualStream s, ShowErrorComponent e, Show a) =>
  -- | Debugging label
  String ->
  -- | Information to render
  DbgItem s e a ->
  -- | Rendered result
  String
dbgLog :: forall s e a.
(VisualStream s, ShowErrorComponent e, Show a) =>
String -> DbgItem s e a -> String
dbgLog String
lbl DbgItem s e a
item = ShowS
prefix String
msg
  where
    prefix :: ShowS
prefix = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
lbl forall a. [a] -> [a] -> [a]
++ String
"> ") forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    pxy :: Proxy s
pxy = forall {k} (t :: k). Proxy t
Proxy :: Proxy s
    showHints :: Set (ErrorItem (Token s)) -> String
showHints Set (ErrorItem (Token s))
hs = String
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
List.intercalate String
"," (forall s.
VisualStream s =>
Proxy s -> ErrorItem (Token s) -> String
showErrorItem Proxy s
pxy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
E.toAscList Set (ErrorItem (Token s))
hs) forall a. [a] -> [a] -> [a]
++ String
"]"
    msg :: String
msg = case DbgItem s e a
item of
      DbgIn [Token s]
ts ->
        String
"IN: " forall a. [a] -> [a] -> [a]
++ forall s. VisualStream s => Proxy s -> [Token s] -> String
showStream Proxy s
pxy [Token s]
ts
      DbgCOK [Token s]
ts a
a (Hints Set (ErrorItem (Token s))
hs) ->
        String
"MATCH (COK): "
          forall a. [a] -> [a] -> [a]
++ forall s. VisualStream s => Proxy s -> [Token s] -> String
showStream Proxy s
pxy [Token s]
ts
          forall a. [a] -> [a] -> [a]
++ String
"\nVALUE: "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a
          forall a. [a] -> [a] -> [a]
++ String
"\nHINTS: "
          forall a. [a] -> [a] -> [a]
++ Set (ErrorItem (Token s)) -> String
showHints Set (ErrorItem (Token s))
hs
      DbgCERR [Token s]
ts ParseError s e
e ->
        String
"MATCH (CERR): " forall a. [a] -> [a] -> [a]
++ forall s. VisualStream s => Proxy s -> [Token s] -> String
showStream Proxy s
pxy [Token s]
ts forall a. [a] -> [a] -> [a]
++ String
"\nERROR:\n" forall a. [a] -> [a] -> [a]
++ forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty ParseError s e
e
      DbgEOK [Token s]
ts a
a (Hints Set (ErrorItem (Token s))
hs) ->
        String
"MATCH (EOK): "
          forall a. [a] -> [a] -> [a]
++ forall s. VisualStream s => Proxy s -> [Token s] -> String
showStream Proxy s
pxy [Token s]
ts
          forall a. [a] -> [a] -> [a]
++ String
"\nVALUE: "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a
          forall a. [a] -> [a] -> [a]
++ String
"\nHINTS: "
          forall a. [a] -> [a] -> [a]
++ Set (ErrorItem (Token s)) -> String
showHints Set (ErrorItem (Token s))
hs
      DbgEERR [Token s]
ts ParseError s e
e ->
        String
"MATCH (EERR): " forall a. [a] -> [a] -> [a]
++ forall s. VisualStream s => Proxy s -> [Token s] -> String
showStream Proxy s
pxy [Token s]
ts forall a. [a] -> [a] -> [a]
++ String
"\nERROR:\n" forall a. [a] -> [a] -> [a]
++ forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty ParseError s e
e

-- | Pretty-print a list of tokens.
showStream :: (VisualStream s) => Proxy s -> [Token s] -> String
showStream :: forall s. VisualStream s => Proxy s -> [Token s] -> String
showStream Proxy s
pxy [Token s]
ts =
  case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Token s]
ts of
    Maybe (NonEmpty (Token s))
Nothing -> String
"<EMPTY>"
    Just NonEmpty (Token s)
ne ->
      let (String
h, String
r) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
40 (forall s. VisualStream s => Proxy s -> NonEmpty (Token s) -> String
showTokens Proxy s
pxy NonEmpty (Token s)
ne)
       in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then String
h else String
h forall a. [a] -> [a] -> [a]
++ String
" <…>"

-- | Calculate number of consumed tokens given 'State' of parser before and
-- after parsing.
streamDelta ::
  -- | State of parser before consumption
  State s e ->
  -- | State of parser after consumption
  State s e ->
  -- | Number of consumed tokens
  Int
streamDelta :: forall s e. State s e -> State s e -> Int
streamDelta State s e
s0 State s e
s1 = forall s e. State s e -> Int
stateOffset State s e
s1 forall a. Num a => a -> a -> a
- forall s e. State s e -> Int
stateOffset State s e
s0

-- | Extract a given number of tokens from the stream.
streamTake :: forall s. (Stream s) => Int -> s -> [Token s]
streamTake :: forall s. Stream s => Int -> s -> [Token s]
streamTake Int
n s
s =
  case forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n s
s of
    Maybe (Tokens s)
Nothing -> []
    Just Tokens s
chk -> forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy s) Tokens 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' :: forall e s (m :: * -> *) a.
MonadParsecDbg e s m =>
String -> m a -> m a
dbg' String
lbl m a
p = forall x. Blind x -> x
unBlind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsecDbg e s m, Show a) =>
String -> m a -> m a
dbg String
lbl (forall x. x -> Blind x
Blind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p)

-- | A wrapper type with a dummy 'Show' instance.
newtype Blind x = Blind {forall x. Blind x -> x
unBlind :: x}

instance Show (Blind x) where
  show :: Blind x -> String
show Blind x
_ = String
"NOT SHOWN"