A pretty printed debug tracer for FParsec - like [the example from the docs](http://www.quanttec.com/fparsec/users-guide/debugging-a-parser.html#tracing-a-parser) but with nicer syntax and saves the output in `UserData.Debug`. Use the same ways as in the docs - `parser <!> "label"` will trace the entrance, exit, result and data produced by `pars…

0_FParsecTrace.fs

module FParsecTrace

open FParsec
open FParsec.Primitives
open FParsec.CharParsers

open System.Text

type DebugInfo = { Message: string; Indent: int }
type UserState = { mutable Debug: DebugInfo }
type P<'t> = Parser<'t, UserState>

type DebugType<'a> = Enter | Leave of Reply<'a>

let addToDebug (stream:CharStream<UserState>) label dtype =
    let msgPadLen = 50

    let startIndent = stream.UserState.Debug.Indent
    let (str, curIndent, nextIndent) = match dtype with
        | Enter    -> sprintf "Entering %s" label, startIndent, startIndent+1
        | Leave res ->
            let str = sprintf "Leaving  %s (%A)" label res.Status
            let resStr = sprintf "%s %A" (str.PadRight(msgPadLen-startIndent-1)) res.Result
            resStr, startIndent-1, startIndent-1

    let indentStr =
        if curIndent = 0 then ""
        else "\u251C".PadRight(curIndent, '\u251C')

    let posStr = (sprintf "%A: " stream.Position).PadRight(20)
    let posIdentStr = posStr + indentStr

    // The %A for res.Result makes it go onto multiple lines - pad them out correctly
    let replaceStr = "\n" + "".PadRight(posStr.Length) + "".PadRight(curIndent, '\u2502').PadRight(msgPadLen)
    let correctedStr = str.Replace("\n", replaceStr)

    let fullStr = sprintf "%s %s\n" posIdentStr correctedStr

    stream.UserState.Debug <- {
        Message = stream.UserState.Debug.Message + fullStr
        Indent = nextIndent
    }

let (<!>) (p: P<_>) label :P<_> =
    fun stream ->
        addToDebug stream label Enter
        let reply = p stream
        addToDebug stream label (Leave reply)
        reply

let (<?!>) (p: P<_>) label :P<_> =
    p <?> label <!> label

ExampleOutput

Success: ['a']
Debug:

(Ln: 1, Col: 1):     Entering sepByTest
(Ln: 1, Col: 1):    ├ Entering a
(Ln: 1, Col: 2):    ├ Leaving  a (Ok)                                 'a'
(Ln: 1, Col: 2):    ├ Entering b
(Ln: 1, Col: 2):    ├ Leaving  b (Error)                              '\000'
(Ln: 1, Col: 2):     Leaving  sepByTest (Ok)                          ['a']

Success: ['a'; 'a']
Debug:

(Ln: 1, Col: 1):     Entering sepByTest
(Ln: 1, Col: 1):    ├ Entering a
(Ln: 1, Col: 2):    ├ Leaving  a (Ok)                                 'a'
(Ln: 1, Col: 2):    ├ Entering b
(Ln: 1, Col: 3):    ├ Leaving  b (Ok)                                 'b'
(Ln: 1, Col: 3):    ├ Entering a
(Ln: 1, Col: 4):    ├ Leaving  a (Ok)                                 'a'
(Ln: 1, Col: 4):    ├ Entering b
(Ln: 1, Col: 4):    ├ Leaving  b (Error)                              '\000'
(Ln: 1, Col: 4):     Leaving  sepByTest (Ok)                          ['a'; 'a']

Failure: "Error in Ln: 1 Col: 3
ab
  ^
Note: The error occurred at the end of the line.
Expecting: 'a'
"

Debug:

(Ln: 1, Col: 1):     Entering sepByTest
(Ln: 1, Col: 1):    ├ Entering a
(Ln: 1, Col: 2):    ├ Leaving  a (Ok)                                 'a'
(Ln: 1, Col: 2):    ├ Entering b
(Ln: 1, Col: 3):    ├ Leaving  b (Ok)                                 'b'
(Ln: 1, Col: 3):    ├ Entering a
(Ln: 1, Col: 3):    ├ Leaving  a (Error)                              '\000'
(Ln: 1, Col: 3):     Leaving  sepByTest (Error)                       <null>

ExampleUse.fs

module ExampleUse

open FParsec
open FParsec.Primitives
open FParsec.CharParsers

// Test on the pattern (a (ba)*)?
let sepByTest = sepBy (pchar 'a' <!> "a") (pchar 'b' <!> "b") <!> "sepByTest"

let test p str =
    let str = str + "\n"
    match runParserOnString p ({ Debug = { Message = ""; Indent = 0 } }) "" str with
        | Success (result, us, _) ->
            printfn "Success: %A" result
            printfn "Debug:\n\n%s" us.Debug.Message
        | Failure (msg, _, us)   ->
            printfn "Failure: %A\n" msg
            printfn "Debug:\n\n%s" us.Debug.Message

[<EntryPoint>]
let main argv =
    test sepByTest "a"
    test sepByTest "aba"
    test sepByTest "ab"

    0

LargerOutput

// For the code foo a = f x 3

Success: FuncDef {Name = "[f; o; o]";
         Params = ["[a]"];
         Expr = App {Func = Ident {Name = "[f]";};
                     Args = [Ident {Name = "[x]";}; ConstInt 3];};}
Debug:

(Ln: 1, Col: 1):     Entering top level function definition
(Ln: 1, Col: 1):    ├ Entering identifier
(Ln: 1, Col: 4):    ├ Leaving  identifier (Ok)                   "[f; o; o]"
(Ln: 1, Col: 4):    ├ Entering params
(Ln: 1, Col: 4):    ├├ Entering whitespace
(Ln: 1, Col: 5):    ├├ Leaving  whitespace (Ok)                  <null>
(Ln: 1, Col: 5):    ├├ Entering parameter
(Ln: 1, Col: 5):    ├├├ Entering identifier
(Ln: 1, Col: 6):    ├├├ Leaving  identifier (Ok)                 "[a]"
(Ln: 1, Col: 6):    ├├ Leaving  parameter (Ok)                   "[a]"
(Ln: 1, Col: 6):    ├├ Entering whitespace
(Ln: 1, Col: 7):    ├├ Leaving  whitespace (Ok)                  <null>
(Ln: 1, Col: 7):    ├├ Entering parameter
(Ln: 1, Col: 7):    ├├├ Entering identifier
(Ln: 1, Col: 7):    ├├├ Leaving  identifier (Error)              <null>
(Ln: 1, Col: 7):    ├├ Leaving  parameter (Error)                <null>
(Ln: 1, Col: 6):    ├├ Entering whitespace
(Ln: 1, Col: 7):    ├├ Leaving  whitespace (Ok)                  <null>
(Ln: 1, Col: 7):    ├ Leaving  params (Ok)                       ["[a]"]
(Ln: 1, Col: 7):    ├ Entering eq
(Ln: 1, Col: 8):    ├ Leaving  eq (Ok)                           '='
(Ln: 1, Col: 8):    ├ Entering whitespace
(Ln: 1, Col: 9):    ├ Leaving  whitespace (Ok)                   <null>
(Ln: 1, Col: 9):    ├ Entering expression
(Ln: 1, Col: 9):    ├├ Entering app
(Ln: 1, Col: 9):    ├├├ Entering exprBasic
(Ln: 1, Col: 9):    ├├├├ Entering int32
(Ln: 1, Col: 9):    ├├├├ Leaving  int32 (Error)                  <null>
(Ln: 1, Col: 9):    ├├├├ Entering var
(Ln: 1, Col: 9):    ├├├├├ Entering identifier
(Ln: 1, Col: 10):   ├├├├├ Leaving  identifier (Ok)               "[f]"
(Ln: 1, Col: 10):   ├├├├ Leaving  var (Ok)                       Ident {Name = "[f]";}
(Ln: 1, Col: 10):   ├├├ Leaving  exprBasic (Ok)                  Ident {Name = "[f]";}
(Ln: 1, Col: 10):   ├├├ Entering whitespace1
(Ln: 1, Col: 11):   ├├├ Leaving  whitespace1 (Ok)                <null>
(Ln: 1, Col: 11):   ├├├ Entering exprBasic
(Ln: 1, Col: 11):   ├├├├ Entering int32
(Ln: 1, Col: 11):   ├├├├ Leaving  int32 (Error)                  <null>
(Ln: 1, Col: 11):   ├├├├ Entering var
(Ln: 1, Col: 11):   ├├├├├ Entering identifier
(Ln: 1, Col: 12):   ├├├├├ Leaving  identifier (Ok)               "[x]"
(Ln: 1, Col: 12):   ├├├├ Leaving  var (Ok)                       Ident {Name = "[x]";}
(Ln: 1, Col: 12):   ├├├ Leaving  exprBasic (Ok)                  Ident {Name = "[x]";}
(Ln: 1, Col: 12):   ├├├ Entering whitespace1
(Ln: 1, Col: 13):   ├├├ Leaving  whitespace1 (Ok)                <null>
(Ln: 1, Col: 13):   ├├├ Entering exprBasic
(Ln: 1, Col: 13):   ├├├├ Entering int32
(Ln: 1, Col: 14):   ├├├├ Leaving  int32 (Ok)                     ConstInt 3
(Ln: 1, Col: 14):   ├├├ Leaving  exprBasic (Ok)                  ConstInt 3
(Ln: 1, Col: 14):   ├├├ Entering whitespace1
(Ln: 1, Col: 14):   ├├├ Leaving  whitespace1 (Error)             <null>
(Ln: 1, Col: 14):   ├├ Leaving  app (Ok)                         App {Func = Ident {Name = "[f]";};
                    ││                                                Args = [Ident {Name = "[x]";}; ConstInt 3];}
(Ln: 1, Col: 14):   ├ Leaving  expression (Ok)                   App {Func = Ident {Name = "[f]";};
                    │                                                 Args = [Ident {Name = "[x]";}; ConstInt 3];}
(Ln: 1, Col: 14):   ├ Entering whitespace
(Ln: 1, Col: 14):   ├ Leaving  whitespace (Ok)                   <null>
(Ln: 2, Col: 1):     Leaving  top level function definition (Ok) FuncDef {Name = "[f; o; o]";
                                                                          Params = ["[a]"];
                                                                          Expr = App {Func = Ident {Name = "[f]";};
                                                                                      Args = [Ident {Name = "[x]";}; ConstInt 3];};}