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