JSON Parser

JsonParser.fs

type json =
    | Number of float
    | String of string
    | Boolean of bool
    | Array of json list
    | Object of (string * json) list 
    | Null
    static member (?) (this,name:string) =
        match this with
        | Object xs -> xs |> List.find (fst >> (=) name) |> snd
        | _ -> invalidOp "Expecting object"
    member this.Item(n:int) = 
        match this with
        | Array xs -> xs.[n]
        | _ -> invalidOp "Expecting array"
       
let parse (s:string) =
    let index = ref 0
    let numIntroChars = "-0123456789."
    let numChars = "-0123456789.eE"
    let len = s.Length
    let inline error s =
        invalidOp s
    let skipWhiteSpace () =
        while !index < len && System.Char.IsWhiteSpace(s.[!index]) do incr index
    let rec parseValue () =
        skipWhiteSpace ()
        if !index < len then
            let c = s.[!index]
            if c = '[' then parseArray ()
            elif c = '{' then parseObject ()
            elif c = '"' then parseString ()
            elif numIntroChars.IndexOf(c) <> -1 then parseNumber ()
            elif c = 't' then parseLiteral("true",Boolean true)
            elif c = 'f' then parseLiteral("false",Boolean false)
            elif c = 'n' then parseLiteral("null",Null)
            elif c = 'N' then parseLiteral("NaN",Number nan)
            else error (sprintf "Unexpected tokens %s" (s.Substring(!index)))
        else Null
    and parseLiteral (text,value) =
        if s.Substring(!index, text.Length) = text 
        then
            index := !index + text.Length
            value
        else error "Invalid token"
    and parseObject () =
        incr index
        skipWhiteSpace ()
        if s.[!index] = '}' then Object []
        else
            let pairs = parsePairs ()
            if s.[!index] <> '}' then error "Expecting , or }"
            incr index
            Object pairs
    and parsePairs () =
        let name = 
            match parseValue () with
            | String s -> s
            | _ -> error "Expecting property name"
        skipWhiteSpace ()
        if s.[!index] <> ':' then error "Expecting :"
        incr index
        let value = parseValue ()
        let pair = (name,value)
        skipWhiteSpace ()
        if s.[!index] = ',' then
            incr index
            skipWhiteSpace ()            
            pair::parsePairs ()
        else [pair]
    and parseArray () =
        incr index
        skipWhiteSpace ()
        if  s.[!index] = ']' then incr index; Array []
        else          
           let xs = parseValues ()
           if s.[!index] <> ']' then error "Expecting , or ]"
           incr index
           json.Array xs
    and parseValues () =
        let x = parseValue ()
        skipWhiteSpace ()
        if s.[!index] = ',' then 
           incr index
           skipWhiteSpace ()
           x::parseValues ()
        else [x]
    and parseString () =
        incr index
        let startIndex = !index
        let mutable c = ' '
        let mutable isEscaped = false
        while (c <- s.[!index]; c <> '\"') do 
            if c = '\\' then isEscaped <- true; incr index
            incr index
        let text = s.Substring(startIndex, !index-startIndex)
        if !index < len then incr index
        if isEscaped then json.String (System.Text.RegularExpressions.Regex.Unescape text)
        else json.String text
    and parseNumber () =
        let startIndex = !index
        while !index < len && numChars.IndexOf(s.[!index]) <> -1 do incr index
        let n = System.Double.Parse(s.Substring(startIndex, !index-startIndex))
        Number n
    let value = parseValue ()
    skipWhiteSpace ()
    if !index < len then error (sprintf "Unexpected tokens %s" (s.Substring(!index)))
    value

let empty = parse ""
let o = parse """{"a":1}"""
let eo = parse """{"a":1,"bb":2}"""
let bb = eo?bb
let ar = parse """ [ 1, [-1,2.3], "abc" ] """
let n = ar.[1].[1]
let ear = parse "[1,2,3]"
let num = parse " 1.0"
let text = parse "\"a\""
let b = parse "false"