8 people like it.

JSON Parser

JSON Parser using Regular Expressions & Active Patterns (just for fun).

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84: 

type token =
    | WhiteSpace
    | Symbol of char
    | StrToken of string
    | NumToken of float
    | BoolToken of bool

let (|Match|_|) pattern input =
    let m = System.Text.RegularExpressions.Regex.Match(input, pattern)
    if m.Success then Some m.Value else None

let bool = System.Boolean.Parse
let unquote (s:string) = s.Substring(1,s.Length-2)

let toToken = function
    | Match @"^\s+" s -> s, WhiteSpace
    | Match @"^""[^""\\]*(?:\\.[^""\\]*)*""" s -> s, s |> unquote |> StrToken
    | Match @"^\{|^\}|^\[|^\]|^:|^," s -> s, s.[0] |> Symbol
    | Match @"^\d+(\.\d+)?|\.\d+" s -> s, s |> float |> NumToken
    | Match @"^true|false" s -> s, s |> bool |> BoolToken
    | _ -> invalidOp "Unknown token"

let tokenize s =
    let rec tokenize' index (s:string) =
        if index = s.Length 
        then [] 
        else
            let next = s.Substring index 
            let text, token = toToken next
            token :: tokenize' (index + text.Length) s
    tokenize' 0 s
    |> List.choose (function WhiteSpace -> None | t -> Some t)

type json =
    | Number of float
    | String of string
    | Boolean of bool
    | Array of json list
    | Object of (string * json) list
    | Null

let rec (|ValueRec|_|) = function
    | NumToken n::t -> Some(Number n, t)
    | BoolToken b::t -> Some(Boolean b, t)
    | StrToken s::t -> Some(String s, t)
    | Symbol '['::ValuesRec(vs, Symbol ']'::t) -> Some(Array(vs),t)
    | Symbol '{'::PairsRec(ps, Symbol '}'::t) -> Some(Object(ps),t)
    | [] -> Some(Null,[])
    | _ -> None
