{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards  #-}

{-|
Module      : Hectoparsec.Debug
Copyright   : (c) comp 2020
License     : MIT
Maintainer  : onecomputer00@gmail.com
Stability   : stable
Portability : portable

Combinators and functions for debugging 'ParserT'.
-}
module Hectoparsec.Debug
    ( -- * Re-exports
      module Debug.Trace
      -- * Debug combinators
    , pdbg
    , (<??>)
      -- * Debug printers
    , parseTest
    , fmtP
    , fmtE
    ) where

import Control.Monad.Identity
import Debug.Trace
import Hectoparsec.Error
import Hectoparsec.Primitive
import Hectoparsec.State
import Hectoparsec.Stream

{-|
Wraps a parser with 'trace' for debugging, showing the parser state before and after the parser.

A parser can either consume or not consume tokens, and it can succeed with a parsed value or fail with an error.
-}
pdbg
    :: (Stream s, Show (Token s), Show (Chunk s), Show e, Show l, Show a)
    => String
    -> ParserT s e l m a
    -> ParserT s e l m a
pdbg :: forall s e l a (m :: * -> *).
(Stream s, Show (Token s), Show (Chunk s), Show e, Show l,
 Show a) =>
String -> ParserT s e l m a -> ParserT s e l m a
pdbg String
lbl ParserT s e l m a
p = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
cok ThenErr s e l m r
cerr ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
    let pcok :: ThenOk s l m a r
pcok a
pa [l]
ls State s
pst = (String -> m r -> m r) -> m r -> String -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> m r -> m r
forall a. String -> a -> a
trace (ThenOk s l m a r
cok a
pa [l]
ls State s
pst) (String -> m r) -> ([String] -> String) -> [String] -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s -> State s -> String -> String
wrapState State s
st State s
pst (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> m r) -> [String] -> m r
forall a b. (a -> b) -> a -> b
$
            [ String
"  \x1b[32mconsumed ok:\x1b[0m\n"
            , String
"    \x1b[90mvalue:\x1b[0m ", a -> String
forall a. Show a => a -> String
show a
pa, String
"\n"
            , String
"    \x1b[90mlabels:\x1b[0m ", [l] -> String
forall a. Show a => a -> String
show [l]
ls
            ]
        pcerr :: ThenErr s e l m r
pcerr ParseError s e l
pe State s
pst  = (String -> m r -> m r) -> m r -> String -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> m r -> m r
forall a. String -> a -> a
trace (ThenErr s e l m r
cerr ParseError s e l
pe State s
pst) (String -> m r) -> ([String] -> String) -> [String] -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s -> State s -> String -> String
wrapState State s
st State s
pst (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> m r) -> [String] -> m r
forall a b. (a -> b) -> a -> b
$
            [ String
"  \x1b[31mconsumed err:\x1b[0m\n"
            , ParseError s e l -> String
forall {e} {l} {s}.
(Show e, Show l, Show (Token s), Show (Chunk s)) =>
ParseError s e l -> String
showError ParseError s e l
pe
            ]
        puok :: ThenOk s l m a r
puok a
pa [l]
ls State s
pst = (String -> m r -> m r) -> m r -> String -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> m r -> m r
forall a. String -> a -> a
trace (ThenOk s l m a r
uok a
pa [l]
ls State s
pst) (String -> m r) -> ([String] -> String) -> [String] -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s -> State s -> String -> String
wrapState State s
st State s
pst (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> m r) -> [String] -> m r
forall a b. (a -> b) -> a -> b
$
            [ String
"  \x1b[32munconsumed ok:\x1b[0m\n"
            , String
"    \x1b[90mvalue:\x1b[0m ", a -> String
forall a. Show a => a -> String
show a
pa, String
"\n"
            , String
"    \x1b[90mlabels:\x1b[0m ", [l] -> String
forall a. Show a => a -> String
show [l]
ls
            ]
        puerr :: ThenErr s e l m r
puerr ParseError s e l
pe State s
pst  = (String -> m r -> m r) -> m r -> String -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> m r -> m r
forall a. String -> a -> a
trace (ThenErr s e l m r
uerr ParseError s e l
pe State s
pst) (String -> m r) -> ([String] -> String) -> [String] -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s -> State s -> String -> String
wrapState State s
st State s
pst (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> m r) -> [String] -> m r
forall a b. (a -> b) -> a -> b
$
            [ String
"  \x1b[31munconsumed err:\x1b[0m\n"
            , ParseError s e l -> String
forall {e} {l} {s}.
(Show e, Show l, Show (Token s), Show (Chunk s)) =>
ParseError s e l -> String
showError ParseError s e l
pe
            ]
    in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st ThenOk s l m a r
pcok ThenErr s e l m r
pcerr ThenOk s l m a r
puok ThenErr s e l m r
puerr
    where
        wrapState :: State s -> State s -> String -> String
wrapState State s
st State s
st' String
xs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
header, String
"\n"
            , String -> State s -> String
showState String
"before" State s
st, String
"\n"
            , String
xs, String
"\n"
            , String -> State s -> String
showState String
"after" State s
st'
            ]

        header :: String
header = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"\x1b[1mparser ", String
lbl, String
":\x1b[0m"
            ]

        showState :: String -> State s -> String
showState String
x State s
st = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"  \x1b[33m", String
x, String
" state:\x1b[0m\n"
            , String
"    \x1b[90moffset:\x1b[0m ", Pos -> String
forall a. Show a => a -> String
show (Pos -> String) -> Pos -> String
forall a b. (a -> b) -> a -> b
$ State s -> Pos
forall s. State s -> Pos
statePos State s
st, String
"\n"
            , String
"    \x1b[90mposition:\x1b[0m ", Pos -> String
forall a. Show a => a -> String
show (Pos -> String) -> Pos -> String
forall a b. (a -> b) -> a -> b
$ State s -> Pos
forall s. State s -> Pos
statePos State s
st, String
"\n"
            , String
"    \x1b[90minput:\x1b[0m ", s -> String
takeSome (s -> String) -> s -> String
forall a b. (a -> b) -> a -> b
$ State s -> s
forall s. State s -> s
stateInput State s
st
            ]

        showError :: ParseError s e l -> String
showError ParseError s e l
e = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"    \x1b[90moffset:\x1b[0m ", Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ ParseError s e l -> Int
forall s e l. ParseError s e l -> Int
parseErrorOffset ParseError s e l
e, String
"\n"
            , String
"    \x1b[90mposition:\x1b[0m ", Pos -> String
forall a. Show a => a -> String
show (Pos -> String) -> Pos -> String
forall a b. (a -> b) -> a -> b
$ ParseError s e l -> Pos
forall s e l. ParseError s e l -> Pos
parseErrorPos ParseError s e l
e, String
"\n"
            , String
"    \x1b[90merror:\x1b[0m ", ErrorItem s e l -> String
forall a. Show a => a -> String
show (ErrorItem s e l -> String) -> ErrorItem s e l -> String
forall a b. (a -> b) -> a -> b
$ ParseError s e l -> ErrorItem s e l
forall s e l. ParseError s e l -> ErrorItem s e l
parseErrorItem ParseError s e l
e
            ]

        takeSome :: s -> String
takeSome = Chunk s -> String
forall a. Show a => a -> String
show (Chunk s -> String) -> (s -> Chunk s) -> s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk s, s) -> Chunk s
forall a b. (a, b) -> a
fst ((Chunk s, s) -> Chunk s) -> (s -> (Chunk s, s)) -> s -> Chunk s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> s -> (Chunk s, s)
forall s. Stream s => Int -> s -> (Chunk s, s)
streamSplitAt Int
10

-- | Infix version of @flip 'pdbg'@.
infix 0 <??>
(<??>) :: (Stream s, Show (Token s), Show (Chunk s), Show e, Show l, Show a)
    => ParserT s e l m a
    -> String
    -> ParserT s e l m a
<??> :: forall s e l a (m :: * -> *).
(Stream s, Show (Token s), Show (Chunk s), Show e, Show l,
 Show a) =>
ParserT s e l m a -> String -> ParserT s e l m a
(<??>) = (String -> ParserT s e l m a -> ParserT s e l m a)
-> ParserT s e l m a -> String -> ParserT s e l m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> ParserT s e l m a -> ParserT s e l m a
forall s e l a (m :: * -> *).
(Stream s, Show (Token s), Show (Chunk s), Show e, Show l,
 Show a) =>
String -> ParserT s e l m a -> ParserT s e l m a
pdbg

-- | Runs a parser and prints the output or error to the console.
parseTest
    :: (Show (Token s), Show (Chunk s), Show e, Show l, Show a)
    => Parser s e l a
    -> s
    -> IO ()
