JSONの構造解析 (JsonAnalyzer.fs)

Flag.fs

//
// JsonAnalyzer
//  - Flag module
//
//  parse Command-line Arguments
//
module Flag


let showUsage() =
    eprintfn "
JsonAnalyzer.exe:
  入力されたJSONの構造を標準出力に書き出す

  ファイル指定
    JsonAnalyzer.exe -f foobar.json
  標準入力
    JsonAnalyzer.exe -i < foobar.json
  パイプライン入力
    SomeProgram.exe | JsonAnalyzer.exe -p

  複数ファイル指定で構造の省略部分を補完
    JsonAnalyzer.exe -f hoge.json fuga.json piyo.json


  標準出力ではなくファイルに書き出す場合(例: result.txtに出力する場合)

  ファイル指定
    JsonAnalyzer.exe -o result.txt -f foobar.json
  標準入力
    JsonAnalyzer.exe -o result.txt -i < foobar.json
  パイプライン入力
    SomeProgram.exe | JsonAnalyzer.exe -o result.txt -p
  複数ファイル指定で構造の省略部分を補完
    JsonAnalyzer.exe -o result.txt -f hoge.json fuga.json piyo.json


  Go言語の構造体の書式で出力する
    JsonAnalyzer.exe -lang go -o mystructure.go -f foobar.json
  Go言語の構造体の書式で出力する(Mixed系でゲッターメソッドを生成する)
    JsonAnalyzer.exe -a G -lang go -o mystructure.go -f foobar.json
  Go言語の構造体の書式で出力する(同型の構造体の重複を除去する)
    JsonAnalyzer.exe -a D -lang go -o mystructure.go -f foobar.json
  Go言語の構造体の書式で出力する(Mixed系でゲッターメソッドを生成する＆同型の構造体の重複を除去する)
    JsonAnalyzer.exe -a GD -lang go -o mystructure.go -f foobar.json


  ヘルプ表示
    JsonAnalyzer.exe --help
"


let (|FileFlag|_|) (f: string) : unit option =
    match f.ToLower() with
    | "-f" | "-file" | "-files" | "--file" | "--files"
    | "/f" | "/file" | "/files" -> Some ()
    | _ -> None


let (|StdinFlag|_|) (f: string) : unit option =
    match f.ToLower() with
    | "-i" | "-in" | "-stdin" | "--stdin"
    | "/i" | "/in" | "/stdin"
    | "-p" | "-pipe" | "--pipe"
    | "/p" | "/pipe" -> Some ()
    | _ -> None


let (|OutputFlag|_|) (f: string) : unit option =
    match f.ToLower() with
    | "-o" | "-out" | "-output" | "--output"
    | "/o" | "/out" | "/output" -> Some ()
    | _ -> None


let (|UsageFlag|_|) (f: string) : unit option =
    match f.ToLower() with
    | "-u" | "-usage" | "--usage"
    | "/u" | "/usage"
    | "-h" | "-help" | "--help"
    | "/h" | "/help" -> Some ()
    | _ -> None


let (|GeneratorFlag|_|) (f: string) : unit option =
    match f.ToLower() with
    | "-l" | "-lang" | "--language"
    | "/l" | "/lang"
    | "-g" | "-gen" | "--generate" | "--generator"
    | "/g" | "/gen" -> Some ()
    | _ -> None


let (|GeneratorArgFlag|_|) (f: string) : unit option =
    match f.ToLower() with
    | "-a" | "-arg" | "--argument"
    | "/a" | "/arg" -> Some ()
    | _ -> None


type Lang =
    | Go


let (|LangParam|_|) (f: string) : Lang option =
    match f.ToLower() with
    | "go" | "golang" | "go-lang" -> Some Go
    | _ -> None


type LangOption = (Lang * string) option


type InputSource =
    | Stdin
    | Files of string list


type Flag =
    | Input of InputSource * LangOption
    | WithOutput of InputSource * string * LangOption
    | Usage
    | Invalid of string list


