型安全？なJsonパーサ

JsonSerializer.fs

module Sayuri.JsonSerializer
open System
open System.Collections.Generic
open System.Globalization
open System.Text

[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
type JsonType =
| JsonNull
| JsonBoolean of bool
| JsonNumber  of float
| JsonString  of string
| JsonArray   of JsonType[]
| JsonObject  of IDictionary<string, JsonType>

let getBoolean = function
    | JsonBoolean b -> b
    | _ -> failwith "not boolean"

let getNumber = function
    | JsonNumber d -> d
    | _ -> failwith "not number"

let getString = function
    | JsonString s -> s
    | _ -> failwith "not string"

let getArray = function
    | JsonArray a -> a
    | _ -> failwith "not array"

let getObject = function
    | JsonObject o -> o
    | _ -> failwith "not object"

let deserialize (s : string) =
    let i = ref 0

    let skipWhiteSpace () =
        while Char.IsWhiteSpace(s, !i) do
            incr i
        let c = s.[!i]
        incr i
        c

    let deserializeString first =
        if first <> '"' then failwith ""
        let rec loop escaped =
            if s.Length <= !i then failwith ""
            let c = s.[!i]
            incr i
            if escaped then
                (match c with
                | '"' | '\'' | '/' | '\\'
                      -> c
                | 'b' -> '\b'
                | 'f' -> '\f'
                | 'n' -> '\n'
                | 'r' -> '\r'
                | 't' -> '\t'
                | 'u' -> let hex = s.Substring(!i, 4)
                         i := !i + 4
                         Int32.Parse(hex, NumberStyles.HexNumber, CultureInfo.InvariantCulture) |> char
                | _   -> failwith "") :: loop false
            elif c = '\\' then
                loop true
            elif c = '"' then
                []
            else
                c :: loop false
        String(loop false |> Array.ofList)

    let rec deserialize () =
        match skipWhiteSpace () with
        | '{' ->
            let dictionary = Dictionary()
            let rec loop () =
                let key = skipWhiteSpace () |> deserializeString
                if skipWhiteSpace () <> ':' then failwith ""
                dictionary.[key] <- deserialize ()
                match skipWhiteSpace () with
                | '}' -> ()
                | ',' -> loop ()
                | _   -> failwith ""
            if s.[!i] <> '}' then loop () else incr i
            JsonObject dictionary
        | '[' ->
            if s.[!i] = ']' then incr i; JsonArray Array.empty else
            let rec loop () =
                skipWhiteSpace () |> ignore
                decr i
                let o = deserialize ()
                match skipWhiteSpace () with
                | ']' -> [o]
                | ',' -> o :: loop ()
                | _   -> failwith ""
            loop () |> Array.ofList |> JsonArray
        | '"' ->
            deserializeString '\"' |> JsonString
        | _ ->
            let start = !i - 1
            let rec loop () =
                if !i < s.Length then
                    let c = s.[!i]
                    if Char.IsLetterOrDigit c || c = '.' || c = '-' || c = '+' (*|| c = '_'*) then
                        incr i
                        loop ()
            loop ()
            match s.Substring(start, !i - start) with
            | "null"  -> JsonNull
            | "true"  -> JsonBoolean true
            | "false" -> JsonBoolean false
            | input   -> Double.Parse(input, NumberStyles.Float, CultureInfo.InvariantCulture) |> JsonNumber

    deserialize ()

let serialize json =
    let sb = StringBuilder()

    let serializeString s =
        ignore <| sb.Append '"'
        let l = String.length s
        let mutable i = 0
        while i < l do
            let o = i
            while i < l && let c = s.[i] in '\x20' <= c &&  c <> '"' && c <> '\\' do
                i <- i + 1
            if o < i then
                ignore <| sb.Append(s, o, i - o)
            if i < l then
                ignore <| sb.AppendFormat(CultureInfo.InvariantCulture, "\\u{0:X4}", int s.[i])
                i <- i + 1
        sb.Append '"'

    let rec serialize = function
        | JsonNull      -> sb.Append "null"
        | JsonBoolean b -> sb.Append(if b then "true" else "false")
        | JsonNumber n  -> sb.AppendFormat(CultureInfo.InvariantCulture, "{0:g}", n)
        | JsonString s  -> serializeString s
        | JsonArray a   -> ignore <| sb.Append '['
                           for i in 0 .. Array.length a - 1 do
                               if i <> 0 then ignore <| sb.Append ','
                               ignore <| serialize a.[i]
                           sb.Append ']'
        | JsonObject o  -> ignore <| sb.Append '{'
                           let mutable first = true
                           for p in o do
                               if first then first <- false else ignore <| sb.Append ','
                               ignore <| serializeString p.Key
                               ignore <| sb.Append ':'
                               ignore <| serialize p.Value
                           sb.Append '}'

    (serialize json).ToString()