parseTest :: forall s e l a.
(Show (Token s), Show (Chunk s), Show e, Show l, Show a) =>
Parser s e l a -> s -> IO ()
parseTest Parser s e l a
p s
s = do
    let Reply State s
_ Bool
_ Either (ParseError s e l) a
res = Identity (Reply s e l a) -> Reply s e l a
forall a. Identity a -> a
runIdentity (Identity (Reply s e l a) -> Reply s e l a)
-> Identity (Reply s e l a) -> Reply s e l a
forall a b. (a -> b) -> a -> b
$ Parser s e l a -> State s -> Identity (Reply s e l a)
forall (m :: * -> *) s e l a.
Monad m =>
ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT Parser s e l a
p (String -> s -> State s
forall s. String -> s -> State s
initialState String
"<debug>" s
s)
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Either (ParseError s e l) a -> String
forall s e l a.
(Show (Token s), Show (Chunk s), Show e, Show l, Show a) =>
Either (ParseError s e l) a -> String
fmtP Either (ParseError s e l) a
res

-- | Formats the result of running a parser for debugging purposes.
fmtP
    :: (Show (Token s), Show (Chunk s), Show e, Show l, Show a)
    => Either (ParseError s e l) a
    -> String
fmtP :: forall s e l a.
(Show (Token s), Show (Chunk s), Show e, Show l, Show a) =>
Either (ParseError s e l) a -> String
fmtP Either (ParseError s e l) a
res = case Either (ParseError s e l) a
res of
    Right a
x -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"\x1b[1;32msuccess:\x1b[0m\n"
        , String
"  \x1b[90mvalue:\x1b[0m ", a -> String
forall a. Show a => a -> String
show a
x
        ]
    Left ParseError s e l
e -> ParseError s e l -> String
forall s e l.
(Show (Token s), Show (Chunk s), Show e, Show l) =>
ParseError s e l -> String
fmtE ParseError s e l
e

-- | Formats the errors from a parser for debugging purposes.
fmtE
    :: (Show (Token s), Show (Chunk s), Show e, Show l)
    => ParseError s e l
    -> String
fmtE :: forall s e l.
(Show (Token s), Show (Chunk s), Show e, Show l) =>
ParseError s e l -> String
fmtE ParseError s e l
e = String
fullmsg
    where
        fullmsg :: String
fullmsg = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"\x1b[1;31mfailure:\x1b[0m\n"
            , ParseError s e l -> String
forall {l} {e} {s}.
(Show l, Show e, Show (Token s), Show (Chunk s)) =>
ParseError s e l -> String
emsg ParseError s e l
e
            ]

        emsg :: ParseError s e l -> String
emsg (ParseError {Int
Pos
ErrorItem s e l
parseErrorItem :: ErrorItem s e l
parseErrorOffset :: Int
parseErrorPos :: Pos
parseErrorItem :: forall s e l. ParseError s e l -> ErrorItem s e l
parseErrorPos :: forall s e l. ParseError s e l -> Pos
parseErrorOffset :: forall s e l. ParseError s e l -> Int
..}) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"  \x1b[90mparse error:\x1b[0m\n"
            , String
"    \x1b[90moffset:\x1b[0m ", Int -> String
forall a. Show a => a -> String
show Int
parseErrorOffset, String
"\n"
            , String
"    \x1b[90mposition:\x1b[0m ", Pos -> String
forall a. Show a => a -> String
show Pos
parseErrorPos, String
"\n"
            , ErrorItem s e l -> String
forall {l} {e} {s}.
(Show l, Show e, Show (Token s), Show (Chunk s)) =>
ErrorItem s e l -> String
eimsg ErrorItem s e l
parseErrorItem
            ]

        eimsg :: ErrorItem s e l -> String
eimsg ErrorItem s e l
ei = case ErrorItem s e l
ei of
            ErrorItemLabels Unexpected s
unex [l]
ls -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"    \x1b[90munexpected:\x1b[0m ", Unexpected s -> String
forall a. Show a => a -> String
show Unexpected s
unex, String
"\n"
                , String
"    \x1b[90mexpected:\x1b[0m ", [l] -> String
forall a. Show a => a -> String
show [l]
ls
                ]
            ErrorItemMessages [Message e]
xs -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"    \x1b[90mmessages:\x1b[0m ", [Message e] -> String
forall a. Show a => a -> String
show [Message e]
xs
                ]