Using Active Patterns to make JSON DOM traversal more declarative

01_JsonElements.fs

open System.Text.Json

[<RequireQualifiedAccess>]
module Json =
  [<return: Struct>]
  let inline private (|OfKind|_|) kind (json : JsonElement) =
    if json.ValueKind = kind then ValueSome json else ValueNone

  let (|Null|_|) json =
    match json with
    | OfKind JsonValueKind.Null _ -> true
    | _ -> false

  let (|Undefined|_|) json =
    match json with
    | OfKind JsonValueKind.Undefined _ -> true
    | _ -> false

  [<return: Struct>]
  let (|True|_|) json =
    match json with
    | OfKind JsonValueKind.True _ -> ValueSome true
    | _ -> ValueNone

  [<return: Struct>]
  let (|False|_|) json =
    match json with
    | OfKind JsonValueKind.False _ -> ValueSome false
    | _ -> ValueNone

  [<return: Struct>]
  let (|Boolean|_|) json =
    match json with
    | OfKind JsonValueKind.True _ -> ValueSome true
    | OfKind JsonValueKind.False _ -> ValueSome false
    | _ -> ValueNone

  [<return: Struct>]
  let (|Decimal|_|) json : decimal voption =
    let mutable value = 0M
    match json with
    | OfKind JsonValueKind.Number json when json.TryGetDecimal(&value) -> ValueSome value
    | _ -> ValueNone

  [<return: Struct>]
  let (|Double|_|) json : float voption =
    let mutable value = 0.
    match json with
    | OfKind JsonValueKind.Number json when json.TryGetDouble(&value) -> ValueSome value
    | _ -> ValueNone

  [<return: Struct>]
  let (|Int32|_|) json : int voption =
    let mutable value = 0
    match json with
    | OfKind JsonValueKind.Number json when json.TryGetInt32(&value) -> ValueSome value
    | _ -> ValueNone

  [<return: Struct>]
  let inline (|Number|_|) json : 'T voption =
    let target = typeof<'T>
    let inline hack value = value |> box |> unbox<'T>

    if target = typeof<decimal> then json |> (|Decimal|_|) |> ValueOption.map hack
    elif target = typeof<float> then json |> (|Double|_|) |> ValueOption.map hack
    elif target = typeof<int32> then json |> (|Int32|_|) |> ValueOption.map hack
    else ValueNone

  [<return: Struct>]
  let (|String|_|) json =
    match json with
    | OfKind JsonValueKind.String json -> ValueSome(json.GetString())
    | _ -> ValueNone

  [<return: Struct>]
  let (|Array|_|) json =
    match json with
    | OfKind JsonValueKind.Array json -> ValueSome [| for json in json.EnumerateArray() -> json |]
    | _ -> ValueNone

  [<return: Struct>]
  let (|Object|_|) json =
    match json with
    | OfKind JsonValueKind.Object json -> ValueSome [| for prop in json.EnumerateObject() -> (prop.Name, prop.Value) |]
    | _ -> ValueNone

  [<return: Struct>]
  let (|Property|_|) (name : string) json =
    match json with
    | OfKind JsonValueKind.Object json ->
      let found, prop = json.TryGetProperty(name)
      if found then ValueSome prop else ValueNone
    | _ -> ValueNone

02_ExampleElements.fs

open System.Text.Json

let daBlob =
  """{"name":{"surname":"Blasucci","givenName":"Paul"},"married": true,"children":2,"languages":["en-US","nl-NL","es-ES"],"pets":[]}"""
  
let greet =
  function
  | Json.Null
  | Json.Undefined -> "Howdy, stranger?"

  | Json.Property "name" (Json.Object [| ("surname", Json.String surname); ("givenName", Json.String givenName) |]) ->
    $"Hello, %s{givenName} %s{surname}."

  | json -> failwith $"wtf, mate?! (%A{json})"

let demo =
  function
  | Json.Null
  | Json.Undefined -> "Demographics unavailable"

  | Json.Property "married" (Json.Boolean married) & Json.Property "children" (Json.Int32 kids) ->
    let status = if not married then "not married" else "married"
    $"You are %s{status}, with %i{kids} children."

  | json -> failwith $"wtf, mate?! (%A{json})"

let json = JsonDocument.Parse(daBlob)
json.RootElement |> greet |> printfn "%s"
json.RootElement |> demo |> printfn "%s"

03_JsonNodes.fs