let parseArgs args =
    let rec parse args =
        match args with
        | FileFlag :: ((_ :: _) as files) -> Input (Files files, None)
        | [StdinFlag] -> Input (Stdin, None)
        | []
        | [UsageFlag] -> Usage
        | OutputFlag :: dst :: rest ->
            match parse rest with
            | Input (src, opt) -> WithOutput (src, dst, opt)
            | flag -> flag
        | GeneratorFlag :: LangParam lang :: rest ->
            match parse rest with
            | Input (src, None) -> Input (src, Some (lang, ""))
            | WithOutput (src, dst, None) -> WithOutput (src, dst, Some (lang, ""))
            | flag -> flag
        | GeneratorArgFlag :: arg :: rest ->
            match parse rest with
            | Input (src, Some (lang, "")) -> Input (src, Some (lang, arg))
            | WithOutput (src, dst, Some (lang, "")) -> WithOutput (src, dst, Some (lang, arg))
            | flag -> flag
        | _ -> Invalid args
    parse (Array.toList args)

Generator.Go.fs

//
// JsonAnalyzer
//  - Generator.Go module
//
//  generate Go Structure from JSON
//
// Issues:
//      - 次のいずれもGoでコンパイルエラーになる
//          + フィールド名の重複が発生する
//          + 記号や数字のみのキー名が存在した場合に無名フィールドが発生する
//          + フィールドにタグ付けできないキー名が存在した場合に不正なタグが発生する
//      - キー名の前部が数字や記号で構成される場合にフィールド名が不明瞭になる
//      - キー名に記号が多く含まれる場合にフィールド名が不明瞭になる
//      - 自動生成される型の名前(Object*/Mixed*)は関連や対応が分かりづらい
//      - 自動生成される型で構造が同じ型が発生しても別々の名前で生成され無駄が多い
//
module Generator.Go


open JsonObject
open Utils


let trim (s: string) : string =
    s.ToCharArray()
    |> Array.toSeq
    |> Seq.skipWhile (fun c -> not <| System.Char.IsLetter(c))
    |> Seq.filter (fun c -> System.Char.IsLetter(c) || System.Char.IsDigit(c) || c = '_')
    |> Seq.mapi (fun i c -> if i = 0 then System.Char.ToUpper(c) else c)
    |> Seq.toArray
    |> fun cs -> new string(cs)


let objectId = ref 0


let genObjectName() =
    incr objectId
    sprintf "Object_%d_" !objectId


let mixedId = ref 0


let genMixedName() =
    incr mixedId
    sprintf "Mixed_%d_" !mixedId


let nameMap = ref Map.empty


let printObjectDefinition oname vs out =
    let (imax, tmax) =
        List.fold (fun (i, t) (tk, _, s, _) ->
            (max i (String.length tk), max t (String.length s))
        ) (0, 0) vs
    fprintf out "type %s struct {\n" oname
    List.iter (fun (tk, k, s, _) ->
        let bp = new string(' ', imax - String.length tk)
        let ap = new string(' ', tmax - String.length s)
        fprintf out "\t%s %s%s%s `json:%s`\n" tk bp s ap k
    ) vs
    fprintf out "}\n\n"


