F# Dynamic JSON #2

dynamic_json.fs

// Copyright 2015 Mårten Rånge
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//   http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
module FsDynamicJson =

  open System.Collections.Generic

  open Newtonsoft.Json
  open Newtonsoft.Json.Linq

  type [<RequireQualifiedAccess>] JsonPathElement = 
  | ObjectKey   of string
  | ArrayIndex  of int

  type JsonPath = JsonPathElement list

  type [<RequireQualifiedAccess>] JsonNavigationFailure =
  | NotConvertibleTo        of JsonPath*string*string
  | InvalidNumberValue      of JsonPath
  | MissingProperty         of JsonPath*string
  | IndexOutOfRange         of JsonPath*int*int
  | NotAnArray              of JsonPath*string
  | NotAnObject             of JsonPath*string
  | Group                   of JsonPath*JsonNavigationFailure array

  type [<RequireQualifiedAccess>] JsonNavigationResult =
  | Success of JsonPath*JToken
  | Failure of JsonNavigationFailure

  type JsonNavigator = 
    | JN of (JsonPath -> JToken -> JsonNavigationResult)

  module JsonNavigation =

    module Details =
      let inline adapt2  (JN f) = OptimizedClosures.FSharpFunc<_, _, _>.Adapt f
      let inline invoke2 f j p  = (f : OptimizedClosures.FSharpFunc<_, _, _>).Invoke (j, p)
      let inline success jp jt  = JsonNavigationResult.Success (jp, jt)
      let inline failure f      = JsonNavigationResult.Failure f

    open Details

    let jnroot = JN <| fun jp jt ->
      JsonNavigationResult.Success (jp, jt)

    let jnrun jt t = 
      let t = adapt2 t
      invoke2 t [] jt

    let jntoken jt t =
      match jnrun jt t with
      | JsonNavigationResult.Success (_, jt)  -> Ok     jt
      | JsonNavigationResult.Failure f        -> Error  f

    let jnvalue<'T> jt t : Result<'T, _> =
      jntoken jt t
      |> Result.map (fun t -> t.Value<'T> ())

    let jnstring jt t = jnvalue<string> jt t
    let jnfloat  jt t = jnvalue<float>  jt t

    let jnindex idx t = 
      let t = adapt2 t
      JN <| fun jp jt ->
        match invoke2 t jp jt with
        | JsonNavigationResult.Failure _ as f -> f
        | JsonNavigationResult.Success (tjp, tjt) ->
          match tjt with
          | :? JArray as ja ->
            let c = ja.Count
            if idx < c then
              let ijp = (JsonPathElement.ArrayIndex idx)::tjp
              let ijt = ja.[idx]
              success ijp ijt
            else
              JsonNavigationFailure.IndexOutOfRange (tjp, idx, c) |> failure
          | jt ->
            JsonNavigationFailure.NotAnArray (tjp, string jt.Type) |> failure

    let jnkey key t = 
      let t = adapt2 t
      JN <| fun jp jt ->
        match invoke2 t jp jt with
        | JsonNavigationResult.Failure _ as f -> f
        | JsonNavigationResult.Success (tjp, tjt) ->
          match tjt with
          | :? JObject as jo ->
            let ijt = jo.[key]
            if not (isNull ijt) then
              let ijp = (JsonPathElement.ObjectKey key)::tjp
              success ijp ijt
            else
              JsonNavigationFailure.MissingProperty (tjp, key) |> failure
          | jt ->
            JsonNavigationFailure.NotAnObject (tjp, string jt.Type) |> failure

    let jnpick p t = 
      let p = adapt2 p
      let t = adapt2 t
      JN <| fun jp jt ->
        match invoke2 t jp jt with
        | JsonNavigationResult.Failure _ as f -> f
        | JsonNavigationResult.Success (tjp, tjt) ->
          match tjt with
          | :? JArray as ja ->
            let c = ja.Count
            let vs = ResizeArray c
            for i = 0 to c - 1 do
              let ijp = (JsonPathElement.ArrayIndex i)::tjp
              let ijt = ja.[i]
              match invoke2 p ijp ijt with
              | JsonNavigationResult.Success (_, sjt) -> vs.Add sjt
              | JsonNavigationResult.Failure _        -> ()
            success tjp (JArray vs)
          | _ ->
            let vs = 
              match invoke2 p tjp tjt with
              | JsonNavigationResult.Success (_, sjt) -> [|sjt|]
              | JsonNavigationResult.Failure _        -> [||]
            success tjp (JArray vs)

    let jnfilter f t = 
      let f = adapt2 f
      let t = adapt2 t
      JN <| fun jp jt ->
        match invoke2 t jp jt with
        | JsonNavigationResult.Failure _ as f -> f
        | JsonNavigationResult.Success (tjp, tjt) ->
          match tjt with
          | :? JArray as ja ->
            let c = ja.Count
            let vs = ResizeArray c
            for i = 0 to c - 1 do
              let ijp = (JsonPathElement.ArrayIndex i)::tjp
              let ijt = ja.[i]
              match invoke2 f ijp ijt with
              | JsonNavigationResult.Success (_, sjt) -> if sjt.Value<bool> () then vs.Add ijt
              | JsonNavigationResult.Failure _        -> ()
            success tjp (JArray vs)
          | _ ->
            let vs = 
              match invoke2 f tjp tjt with
              | JsonNavigationResult.Success (_, sjt) -> if sjt.Value<bool> () then [|tjt|] else [||]
              | JsonNavigationResult.Failure _        -> [||]
            success tjp (JArray vs)

  type JsonNavigator with
    member x.Item   idx = JsonNavigation.jnindex  idx x
    member x.Filter f   = JsonNavigation.jnfilter f x
    member x.Pick   p   = JsonNavigation.jnpick   p x
    static member (?) (jn, key) = JsonNavigation.jnkey key jn

module Test =
  let jsonString = """
{
  "glossary": {
    "title": "example glossary",
		"GlossDiv": {
      "title": "S",
      "id": 24,
			"GlossList": {
        "GlossEntry": {
          "ID": "SGML",
					"SortAs": "SGML",
					"GlossTerm": "Standard Generalized Markup Language",
					"Acronym": "SGML",
					"Abbrev": "ISO 8879:1986",
					"GlossDef": {
            "para": "A meta-markup language, used to create markup languages such as DocBook.",
						"GlossSeeAlso": ["GML", "XML"]
          },
					"GlossSee": "markup"
        }
      }
    }
  }
}
"""

  let json2String = """
[
  { "id": 1, "isCompany": "false", "firstName": "Bill"    , "lastName": "Gates" },
  { "id": 2, "isCompany": "false", "firstName": "Melinda" , "lastName": "Gates" },

  { "id": 3, "isCompany": "true" , "companyName": "Microsoft" },
  { "id": 4, "isCompany": "true" , "companyName": "Apple"     },
  { "id": 5, "isCompany": "true" , "companyName": "Google"    }
]"""

  open Newtonsoft.Json
  open Newtonsoft.Json.Linq

  open FsDynamicJson.JsonNavigation

  let run () =
    do 
      let jt = JsonConvert.DeserializeObject jsonString :?> JToken

      printfn "%A" <| jnstring jt jnroot?glossary?title
      printfn "%A" <| jnstring jt jnroot?glossary.[0]
      printfn "%A" <| jnstring jt jnroot?glossary?GlossDiv?id
      printfn "%A" <| jnstring jt jnroot?glossary?missing
      printfn "%A" <| jnstring jt jnroot?glossary?GlossDiv?GlossList?GlossEntry?GlossDef?GlossSeeAlso.[0]
      printfn "%A" <| jnstring jt jnroot?glossary?GlossDiv?GlossList?GlossEntry?GlossDef?GlossSeeAlso.[3]

      ()

    do 
      let jt = JsonConvert.DeserializeObject json2String :?> JToken

      printfn "%A" <| jnstring jt jnroot.[0]?firstName
      printfn "%A" <| jnstring jt (jnroot.Pick jnroot?companyName).[0]
      printfn "%A" <| jnstring jt (jnroot.[0].Pick jnroot?companyName).[0]
      printfn "%A" <| jnstring jt (jnroot.[3].Pick jnroot?companyName).[0]
      printfn "%A" <| jnstring jt (jnroot.Filter jnroot?isCompany).[0]?companyName
      printfn "%A" <| jnstring jt (jnroot.[0].Filter jnroot?isCompany).[0]?companyName
      printfn "%A" <| jnstring jt (jnroot.[3].Filter jnroot?isCompany).[0]?companyName

      ()
[<EntryPoint>]
let main argv =
  Test.run ()
  0