1-- |
2-- Module      :  Text.Megaparsec.Debug
3-- Copyright   :  © 2015–present Megaparsec contributors
4-- License     :  FreeBSD
5--
6-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
7-- Stability   :  experimental
8-- Portability :  portable
9--
10-- Debugging helpers.
11--
12-- @since 7.0.0
13
14{-# LANGUAGE FlexibleContexts    #-}
15{-# LANGUAGE ScopedTypeVariables #-}
16
17module Text.Megaparsec.Debug
18  ( dbg )
19where
20
21import Data.Proxy
22import Debug.Trace
23import Text.Megaparsec.Error
24import Text.Megaparsec.Internal
25import Text.Megaparsec.State
26import Text.Megaparsec.Stream
27import qualified Data.List.NonEmpty as NE
28
29-- | @'dbg' label p@ parser works exactly like @p@, but when it's evaluated
30-- it also prints information useful for debugging. The @label@ is only used
31-- to refer to this parser in the debugging output. This combinator uses the
32-- 'trace' function from "Debug.Trace" under the hood.
33--
34-- Typical usage is to wrap every sub-parser in misbehaving parser with
35-- 'dbg' assigning meaningful labels. Then give it a shot and go through the
36-- print-out. As of current version, this combinator prints all available
37-- information except for /hints/, which are probably only interesting to
38-- the maintainer of Megaparsec itself and may be quite verbose to output in
39-- general. Let me know if you would like to be able to see hints in the
40-- debugging output.
41--
42-- The output itself is pretty self-explanatory, although the following
43-- abbreviations should be clarified (they are derived from the low-level
44-- source code):
45--
46--     * @COK@—“consumed OK”. The parser consumed input and succeeded.
47--     * @CERR@—“consumed error”. The parser consumed input and failed.
48--     * @EOK@—“empty OK”. The parser succeeded without consuming input.
49--     * @EERR@—“empty error”. The parser failed without consuming input.
50--
51-- Finally, it's not possible to lift this function into some monad
52-- transformers without introducing surprising behavior (e.g. unexpected
53-- state backtracking) or adding otherwise redundant constraints (e.g.
54-- 'Show' instance for state), so this helper is only available for
55-- 'ParsecT' monad, not any instance of 'Text.Megaparsec.MonadParsec' in
56-- general.
57
58dbg :: forall e s m a.
59  ( Stream s
60  , ShowErrorComponent e
61  , Show a )
62  => String            -- ^ Debugging label
63  -> ParsecT e s m a   -- ^ Parser to debug
64  -> ParsecT e s m a   -- ^ Parser that prints debugging messages
65dbg lbl p = ParsecT $ \s cok cerr eok eerr ->
66  let l = dbgLog lbl :: DbgItem s e a -> String
67      unfold = streamTake 40
68      cok' x s' hs = flip trace (cok x s' hs) $
69        l (DbgIn (unfold (stateInput s))) ++
70        l (DbgCOK (streamTake (streamDelta s s') (stateInput s)) x)
71      cerr' err s' = flip trace (cerr err s') $
72        l (DbgIn (unfold (stateInput s))) ++
73        l (DbgCERR (streamTake (streamDelta s s') (stateInput s)) err)
74      eok' x s' hs = flip trace (eok x s' hs) $
75        l (DbgIn (unfold (stateInput s))) ++
76        l (DbgEOK (streamTake (streamDelta s s') (stateInput s)) x)
77      eerr' err s' = flip trace (eerr err s') $
78        l (DbgIn (unfold (stateInput s))) ++
79        l (DbgEERR (streamTake (streamDelta s s') (stateInput s)) err)
80  in unParser p s cok' cerr' eok' eerr'
81
82-- | A single piece of info to be rendered with 'dbgLog'.
83
84data DbgItem s e a
85  = DbgIn   [Token s]
86  | DbgCOK  [Token s] a
87  | DbgCERR [Token s] (ParseError s e)
88  | DbgEOK  [Token s] a
89  | DbgEERR [Token s] (ParseError s e)
90
91-- | Render a single piece of debugging info.
92
93dbgLog
94  :: forall s e a. (Stream s, ShowErrorComponent e, Show a)
95  => String            -- ^ Debugging label
96  -> DbgItem s e a     -- ^ Information to render
97  -> String            -- ^ Rendered result
98dbgLog lbl item = prefix msg
99  where
100    prefix = unlines . fmap ((lbl ++ "> ") ++) . lines
101    pxy = Proxy :: Proxy s
102    msg = case item of
103      DbgIn   ts   ->
104        "IN: " ++ showStream pxy ts
105      DbgCOK  ts a ->
106        "MATCH (COK): " ++ showStream pxy ts ++ "\nVALUE: " ++ show a
107      DbgCERR ts e ->
108        "MATCH (CERR): " ++ showStream pxy ts ++ "\nERROR:\n" ++ parseErrorPretty e
109      DbgEOK  ts a ->
110        "MATCH (EOK): " ++ showStream pxy ts ++ "\nVALUE: " ++ show a
111      DbgEERR ts e ->
112        "MATCH (EERR): " ++ showStream pxy ts ++ "\nERROR:\n" ++ parseErrorPretty e
113
114-- | Pretty-print a list of tokens.
115
116showStream :: Stream s => Proxy s -> [Token s] -> String
117showStream pxy ts =
118  case NE.nonEmpty ts of
119    Nothing -> "<EMPTY>"
120    Just ne ->
121      let (h, r) = splitAt 40 (showTokens pxy ne)
122      in if null r then h else h ++ " <…>"
123
124-- | Calculate number of consumed tokens given 'State' of parser before and
125-- after parsing.
126
127streamDelta
128  :: State s e         -- ^ State of parser before consumption
129  -> State s e         -- ^ State of parser after consumption
130  -> Int               -- ^ Number of consumed tokens
131streamDelta s0 s1 = stateOffset s1 - stateOffset s0
132
133-- | Extract a given number of tokens from the stream.
134
135streamTake :: forall s. Stream s => Int -> s -> [Token s]
136streamTake n s =
137  case fst <$> takeN_ n s of
138    Nothing -> []
139    Just chk -> chunkToTokens (Proxy :: Proxy s) chk
140