let printMixedDefinition mname vs genGetter out =
    fprintf out "type %s struct {\n" mname
    List.iter (fun (s, _) ->
        fprintf out "\t// %s\n" s
    ) vs
    fprintf out "\tValue interface{}\n"
    fprintf out "}\n\n"
    fprintf out "func (this *%s) UnmarshalJSON(b []byte) (err error) {\n" mname
    List.iter (fun (s, _) ->
        fprintf out "\t{\n"
        fprintf out "\t\tvar x %s\n" s
        fprintf out "\t\tif err = json.Unmarshal(b, &x); err == nil {\n"
        fprintf out "\t\t\tthis.Value = x\n"
        fprintf out "\t\t\treturn\n"
        fprintf out "\t\t}\n"
        fprintf out "\t}\n"
    ) vs
    fprintf out "\treturn\n"
    fprintf out "}\n"
    List.iter (fun (s, _) ->
        let suf = if String.exists ((=) '[') s then "s" else ""
        let ts = trim s + suf
        fprintf out "func (this *%s) Get%s() (ret %s, ok bool) {\n" mname ts s
        fprintf out "\tret, ok = this.Value.(%s)\n" s
        fprintf out "\treturn\n"
        fprintf out "}\n"
        fprintf out "func (this *%s) %sValue() %s {\n" mname ts s
        fprintf out "\treturn this.Value.(%s)\n" s
        fprintf out "}\n"
    ) (if genGetter then vs else [])
    fprintf out "\n"


// Topological sort
let toposo() =
    let fromCounts = ref Map.empty
    let toEdges = ref Map.empty
    let outputs = ref Map.empty
    let addNode name =
        fromCounts := Map.add name (ref 0) !fromCounts
        toEdges := Map.add name (ref []) !toEdges
    let addEdge toNode fromNode =
        let fromNode = trim fromNode
        Map.tryFind fromNode !toEdges
        |> Option.iter (fun edges ->
            let toNode = trim toNode
            Map.tryFind toNode !fromCounts
            |> Option.iter (fun c ->
                incr c
                edges := toNode :: !edges
            )
        )
    let addOutput name f = outputs := Map.add name f !outputs
    let output out =
        let rec runOutput =
            function
            | [] -> ()
            | (name, _) :: rest ->
                Map.tryFind name !outputs
                |> Option.iter ((|>) out)
                Map.tryFind name !toEdges
                |> Option.getWithDefault (ref [])
                |> (!)
                |> List.toSeq
                |> Seq.map (fun n -> (n, Map.tryFind n !fromCounts))
                |> Seq.filter (Option.isSome << snd)
                |> Seq.map (fun (n, oc) ->
                    let c = Option.get oc
                    decr c
                    (n, c)
                )
                |> Seq.filter (fun (_, c) -> !c = 0)
                |> Seq.toList
                |> (@) rest
                |> runOutput
        let ls =
            Map.toSeq !fromCounts
            |> Seq.filter (fun (_, c) -> !c = 0)
            |> Seq.toList
        runOutput ls
    (addNode, addEdge, addOutput, output)


let printGoStructure arg out json =
    let genGetter = String.exists (fun c -> System.Char.ToLower(c) = 'g') arg
    let dedup = String.exists (fun c -> System.Char.ToLower(c) = 'd') arg
    let (addNode, addEdge, addOutput, output) = toposo()
    let rec expand json =
        match json with
        | Number -> ("float64", None)
        | String -> ("string", None)
        | Boolean -> ("bool", None)
        | Array sub1 ->
            let (s, x) = expand sub1
            ("[]" + s, x)
        | Object _ ->
            if dedup
            then let key = ident json
                 match Map.tryFind key !nameMap with
                 | Some oname -> ("*" + oname, None)
                 | None ->
                     let oname = genObjectName()
                     nameMap := Map.add key oname !nameMap
                     addNode oname
                     ("*" + oname, Some (oname, json))
            else let oname = genObjectName()
                 addNode oname
                 ("*" + oname, Some (oname, json))
        | Mixed _ ->
            if dedup
            then let key = ident json
                 match Map.tryFind key !nameMap with
                 | Some mname -> ("*" + mname, None)
                 | None ->
                     let mname = genMixedName()
                     nameMap := Map.add key mname !nameMap
                     addNode mname
                     ("*"+ mname, Some (mname, json))
            else let mname = genMixedName()
                 addNode mname
                 ("*" + mname, Some (mname, json))
        | Null | Any -> ("interface{}", None)
    let rec loop jsons =
        match jsons with
        | [] -> ()
        | Some (oname, Object map1) :: rest ->
            let vs =
                Map.toSeq map1
                |> Seq.map (fun (k, v) ->
                    let tk = trim k
                    let (s, rem) = expand v
                    addEdge oname s
                    (tk, k, s, rem)
                )
                |> Seq.toList
            addOutput oname (printObjectDefinition oname vs)
            loop <| List.fold (fun ls (_, _, _, rem) -> rem :: ls) rest vs
        | Some (mname, Mixed list1) :: rest ->
            let vs = List.map expand list1
            List.iter (addEdge mname << fst) vs
            addOutput mname (printMixedDefinition mname vs genGetter)
            loop <| List.fold (fun ls (_, rem) -> rem :: ls) rest vs
        | _ :: rest -> loop rest
    let name = genObjectName()
    let (s, rem) = expand json
    loop [rem]
    output out
    fprintf out "type %s %s\n\n" name s

