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

    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module Text.Megaparsec.Debug
      ( dbg )
    where

    import Data.Proxy
    import Debug.Trace
    import Text.Megaparsec.Error
    import Text.Megaparsec.Internal
    import Text.Megaparsec.State
    import Text.Megaparsec.Stream
    import qualified Data.List.NonEmpty as NE

    -- | @'dbg' label p@ parser works exactly like @p@, but when it's evaluated
    -- it also 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.
    --
    -- 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.
      ( Stream s
      , ShowErrorComponent e
      , Show a )
      => String            -- ^ Debugging label
      -> ParsecT e s m a   -- ^ Parser to debug
      -> ParsecT e s m a   -- ^ Parser that prints debugging messages
    dbg :: String -> ParsecT e s m a -> ParsecT e s m a
    dbg lbl :: String
    lbl p :: ParsecT e s m a
    p = (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
    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 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)
    -> (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
    forall a b. (a -> b) -> a -> b
    $ \s :: State s e
    s cok :: a -> State s e -> Hints (Token s) -> m b
    cok cerr :: ParseError s e -> State s e -> m b
    cerr eok :: a -> State s e -> Hints (Token s) -> m b
    eok eerr :: ParseError s e -> State s e -> m b
    eerr ->
      let l :: DbgItem s e a -> String
    l = String -> DbgItem s e a -> String
    forall s e a.
    (Stream s, ShowErrorComponent e, Show a) =>
    String -> DbgItem s e a -> String
    dbgLog String
    lbl :: DbgItem s e a -> String
          unfold :: s -> [Token s]
    unfold = Int -> s -> [Token s]
    forall s. Stream s => Int -> s -> [Token s]
    streamTake 40
          cok' :: a -> State s e -> Hints (Token s) -> m b
    cok' x :: a
    x s' :: State s e
    s' hs :: Hints (Token s)
    hs = (String -> m b -> m b) -> m b -> String -> m b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> m b -> m b
    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) (String -> m b) -> String -> m b
    forall a b. (a -> b) -> a -> b
    $
            DbgItem s e a -> String
    l ([Token s] -> DbgItem s e a
    forall s e a. [Token s] -> DbgItem s e a
    DbgIn (s -> [Token s]
    unfold (State s e -> s
    forall s e. State s e -> s
    stateInput State s e
    s))) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
            DbgItem s e a -> String
    l ([Token s] -> a -> DbgItem s e a
    forall s e a. [Token s] -> a -> DbgItem s e a
    DbgCOK (Int -> s -> [Token s]
    forall s. Stream s => Int -> s -> [Token s]
    streamTake (State s e -> State s e -> Int
    forall s e. State s e -> State s e -> Int
    streamDelta State s e
    s State s e
    s') (State s e -> s
    forall s e. State s e -> s
    stateInput State s e
    s)) a
    x)
          cerr' :: ParseError s e -> State s e -> m b
    cerr' err :: ParseError s e
    err s' :: State s e
    s' = (String -> m b -> m b) -> m b -> String -> m b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> m b -> m b
    forall a. String -> a -> a
    trace (ParseError s e -> State s e -> m b
    cerr ParseError s e
    err State s e
    s') (String -> m b) -> String -> m b
    forall a b. (a -> b) -> a -> b
    $
            DbgItem s e a -> String
    l ([Token s] -> DbgItem s e a
    forall s e a. [Token s] -> DbgItem s e a
    DbgIn (s -> [Token s]
    unfold (State s e -> s
    forall s e. State s e -> s
    stateInput State s e
    s))) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
            DbgItem s e a -> String
    l ([Token s] -> ParseError s e -> DbgItem s e a
    forall s e a. [Token s] -> ParseError s e -> DbgItem s e a
    DbgCERR (Int -> s -> [Token s]
    forall s. Stream s => Int -> s -> [Token s]
    streamTake (State s e -> State s e -> Int
    forall s e. State s e -> State s e -> Int
    streamDelta State s e
    s 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' x :: a
    x s' :: State s e
    s' hs :: Hints (Token s)
    hs = (String -> m b -> m b) -> m b -> String -> m b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> m b -> m b
    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) (String -> m b) -> String -> m b
    forall a b. (a -> b) -> a -> b
    $
            DbgItem s e a -> String
    l ([Token s] -> DbgItem s e a
    forall s e a. [Token s] -> DbgItem s e a
    DbgIn (s -> [Token s]
    unfold (State s e -> s
    forall s e. State s e -> s
    stateInput State s e
    s))) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
            DbgItem s e a -> String
    l ([Token s] -> a -> DbgItem s e a
    forall s e a. [Token s] -> a -> DbgItem s e a
    DbgEOK (Int -> s -> [Token s]
    forall s. Stream s => Int -> s -> [Token s]
    streamTake (State s e -> State s e -> Int
    forall s e. State s e -> State s e -> Int
    streamDelta State s e
    s State s e
    s') (State s e -> s
    forall s e. State s e -> s
    stateInput State s e
    s)) a
    x)
          eerr' :: ParseError s e -> State s e -> m b
    eerr' err :: ParseError s e
    err s' :: State s e
    s' = (String -> m b -> m b) -> m b -> String -> m b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> m b -> m b
    forall a. String -> a -> a
    trace (ParseError s e -> State s e -> m b
    eerr ParseError s e
    err State s e
    s') (String -> m b) -> String -> m b
    forall a b. (a -> b) -> a -> b
    $
            DbgItem s e a -> String
    l ([Token s] -> DbgItem s e a
    forall s e a. [Token s] -> DbgItem s e a
    DbgIn (s -> [Token s]
    unfold (State s e -> s
    forall s e. State s e -> s
    stateInput State s e
    s))) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
            DbgItem s e a -> String
    l ([Token s] -> ParseError s e -> DbgItem s e a
    forall s e a. [Token s] -> ParseError s e -> DbgItem s e a
    DbgEERR (Int -> s -> [Token s]
    forall s. Stream s => Int -> s -> [Token s]
    streamTake (State s e -> State s e -> Int
    forall s e. State s e -> State s e -> Int
    streamDelta State s e
    s 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 ParsecT e s m a
    -> 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
    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
      | DbgCERR [Token s] (ParseError s e)
      | DbgEOK  [Token s] a
      | DbgEERR [Token s] (ParseError s e)

    -- | Render a single piece of debugging info.

    dbgLog
      :: forall s e a. (Stream s, ShowErrorComponent e, Show a)
      => String            -- ^ Debugging label
      -> DbgItem s e a     -- ^ Information to render
      -> String            -- ^ Rendered result
    dbgLog :: String -> DbgItem s e a -> String
    dbgLog lbl :: String
    lbl item :: DbgItem s e a
    item = String -> String
    prefix String
    msg
      where
        prefix :: String -> String
    prefix = [String] -> String
    unlines ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((String
    lbl String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "> ") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines
        pxy :: Proxy s
    pxy = Proxy s
    forall k (t :: k). Proxy t
    Proxy :: Proxy s
        msg :: String
    msg = case DbgItem s e a
    item of
          DbgIn   ts :: [Token s]
    ts   ->
            "IN: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Proxy s -> [Token s] -> String
    forall s. Stream s => Proxy s -> [Token s] -> String
    showStream Proxy s
    pxy [Token s]
    ts
          DbgCOK  ts :: [Token s]
    ts a :: a
    a ->
            "MATCH (COK): " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Proxy s -> [Token s] -> String
    forall s. Stream s => Proxy s -> [Token s] -> String
    showStream Proxy s
    pxy [Token s]
    ts String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\nVALUE: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    a
          DbgCERR ts :: [Token s]
    ts e :: ParseError s e
    e ->
            "MATCH (CERR): " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Proxy s -> [Token s] -> String
    forall s. Stream s => Proxy s -> [Token s] -> String
    showStream Proxy s
    pxy [Token s]
    ts String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\nERROR:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ParseError s e -> String
    forall s e.
    (Stream s, ShowErrorComponent e) =>
    ParseError s e -> String
    parseErrorPretty ParseError s e
    e
          DbgEOK  ts :: [Token s]
    ts a :: a
    a ->
            "MATCH (EOK): " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Proxy s -> [Token s] -> String
    forall s. Stream s => Proxy s -> [Token s] -> String
    showStream Proxy s
    pxy [Token s]
    ts String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\nVALUE: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    a
          DbgEERR ts :: [Token s]
    ts e :: ParseError s e
    e ->
            "MATCH (EERR): " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Proxy s -> [Token s] -> String
    forall s. Stream s => Proxy s -> [Token s] -> String
    showStream Proxy s
    pxy [Token s]
    ts String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\nERROR:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ParseError s e -> String
    forall s e.
    (Stream s, ShowErrorComponent e) =>
    ParseError s e -> String
    parseErrorPretty ParseError s e
    e

    -- | Pretty-print a list of tokens.

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

    -- | Calculate number of consumed tokens given 'State' of parser before and
    -- after parsing.

    streamDelta
      :: State s e         -- ^ State of parser before consumption
      -> State s e         -- ^ State of parser after consumption
      -> Int               -- ^ Number of consumed tokens
    streamDelta :: State s e -> State s e -> Int
    streamDelta s0 :: State s e
    s0 s1 :: State s e
    s1 = State s e -> Int
    forall s e. State s e -> Int
    stateOffset State s e
    s1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - State s e -> Int
    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 :: Int -> s -> [Token s]
    streamTake n :: Int
    n s :: s
    s =
      case (Tokens s, s) -> Tokens s
    forall a b. (a, b) -> a
    fst ((Tokens s, s) -> Tokens s)
    -> Maybe (Tokens s, s) -> Maybe (Tokens s)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> s -> Maybe (Tokens s, s)
    forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
    takeN_ Int
    n s
    s of
        Nothing -> []
        Just chk :: Tokens s
    chk -> Proxy s -> Tokens s -> [Token s]
    forall s. Stream s => Proxy s -> Tokens s -> [Token s]
    chunkToTokens (Proxy s
    forall k (t :: k). Proxy t
    Proxy :: Proxy s) Tokens s
    chk