and (|ValuesRec|_|) = function
    | ValueRec(p,t) ->
        let rec aux p' = function
            | Symbol ','::ValueRec(p,t) -> aux (p'@[p]) t
            | t -> p',t
        Some(aux [p] t)
    | _ -> None
and (|PairsRec|_|) = function
    | PairRec(p,t) ->
        let rec aux p' = function
            | Symbol ','::PairRec(p,t) -> aux (p'@[p]) t
            | t -> p',t
        Some(aux [p] t)
    | _ -> None
and (|PairRec|_|) = function
    | StrToken s::Symbol ':'::ValueRec(v,t) -> Some((s,v), t)
    | _ -> None

let parse s = 
    tokenize s |> function 
    | ValueRec(f,[]) -> f 
    | x -> failwith "Failed to parse JSON"

module Test =

    let jsonString = "{
        \"Name\": \"Phil\",
        \"Phone\": 123456789
        }"
    let person = parse jsonString
    let name, phone =
        match person with
        | Object(["Name", String(name); "Phone",Number(phone)]) ->
            name, phone
        | _ -> invalidOp "Invalid person"
union case token.WhiteSpace: token
union case token.Symbol: char -> token
Multiple items
val char : value:'T -> char (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.char

--------------------
type char = System.Char

Full name: Microsoft.FSharp.Core.char
union case token.StrToken: string -> token
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
union case token.NumToken: float -> token
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = System.Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
union case token.BoolToken: bool -> token
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
val pattern : string
val input : string
val m : System.Text.RegularExpressions.Match
namespace System
namespace System.Text
namespace System.Text.RegularExpressions
Multiple items
type Regex =
  new : pattern:string -> Regex + 1 overload
  member GetGroupNames : unit -> string[]
  member GetGroupNumbers : unit -> int[]
  member GroupNameFromNumber : i:int -> string
  member GroupNumberFromName : name:string -> int
  member IsMatch : input:string -> bool + 1 overload
  member Match : input:string -> Match + 2 overloads
  member Matches : input:string -> MatchCollection + 1 overload
  member Options : RegexOptions
  member Replace : input:string * replacement:string -> string + 5 overloads
  ...

Full name: System.Text.RegularExpressions.Regex

--------------------
System.Text.RegularExpressions.Regex(pattern: string) : unit
System.Text.RegularExpressions.Regex(pattern: string, options: System.Text.RegularExpressions.RegexOptions) : unit
System.Text.RegularExpressions.Regex.Match(input: string, pattern: string) : System.Text.RegularExpressions.Match
System.Text.RegularExpressions.Regex.Match(input: string, pattern: string, options: System.Text.RegularExpressions.RegexOptions) : System.Text.RegularExpressions.Match
property System.Text.RegularExpressions.Group.Success: bool
union case Option.Some: Value: 'T -> Option<'T>
property System.Text.RegularExpressions.Capture.Value: string
union case Option.None: Option<'T>
Multiple items
val bool : arg00:string -> bool

Full name: Script.bool

--------------------
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
type Boolean =
  struct
    member CompareTo : obj:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 1 overload
    static val TrueString : string
    static val FalseString : string
    static member Parse : value:string -> bool
    static member TryParse : value:string * result:bool -> bool
  end

Full name: System.Boolean
System.Boolean.Parse(value: string) : bool
val unquote : s:string -> string

Full name: Script.unquote
val s : string
System.String.Substring(startIndex: int) : string
System.String.Substring(startIndex: int, length: int) : string
property System.String.Length: int
val toToken : _arg1:string -> string * token

Full name: Script.toToken
active recognizer Match: string -> string -> string option

Full name: Script.( |Match|_| )
val invalidOp : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.invalidOp
val tokenize : s:string -> token list

Full name: Script.tokenize
val tokenize' : (int -> string -> token list)
val index : int
val next : string
val text : string
Multiple items
val token : token

--------------------
type token =
  | WhiteSpace
  | Symbol of char
  | StrToken of string
  | NumToken of float
  | BoolToken of bool

Full name: Script.token
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val choose : chooser:('T -> 'U option) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.choose
val t : token
type json =
  | Number of float
  | String of string
  | Boolean of bool
  | Array of json list
  | Object of (string * json) list
  | Null

Full name: Script.json
union case json.Number: float -> json
Multiple items
union case json.String: string -> json

--------------------
module String

from Microsoft.FSharp.Core
union case json.Boolean: bool -> json
Multiple items
union case json.Array: json list -> json

--------------------
module Array

from Microsoft.FSharp.Collections
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
union case json.Object: (string * json) list -> json
union case json.Null: json
val n : float
val t : token list
val b : bool
active recognizer ValuesRec: token list -> (json list * token list) option

Full name: Script.( |ValuesRec|_| )
val vs : json list
active recognizer PairsRec: token list -> ((string * json) list * token list) option

Full name: Script.( |PairsRec|_| )
val ps : (string * json) list
active recognizer ValueRec: token list -> (json * token list) option

Full name: Script.( |ValueRec|_| )
val p : json
val aux : (json list -> token list -> json list * token list)
val p' : json list
active recognizer PairRec: token list -> ((string * json) * token list) option

Full name: Script.( |PairRec|_| )
val p : string * json
val aux : ((string * json) list -> token list -> (string * json) list * token list)
val p' : (string * json) list
val v : json
val parse : s:string -> json

Full name: Script.parse
val f : json
val x : token list
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
module Test

from Script
val jsonString : string

Full name: Script.Test.jsonString
val person : json

Full name: Script.Test.person
val name : string

Full name: Script.Test.name
val phone : float

Full name: Script.Test.phone
val name : string
val phone : float
Next Version Raw view Test code New version

More information

Link:http://fssnip.net/8y
Posted:13 years ago
Author:Phillip Trelford
Tags: json , serialization

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.