JsonAnalyzer.fs

//
// JSON の 構成を調べるだけ  (車輪の再発明)
//
// 標準入力もしくは指定ファイル名からJSONファイルを読み込み、
// 解析結果を標準出力へ書き出す
//
// コンパイル:
//  fsc Utils.fs JsonObject.fs ParserUtils.fs Parser.fs Flag.fs Generator.Go.fs JsonAnalyzer.fs
//
// 実行:
//
//  ファイル指定 -> 標準出力
//  JsonAnalyzer.exe -f hoge.json
//
//  ファイル指定 -> ファイル(リダイレクト)
//  JsonAnalyzer.exe -f hoge.json > result.txt
//
//  ファイル指定 -> ファイル
//  JsonAnalyzer.exe -o result.txt -f hoge.json
//
//
//  標準入力(リダイレクト) -> 標準出力
//  JsonAnalyzer.exe -i < hoge.json
//
//  標準入力(リダイレクト) -> ファイル(リダイレクト)
//  JsonAnalyzer.exe -i < hoge.json > result.txt
//
//  標準入力(リダイレクト) -> ファイル
//  JsonAnalyzer.exe -o result.txt -i < hoge.json
//
//
//  標準入力(パイプ) -> 標準出力
//  SomeProgram.exe | JsonAnalyzer.exe -p
//
//  標準入力(パイプ) -> ファイル(リダイレクト)
//  SomeProgram.exe | JsonAnalyzer.exe -p > result.txt
//
//  標準入力(パイプ) -> ファイル
//  SomeProgram.exe | JsonAnalyzer.exe -o result.txt -p
//
//
//  複数ファイル指定で構造の省略部分を補完する (-> 標準出力)
//  JsonAnalyzer.exe -f hoge.json fuga.json piyo.json
//      例
//          hoge.json -> {"name": "x", "age": 12}
//          fuga.json -> {"name": "y", "sex": "male"}
//          piyo.json -> {"name": "z", "age": 34, "location": "japan"}
//          結果 -> Object { "name": String, "age": Number, "sex": String, "location": String }
//
//  複数ファイル指定で構造の省略部分を補完する (-> ファイル(リダイレクト))
//  JsonAnalyzer.exe -f hoge.json fuga.json piyo.json > result.txt
//
//  複数ファイル指定で構造の省略部分を補完する (-> ファイル)
//  JsonAnalyzer.exe -o result.txt -f hoge.json fuga.json piyo.json
//
//
//  ファイル指定 -> ファイル (Go言語の構造体の書式で出力する)
//  JsonAnalyzer.exe -lang go -o mystructure.go -f hoge.json
//
//  ファイル指定 -> ファイル (Go言語の構造体の書式で出力する(Mixed系でゲッターメソッドを生成する))
//  JsonAnalyzer.exe -a G -lang go -o mystructure.go -f hoge.json
//  ファイル指定 -> ファイル (Go言語の構造体の書式で出力する(同型の構造体の重複を除去する)
//  JsonAnalyzer.exe -a D -lang go -o mystructure.go -f hoge.json
//  ファイル指定 -> ファイル (Go言語の構造体の書式で出力する(Mixed系でゲッターメソッドを生成する＆同型の構造体の重複を除去する))
//  JsonAnalyzer.exe -a GD -lang go -o mystructure.go -f hoge.json
//
//
module JsonAnalyzer


