5.9 Parsing with user state

The user state allows you to introduce additional variables into the state tracked by FParsec parsers. It has the following two important properties:

• The user state is stored in the CharStream<'u> instance and hence associated with the input. It is not shared globally and not associated with particular parser instances. The same parser instances can be concurrently applied to different CharStream<'u> instances with different user state instances.
• The user state is tracked by FParsec parsers together with the input stream position. This means in particular that a parser restores the previous user state value when it backtracks.

With the help of the user state you can implement context sensitive parsers, i.e. parsers whose behaviour not only depends on the immediate input but also on the context of the input. In general this works as follows:

1. You establish a context by defining variables in the user state.
2. You update the context depending on the input by letting parsers update the user state.
3. You parse input depending on the context by making the parser behaviour dependent on the user state variables.

The user state is exposed through the UserState property of the CharStream<'u>. You can implement parsers using the low‐level API that directly access this property, or you can use the following parser primitives from the CharParsers module:

• getUserState,
• setUserState,
• updateUserState,
• userStateSatisfies.

The following parser for a tiny markup‐language employs the user state

1. to ensure that nested hyperlinks are not accepted and
2. to parse potentially nested quotations between matching pairs of '\'' or '\"' chars.

open FParsec

type Element = Text of string
             | Bold of Element list
             | Italic of Element list
             | Url of string * Element list
             | Quote of char * Element list

type UserState =
    {InLink: bool
     QuoteStack: char list}
    with
       static member Default = {InLink = false; QuoteStack = []}

let ws    = spaces
let ws1   = spaces1
let str s = pstring s

let elements, elementsR = createParserForwardedToRef()

let text = many1Satisfy (isNoneOf "<>'\"\\") |>> Text
let escape = str "\\" >>. (anyChar |>> (string >> Text))

let quote (q: char) =
  let pq = str (string q)

  let pushQuote =
      updateUserState (fun us -> {us with QuoteStack = q::us.QuoteStack})

  let popQuote =
      updateUserState (fun us -> {us with QuoteStack = List.tail us.QuoteStack})

  let isNotInQuote =
      userStateSatisfies (fun us -> match us.QuoteStack with
                                    | c::_ when c = q -> false
                                    | _ -> true)

  isNotInQuote >>. between pq pq
                           (between pushQuote popQuote
                                    (elements |>> fun ps -> Quote(q, ps)))

// helper functions for defining tags

let tagOpenBegin tag =
    str ("<" + tag)
    >>? nextCharSatisfiesNot isLetter // make sure tag name is complete
    <?> "<" + tag + "> tag"

let tagOpen tag = tagOpenBegin tag >>. str ">"
let tagClose tag = str ("</" + tag + ">")

let tag t p f =
    between (tagOpen t) (tagClose t)
            (p |>> f)

let attributeValue =
    ws >>. str "=" >>. ws
    >>. between (str "\"") (str "\"")
                (manySatisfy (isNoneOf "\n\""))

let attribute s = str s >>. attributeValue

let nonNestedTag tag pAttributesAndClose pBody f
                 isInTag setInTag setNotInTag =
    tagOpenBegin tag
    >>. ((fun stream ->
            if not (isInTag stream.UserState) then
                stream.UserState <- setInTag stream.UserState
                Reply(())
            else // generate error at start of tag
                stream.Skip(-tag.Length - 1)
                Reply(FatalError,
                      messageError ("Nested <" + tag + "> tags are not allowed.")))
         >>. pipe2 pAttributesAndClose pBody f
             .>> (tagClose tag >>. updateUserState setNotInTag))

// the tags

let bold   = tag "b" elements Bold
let italic = tag "i" elements Italic

let url = nonNestedTag "a" (ws >>. attribute "href" .>> (ws >>. str ">"))
                       elements
                       (fun url phrases -> Url(url, phrases))
                       (fun us -> us.InLink)
                       (fun us -> {us with InLink = true})
                       (fun us -> {us with InLink = false})


let element = choice [text
                      escape
                      quote '\''
                      quote '\"'
                      bold
                      italic
                      url]

do elementsR:= many element

let document = elements .>> eof

> runParserOnString document UserState.Default ""
    "A \"'text' with 'nested \"<b>quotes</b>\"'.\"";;
val it : ParserResult<Element list,UserState> = Success:
[Text "A ";
 Quote
   ('"',
    [Quote ('\'',[Text "text"]); Text " with ";
     Quote ('\'',[Text "nested "; Quote ('"',[Bold [Text "quotes"]])]); Text "."])]

> runParserOnString document UserState.Default ""
    @"<b>Text <i></i>with</b> <a href=""url"">'link' but no \<blink\></a>";;
val it : ParserResult<Element list,UserState> = Success:
[Bold [Text "Text "; Italic []; Text "with"]; Text " ";
 Url("url",
     [Quote ('\'',[Text "link"]); Text " but no "; Text "<"; Text "blink";
      Text ">"])]

> runParserOnString document UserState.Default ""
    "<a href=\"url\"><a href=\"nested\">test</a></a>";;
val it : ParserResult<Element list,UserState> = Failure:
Error in Ln: 1 Col: 15
<a href="url"><a href="nested">test</a></a>
              ^
Nested <a> tags are not allowed.

type CompilationUnitAST = (* ... *)

type UserState = {
    IncludePaths = string list
    (* ... *)
}

let parser : Parser<CompilationUnitAST, UserState> = (* ... *)

let parseCompilationUnit file encoding includePaths (* ... *) =
    let initialUserState = {IncludePaths = includePaths; (* ... *)}
    runParserOnFile parser initialUserState file encoding