type jsonNull = JsonNode | null

[<RequireQualifiedAccess>]
module Json =
  let inline ofValue (value : 'T) = JsonValue.Create<'T>(value) :> jsonNull

  let (|Null|_|) (json : jsonNull) : bool =
    match json with
    | null -> true
    // NOTE: not sure one can *ever* reach this path
    | json when json.GetValueKind() = JsonValueKind.Null -> true
    | _ -> false

  // TODO: when / how is it possible to get a JsonNode with 'Undefined'?!
  let (|Undefined|_|) (json : jsonNull) =
    match json with
    | NonNull(json) when json.GetValueKind() = JsonValueKind.Undefined -> true
    | _ -> false

  [<return: Struct>]
  let private (|Value|_|) kind (json : jsonNull) : 'T voption =
    match json with
    | NonNull(:? JsonValue as json) when json.GetValueKind() = kind ->
      let okay, value = json.TryGetValue<'T>()
      if okay then ValueSome value else ValueNone
    | _ -> ValueNone

  [<return: Struct>]
  let (|String|_|) json : string voption = (|Value|_|) JsonValueKind.String json

  [<return: Struct>]
  let (|Number|_|) json : 'T voption = (|Value|_|) JsonValueKind.Number json

  [<return: Struct>]
  let (|Int32|_|) json : int voption = (|Number|_|) json

  [<return: Struct>]
  let (|Double|_|) json : float voption = (|Number|_|) json

  [<return: Struct>]
  let (|Decimal|_|) json : decimal voption = (|Number|_|) json

  [<return: Struct>]
  let (|True|_|) json : bool voption = (|Value|_|) JsonValueKind.True json

  [<return: Struct>]
  let (|False|_|) json : bool voption = (|Value|_|) JsonValueKind.False json

  [<return: Struct>]
  let (|Boolean|_|) (json : jsonNull) : bool voption =
    match json with
    | NonNull(:? JsonValue as json) when json.GetValueKind() = JsonValueKind.True -> ValueSome true
    | NonNull(:? JsonValue as json) when json.GetValueKind() = JsonValueKind.False -> ValueSome false
    | _ -> ValueNone

  [<return: Struct>]
  let (|Array|_|) (json : jsonNull) : (jsonNull array) voption =
    match json with
    | NonNull(:? JsonArray as json) -> ValueSome [| for node in json -> node |]
    | _ -> ValueNone

  [<return: Struct>]
  let (|Object|_|) (json : jsonNull) : ((string * jsonNull) array) voption =
    match json with
    | NonNull(:? JsonObject as json) -> ValueSome [| for KeyValue(key, value) in json -> (key, value) |]
    | _ -> ValueNone

  [<return: Struct>]
  let (|Property|_|) (name : string) (json : jsonNull) : jsonNull voption =
    let mutable value : jsonNull = null
    match json with
    | NonNull(:? JsonObject as json) when json.TryGetPropertyValue(name, &value) -> ValueSome value
    | _ -> ValueNone

04_ExampleNodes.fs

open System.Text.Json.Nodes

let daBlob =
  """{"name":{"surname":"Blasucci","givenName":"Paul"},"married": true,"children":2,"languages":["en-US","nl-NL","es-ES"],"pets":[]}"""

let greet =
  function
  | Json.Null
  | Json.Undefined -> "Howdy, stranger?"

  | Json.Property "name" (Json.Object [| ("surname", Json.String surname); ("givenName", Json.String givenName) |]) ->
    $"Hello, %s{givenName} %s{surname}."

  | json -> failwith $"wtf, mate?! (%A{json})"

let demo =
  function
  | Json.Null
  | Json.Undefined -> "Demographics unavailable"

  | Json.Property "married" (Json.Boolean married) & Json.Property "children" (Json.Int32 kids) ->
    let status = if not married then "not married" else "married"
    $"You are %s{status}, with %i{kids} children."

  | json -> failwith $"wtf, mate?! (%A{json})"

let json = JsonNode.Parse(daBlob)
json |> greet |> printfn "%s"
json |> demo |> printfn "%s"

This was a small experiment in trying to make DOM traversal more declarative. It never received serious scrutiny, and may not be suitable in performance-sensitive areas.

The API is identical for consumers. The difference between working with JsonElement or JsonNode is: the latter supports more efficient mutation (i.e. if you need to emit new JSON after traversal); meanwhile, the former provides a smaller footprint (in terms of memory).