open Flag
open Parser


let run callback file =
    let buf =
        match file with
        | Some file -> System.IO.File.ReadAllText(file)
        | None      -> stdin.ReadToEnd()
    let src = Source.init buf
    match parse callback src with
    | None ->
        eprintfn "success:"
        0
    | Some src ->
        eprintfn "failure: format error (pos: %d)" (Source.getPos src)
        1


let runFiles callback files =
    let jsons = ref [||]
    let update i newJson =
        if i < Array.length !jsons
        then let oldJson = Array.get !jsons i
             Array.set !jsons i (JsonObject.mergeValue oldJson newJson)
        else jsons := Array.append !jsons [|newJson|]
    let folder acc file =
        eprintfn "analyze %A ..." file
        if System.IO.File.Exists(file)
        then let i = ref 0
             let f json =
                 update !i json
                 incr i
             run f (Some file) + acc
        else eprintfn "no such file： %A" file
             1 + acc
    let ret = List.fold folder 0 files
    Array.iter callback !jsons
    if ret = 0
    then eprintfn "success: all files"
    else eprintfn "failure: %d files" ret
    ret


let output opt =
    match opt with
    | Some (Go, arg) -> Generator.Go.printGoStructure arg
    | None -> JsonObject.printJsonObject


[<EntryPoint>]
let main args =
    try
        match parseArgs args with
        | Input (Stdin, opt) ->
            run (output opt stdout) None
        | Input (Files files, opt) ->
            runFiles (output opt stdout) files
        | WithOutput (Stdin, dstfile, opt) ->
            use dst = System.IO.File.CreateText(dstfile)
            run (output opt dst) None
        | WithOutput (Files files, dstfile, opt) ->
            use dst = System.IO.File.CreateText(dstfile)
            runFiles (output opt dst) files
        | Usage ->
            showUsage()
            0
        | Invalid args ->
            eprintfn "ERROR: invalid flag: %A" args
            showUsage()
            1
    with
        err ->
            eprintfn "ERROR: %A" err
            1

JsonObject.fs

//
// JsonAnalyzer
//   - JsonObject module
//
//  define JSON Structure
//
module JsonObject


open Utils


type Key = string


type JsonObject =
    | Any
    | Array of JsonObject
    | Boolean
    | Mixed of JsonObject list
    | Null
    | Number
    | Object of Map<Key, JsonObject>
    | String


let rec mergeValue value1 value2 =
    match (value1, value2) with
    | (Number, Number)
    | (String, String)
    | (Boolean, Boolean)
    | (_, Any) -> value1
    | (Any, _) -> value2
    | (_, Null) -> value1
    | (Null, _) -> value2
    | (Array sub1, Array sub2) -> Array (mergeValue sub1 sub2)
    | (Object map1, Object map2) -> Object (Map.merge mergeValue map1 map2)
    | (Mixed list1, Mixed list2) -> Mixed (List.fold mix list1 list2)
    | (Mixed list1, _) -> Mixed (mix list1 value2)
    | (_, Mixed list2) -> Mixed (mix list2 value1)
    | _ -> Mixed (mix [value1] value2)
and mix mlist value =
    match (mlist, value) with
    | ([], _) -> [value]
    | (Number::_, Number)
    | (String::_, String)
    | (Boolean::_, Boolean) -> mlist
    | (Array sub1::tail, Array sub2) -> Array (mergeValue sub1 sub2) :: tail
    | (Object map1::tail, Object map2) -> Object (Map.merge mergeValue map1 map2) :: tail
    | (head::tail, _) -> head :: mix tail value


