Getting FParsec to reject unmatched start end tags?

user_99397 0
Viewed 93

Writing my own XML parser to learn FParsec I need to test that the XML start and end tags match or have the parser fail.

In the code fragment below ...

  • The parsers xStartTag and xKey return strings which I want to match.
  • The parser xContent_UntilCloseTag just returns whatever is between the tags.
  • ws skips whitespace and str(">") skips a '>'.
  • The PipeN.pipe10 function is an extension of the standard FParsec primitive pipe5 to feed the result of 10 parsers into a function.

All these parsers compile and work.

How can I get the following parser of type Parser<XELEMENT, USER_STATE> constructing the type XELEMENT_CONTENT to fail when the start and end tags do not match?

00 let xElement_Content : Parser<XELEMENT, USER_STATE> =
01    (PipeN.pipe10 ws xStartTag ws xContent_UntilCloseTag ws xKey ws (str ">") ws
02                  (fun stream -> getUserState stream)
03                  (fun x1 x2_startTag x3 x4_content x5 x6_closeTag x7 x8 x9 userState ->
04                    if x2_startTag.head = x6_closeTag
05                        then
06                            (userState.Deeper(x2_startTag.head), x2_startTag, x4_content)
07                        else Reply(FatalError, messageError ("in xElementContent: head tag (%s) does not match close tag (%s)", x2_startTag.head, x6_closeTag))
08                   ) |>> C_XELEMENT_CONTENT
09                  )

Line 07 throws the compiler error ...

FS0001: All branches of an 'if' expreession must return values of the same type as the first branch which here is 'USER_STATE * XHEADandATTRIBUTES_RECORD * string'. This branch returns a value of the type 'Reply<`a>'.

The code compiles fine if I comment out the if-then-else statement (lines 04, 05, and 07) leaving 06. Types agree in that case. I think I understand that.

But I need to throw an error and have the parser fail when the strings returned from xStartTag and xKey don't agree - How?

I don't think knowing the types is necessary for the answer; but just in case here are the various type definitions...

type USER_STATE =
    {
        tag : string
    depth : int
    }

type XELEMENT_CONTENT = USER_STATE * XHEADandATTRIBUTES_RECORD * string
type XELEMENT_EMPTY = XHEADandATTRIBUTES_RECORD

type XELEMENT =
    | C_XELEMENT_CONTENT of XELEMENT_CONTENT
    | C_XELEMENT_NESTED of USER_STATE * XHEADandATTRIBUTES_RECORD * (XELEMENT list)
    | C_XELEMENT_EMPTY of XELEMENT_EMPTY

type XELEMENT_NESTED = XHEADandATTRIBUTES_RECORD * (XELEMENT list)

I have reviewed the FParsec documentation in detail (especially the User's Guide on 'Parsing with User State') but maybe I missed something?

fparsec f#
1 Answers

I don't think you need to maintain user state to match XML tags. Here's a very simple parser that detects mismatches correctly (but doesn't handle nested tags):

open FParsec

let parseTagOpen =
    pstring "<"
        >>. manySatisfy (fun c -> c <> '>')
        .>> pstring ">"

let parseTagClose =
    pstring "</"
        >>. manySatisfy (fun c -> c <> '>')
        .>> pstring ">"

let parseInput =
    parseTagOpen
        .>>. (manySatisfy (fun c -> c <> '<'))
        .>>. parseTagClose
        >>= (fun ((tag1, content), tag2) ->   // *** this is the important part ***
            if tag1 = tag2 then preturn (tag1, content)
            else failFatally "mismatch")

[<EntryPoint>]
let main argv =
    [
        "<moo>baa</moo>"
        "<moo>baa</oink>"
    ] |> Seq.iter (fun input ->
        let result = run parseInput input
        printfn ""
        printfn "%s" input
        printfn "%A" result)
    0
user_3442230
Related