Simple JSON parser written in F# using active patterns

JsonParser.fs

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

type Bracket = Open | Close

type Token =
  | LITERAL of Json
  | ARRAY of Bracket
  | OBJECT of Bracket

let (|C|_|) (s: string, i) =
  if i < s.Length then Some(s.[i], (s, i+1)) else None

let numeric = set['0'..'9'] + set['+'; '-'; '.'; 'e'; 'E']
let whitespace = set[','; ':'; '\u0009'; '\u000a'; '\u000d'; '\u0020']

let (|Contains|_|) alphabet = function
  | C(c, it) when Set.contains c alphabet -> Some it
  | _ -> None

let rec (|Star|) (|Patt|_|) = function
  | Patt(x, Star (|Patt|_|) (xs, it)) -> x::xs, it
  | it -> [], it

let rec (|LexNumber|_|) = function
  | Contains numeric (LexNumber it | it) -> Some it
  | _ -> None

let rec (|LexString|) = function
  | C('"', it)
  | C('\\', C(('"' | '\\' | '/' | 'b' | 'n' | 'r' | 't'), LexString it))
  | C('\\', C('u', C(_, C(_, C(_, C(_, LexString it))))))
  | C(_, LexString it)
  | it -> it

let rec (|Lex|_|) = function
  | Contains whitespace it -> (|Lex|_|) it
  | C('n', C('u', C('l', C('l', it)))) -> Some(LITERAL Null, it)
  | C('t', C('r', C('u', C('e', it)))) -> Some(LITERAL(Bool true), it)
  | C('f', C('a', C('l', C('s', C('e', it))))) -> Some(LITERAL(Bool false), it)
  | LexNumber((s, last) as it) & (_, first) ->
      Some(LITERAL(Number(float s.[first..last-1])), it)
  | C('"', (LexString(it & (s, last)) & (_, first))) ->
      let s = System.Text.RegularExpressions.Regex.Unescape s.[first..last-2]
      Some(LITERAL(String s), it)
  | C('[', it) -> Some(ARRAY Open, it)
  | C(']', it) -> Some(ARRAY Close, it)
  | C('{', it) -> Some(OBJECT Open, it)
  | C('}', it) -> Some(OBJECT Close, it)
  | _ -> None

let rec (|ParseJSON|_|) = function
  | Lex(LITERAL json, it) -> Some(json, it)
  | Lex(ARRAY Open, Star (|ParseJSON|_|) (jsons, Lex(ARRAY Close, it))) ->
      Some(Array jsons, it)
  | Lex(OBJECT Open, Star (|ParseMember|_|) (members, Lex(OBJECT Close, it))) ->
      Some(Object members, it)
  | _ -> None
and (|ParseMember|_|) = function
  | Lex(LITERAL(String key), ParseJSON(value, it)) -> Some((key, value), it)
  | _ -> None

let parse s = (|ParseJSON|_|) (s, 0) |> Option.map fst

There was a thread on Twitter where many software developers were extolling the virtues of XML and shunning JSON because of its prohibitive complexity. https://twitter.com/kellabyte/status/1090001423448698880

So I thought I'd try to write a simple standards-compliant JSON parser and ended up with this ~60 line program. I've tested it on some torture tests out there and it passed everything. It will accept some inputs that are not valid JSON (e.g. it treats all separators as whitespace) but the standard does not require rejection of invalid data.

LexString fails with StackOverflow on long strings. A possible fix:

    let (|LexString|_|) (s: string, i) =
        seq { i .. s.Length - 1 }
        |> Seq.tryFind (fun j -> s.[j] = '"' && s.[j-1] <> '\\')
        |> Option.map (fun j -> s, j+1)

Using multi-case active patterns as much as possible would be an interesting exploration. See
https://github.com/daveyostcom/RomanNumerals/blob/master/Roman/RomanNumerals4.fs