let printJsonObject out json =
    let rec printJsonObject nest json =
        match json with
        | Array sub ->
            fprintf out "Array "
            printJsonObject nest sub
        | Object map ->
            let indent = String.init nest (fun _ -> "    ")
            fprintfn out "Object {"
            Map.iter (fun k v ->
                fprintf out "%s%s: " indent k
                printJsonObject (nest + 1) v
            ) map
            fprintfn out "%s}" indent
        | Mixed ls ->
            let indent = String.init nest (fun _ -> "    ")
            fprintfn out "Mixed ("
            List.iter (fun v ->
                fprintf out "%s| " indent
                printJsonObject (nest + 1) v
            ) ls
            fprintfn out "%s)" indent
        | _ ->
            fprintfn out "%A" json
    printJsonObject 0 json



let rec ident =
    function
    | Number -> "N"
    | String -> "S"
    | Boolean -> "B"
    | Null | Any -> "A"
    | Array sub1 -> "[" + ident sub1
    | Object map1 ->
        Map.toSeq map1
        |> Seq.map (fun (k, v) -> k + ":" + ident v)
        |> String.concat ","
        |> fun s -> "{" + s + "}"
    | Mixed list1 ->
        List.map ident list1
        |> List.sort
        |> String.concat "|"
        |> fun s -> "(" + s + ")"

Parser.fs

//
// JsonAnalyzer
//  - Parser module
//
//  parse JSON
//
module Parser


open JsonObject
open ParserUtils
open Utils


type source = Source of string * int


module Source =

    let init s = Source (s, 0)

    let skipWthieSpaces (Source (src, i)) =
        Source (src, restIndex isWhiteSpace src i)

    let takeToken getIndex (Source (src, i)) =
        let rest = min (String.length src) (getIndex src i)
        let token = src.Substring(i, rest - i)
        (token,  Source (src, rest))

    let isEOF (Source (src, i)) = i >= String.length src

    let getPos (Source (_, i)) = i


type Token =
    | BeginOfArray
    | BeginOfObject
    | Colon
    | Comma
    | EndOfArray
    | EndOfObject
    | ObjectKey of Key


let parseToken getIndex validate make src =
    let (token,  src) = Source.takeToken getIndex <| Source.skipWthieSpaces src
    if validate token
    then Some (make token, src)
    else None


let parseNumberToken =
    parseToken
        (restIndex (fun ch -> isDigit ch || String.exists ((=) ch) "-+.Ee"))
        isValidNumber
        (fun _ -> Number)


let parseBooleanToken =
    parseToken
        (restIndex isLetter)
        (fun s -> s = "true" || s = "false")
        (fun _ -> Boolean)


let parseNullToken =
    parseToken
        (restIndex isLetter)
        ((=) "null")
        (fun _ -> Null)


let parseStringToken =
    parseToken
        restStringIndex
        isValidString
        (fun _ -> String)


let parseBeginOfArrayToken =
    parseToken
        (fun _ i -> i + 1)
        ((=) "[")
        (fun _ -> BeginOfArray)


let parseBeginOfObjectToken =
    parseToken
        (fun _ i -> i + 1)
        ((=) "{")
        (fun _ -> BeginOfObject)


let parseObjectKeyToken =
    parseToken
        restStringIndex
        isValidString
        (fun s -> ObjectKey s)


let parseCommaToken =
    parseToken
        (fun _ i -> i + 1)
        ((=) ",")
        (fun _ -> Comma)


let parseColonToken =
    parseToken
        (fun _ i -> i + 1)
        ((=) ":")
        (fun _ -> Colon)


let parseEndOfArrayToken =
    parseToken
        (fun _ i -> i + 1)
        ((=) "]")
        (fun _ -> EndOfArray)


let parseEndOfObjectToken =
    parseToken
        (fun _ i -> i + 1)
        ((=) "}")
        (fun _ -> EndOfObject)


let inline combineParsers parsers src =
    let src = Source.skipWthieSpaces src
    List.tryPick ((|>) src) parsers


let parseArrayEnd =
    combineParsers
        [ parseCommaToken
        ; parseEndOfArrayToken
        ]


let rec parseArrayValue parseValue value1 src =
    match parseValue src with
    | None -> None
    | Some (value2, src) ->
        let value = mergeValue value1 value2
        match parseArrayEnd src with
        | Some (EndOfArray, src) -> Some (Array value, src)
        | Some (Comma, src) -> parseArrayValue parseValue value src
        | _ -> None


let parseArray parseValue src =
    match parseBeginOfArrayToken src with
    | Some (BeginOfArray, src) ->
        match parseEndOfArrayToken src with
        | Some (EndOfArray, src) -> Some (Array Any, src)
        | _ -> parseArrayValue parseValue Any src
    | _ -> None


let parseObjectEnd =
    combineParsers
        [ parseCommaToken
        ; parseEndOfObjectToken
        ]


let rec parseObjectEntry parseValue map src =
    match parseObjectKeyToken src with
    | Some (ObjectKey key, src) ->
        match parseColonToken src with
        | Some (Colon, src) ->
            match parseValue src with
            | None -> None
            | Some (value, src) ->
                let map = Map.insertWith mergeValue key value map
                match parseObjectEnd src with
                | Some (EndOfObject, src) -> Some (Object map, src)
                | Some (Comma, src) -> parseObjectEntry parseValue map src
                | _ -> None
        | _ -> None
    | _ -> None


let parseObject parseValue src =
    match parseBeginOfObjectToken src with
    | Some (BeginOfObject, src) ->
        match parseEndOfObjectToken src with
        | Some (EndOfObject, src) -> Some (Object Map.empty, src)
        | _ -> parseObjectEntry parseValue Map.empty src
    | _ -> None


let rec parseValueToken src =
    combineParsers
        [ parseNumberToken
        ; parseBooleanToken
        ; parseNullToken
        ; parseStringToken
        ; parseArray parseValueToken
        ; parseObject parseValueToken
        ]
        src


let rec parse callback src =
    let src = Source.skipWthieSpaces src
    match parseValueToken src with
    | Some (json, src) ->
        callback json
        parse callback src
    | None ->
        if Source.isEOF src
        then None
        else Some src

ParserUtils.fs

//
// JsonAnalyzer
//  - ParserUtils module
//
//  Utilities for Parse module
//
module ParserUtils


open Utils


let inline isDigit ch = System.Char.IsDigit(ch)


let inline isLetter ch = System.Char.IsLetter(ch)


let inline isWhiteSpace ch = System.Char.IsWhiteSpace(ch)


let isValidNumber s =
    let _v = 0.0
    System.Double.TryParse(s, ref _v)


let isValidString s =
    let len = String.length s
    len > 1 && s.[0] = '"' && s.[len-1] = '"'


let rec restIndex validate (s: string) i =
    if i < String.length s && validate s.[i]
    then restIndex validate s (i + 1)
    else i


let rec findRestStringIndex (s: string) i =
    if i >= String.length s
    then None
    else match s.[i] with
         | '"'  -> Some (i + 1)
         | '\\' -> findRestStringIndex s (i + 2)
         | _    -> findRestStringIndex s (i + 1)


let restStringIndex (s: string) i =
    if i >= String.length s || s.[i] <> '"'
    then i
    else Option.getWithDefault i <| findRestStringIndex s (i + 1)

Utils.fs

//
// JsonAnalyzer
//  - Utils module
//
//  Utilities
//
module Utils


module Map =

    let insertWith apply key value map =
        Map.add key (
            match Map.tryFind key map with
            | Some other -> apply other value
            | None -> value
        ) map

    let merge apply map1 map2 =
        Seq.foldBack ((<||) (insertWith apply)) (Map.toSeq map1) map2


module Option =

    let inline getWithDefault def opt = defaultArg opt def