Skip to content

Instantly share code, notes, and snippets.

@mrange
Last active January 23, 2017 06:53
Show Gist options
  • Save mrange/32ad0628bef869ee9e20bfdc2e859e13 to your computer and use it in GitHub Desktop.
Save mrange/32ad0628bef869ee9e20bfdc2e859e13 to your computer and use it in GitHub Desktop.
Monadic JSON Transformers in F#

Monadic JSON Transformers

Full source for JSON Transformer: https://gist.github.com/mrange/7c39333de480a8de5c812a1f6ba70173

Full source for XML Transformer: https://gist.github.com/mrange/552cb0b474b517b706333cebb64f44aa

A popular approach in Functional Languages to create parsers is to use parser combinators.

Parser combinators provide a way to compose parser of ever increasing complexity from simple parsers. Parser combinators (like FParsec) also tend to provide good error reporting.

A problem similar to parsing is transforming a JSON Document without a strict schema into a F# Record. Because of the dynamic nature of JSON we like to good error reporting on transformation failure.

Because of the similarities between text parsing and JSON document transformation is it feasible to define a JSON Transformer monad?

The example code hasn't considered performance. This is an investigation to see if JSON transforms can be expressed using monadic combinators

Let's start with the type of JSON transformer. A first approach would be something like this:

  type JsonTransform<'T> = Json -> 'T

However, a JSON transform might fail:

  type JsonTransform<'T> = Json -> 'T option

In addition we like to support error messages so perhaps this is better?

  type JsonTransform<'T> = Json -> Choice2<'T, string list>

From working on Formlet monads I have come to the realization that in order to report all errors detected and not just the first error a JsonTransform must always return a value (sometimes with errors attached to it). This is because how monadic bind works. In addition we like to have a path to the point of error inside the JSON document so a simple string list wont do.

  type JsonTransform<'T> =
    {
      Transform : JsonPath -> Json -> 'T*JsonTransformErrorTree
      Default   : unit -> 'T
    }

Default is there to provide a default value on errors. Transform takes a JsonPath and a Json document and produces 'T*JsonTransformErrorTree.

'T is the value and JsonTransformErrorTree is the tree of errors discovered during transformation. If everything went well the error tree will be Empty

We are building monadic JSON transformer compinators. Therefore we need to define return and bind. Defining monadic return is straight-forward:

  let jreturn v : JsonTransform<'T> =
    {
      Transform = fun p j -> success v
      Default   = fun ()  -> v
    }

Defining monadic bind isn't too bad neither:

  let jbind (t : JsonTransform<'T>) (uf : 'T -> JsonTransform<'U>) : JsonTransform<'U> =
    {
      Transform =
        let tr = adapt t.Transform
        fun p j ->
          let tv, te = tr.Invoke (p, j)
          let u   = uf tv
          let ur  = adapt u.Transform
          let uv, ue = ur.Invoke (p, j)
          uv, (join te ue)
      Default =
        fun () ->
          let tv = t.Default ()
          let u  = uf tv
          u.Default ()
    }
  let inline (>>=) t uf = jbind t uf

Because the result from running t.Transform is a 'T not an 'T option we can always create u from uf tv. This is important in order to collect error messages for the full transformation process.

Then we can define simple transformers that allows us to coerce the current JSON element into a value:

  let jcoerce dv (c : Json -> 'T option) : JsonTransform<'T> =
    {
      Transform =
        fun p j ->
          match c j with
          | Some v -> success <| v
          | None   -> failure dv p <| CanNotCoerceTo typeof<'T>
      Default = fun () -> dv
    }

  let jstring : JsonTransform<string> =
    jcoerce "" <| function
      | Null      -> Some <| "null"
      | Bool    b -> Some <| if b then "true" else "false"
      | Number  n -> Some <| string n
      | String  s -> Some <| s
      | Array   _
      | Object  _ -> None

jstring coerces the current JSON element so we need some way to navigate the JSON document.

  type NavigateResult<'T> =
    | NavigateTo    of JsonPath*Json
    | NavigateValue of 'T
    | NavigateError of JsonTransformError

  let jnavigate (navigator: JsonPath -> Json -> NavigateResult<'T>) (t : JsonTransform<'T>) : JsonTransform<'T> =
    { t with
        Transform =
          let tr = adapt t.Transform
          let na = adapt navigator
          fun p j ->
            match na.Invoke (p, j) with
            | NavigateTo (np, nj) -> tr.Invoke (np, nj)
            | NavigateValue v     -> success v
            | NavigateError e     ->
              failure (t.Default ()) p e
    }

  let jfield (name : string) (t : JsonTransform<'T>) : JsonTransform<'T> =
    let rescope p j =
      match j with
      | Null
      | Bool    _
      | Number  _
      | String  _
      | Array   _ ->
        NavigateError <| NonObject
      | Object  vs->
        match vs |> Array.tryFind (fst >> (=) name) with
        | Some (_, v) ->
          NavigateTo (Field name::p, v)
        | _ ->
          NavigateError <| FieldNotFound name
    jnavigate rescope t

jfield allows us to navigate the field named name and apply the transformer t in that scope. jfield "Hello" jstring means navigate to field Hello and try to coerce it into a string. Any problems will be reported back as transformation errors.

We also define jindex and jofield to support navigating arrays as well as supporting optional fields.

To further improve usability we define some operators:

  let inline jthis t = t
  let inline (?) t n = jfield n >> t
  let inline (@) t n = jindex n >> t

(?) is the dynamic lookup operator in F# which allows us create transformers like this:

  jthis?Hello?There jstring // navigates into field Hello->There and coerces it to string

By defining an F# computation expression we can use F# monad transformers to build our transforms:

  type JsonTransformBuilder() =
    member x.Bind (t, uf) = jbind t uf
    member x.Return v     = jreturn v
    member x.ReturnFrom t = t

  let jtransform = JsonTransformBuilder ()

  // ...

  type Person =
    {
      Id          : string
      FirstName   : string
      LastName    : string
    }
    static member New id fn ln : Person = { Id = id; FirstName = fn; LastName = ln }

  let inline jstr n = jstring |> jfield n

  let jperson =
    jtransform {
      let! id = jstr "id"
      let! fn = jstr "firstName"
      let! ln = jstr "lastName"
      return Person.New id fn ln
    }

However, recently I have been enjoying super lifting with Applicatives:

  let inline jpure v = jreturn v

  let japply (f : JsonTransform<'T -> 'U>) (t : JsonTransform<'T>) : JsonTransform<'U> =
    f >>= fun ff -> t >>! ff
  let inline (<*>) f t = japply f t

  // ...

  let jperson =
    jpure Person.New
      <*> jstr "id"
      <*> jstr "firstName"
      <*> jstr "lastName"

This allows us to define a JSON tranformer:

  let inline jstr n = jstring |> jfield n
  let inline jqty n = jfloat  |> jcheck ((<) 0.) "Quantity must be positive" |> jofield n 1.

  let jperson =
    jpure Person.New
      <*> jstr "id"
      <*> jstr "firstName"
      <*> jstr "lastName"
    >>! Person
  let jpersons = jmany jperson

  let jcompany =
    jpure Company.New
      <*> jstr "id"
      <*> jstr "name"
      <*> jstr "companyNo"
      <*> jstr "taxNo"
    >>! Company
  let jcompanies = jmany jcompany

  let jcustomer   = jperson <|> jcompany
  let jcustomers  = jmany jcustomer

  let jorderRow =
    jpure OrderRow.New
      <*> jstr "product"
      <*> jqty "quantity"
  let jorderRows = jmany jorderRow

  let jorder =
    jpure Order.New
      <*> jstr "id"
      <*> jstr "customerId"
      <*> jthis?rows jorderRows
  let jorders = jmany jorder

  let jfull =
    jtransform {
      let! customers = jthis?customers  jcustomers
      let! orders    = jthis?orders     jorders
      return Full.New customers orders
    }

Running the transformer on some test data:

{
  "customers": [{
    "id": "1",
    "firstName": "Bill",
    "lastName": "Gates"
  }, {
    "id": "2",
    "firstName": "Melinda",
    "lastName": "Gates"
  }, {
    "id": "3",
    "name": "Microsoft",
    "companyNo": "123",
    "taxNo": "MVAXYZ"
  }],
  "orders": [{
    "id": "1",
    "customerId": "1",
    "rows": [{
      "product": "Silver Tape",
      "quantity": "1"
    }, {
      "product": "Milk",
      "quantity": "2"
    }]
  }, {
    "id": "2",
    "customerId": "2",
    "rows": [{
      "product": "Handbag",
      "quantity": "-1"
    }]
  }]
}

Yields:

Errors: [|([Field "quantity"; Index 0; Field "rows"; Index 1; Field "orders"],
   General "Quantity must be positive")|]
{Customers =
  [|Person {Id = "1";
            FirstName = "Bill";
            LastName = "Gates";}; Person {Id = "2";
                                          FirstName = "Melinda";
                                          LastName = "Gates";};
    Company {Id = "3";
             Name = "Microsoft";
             CompanyNo = "123";
             TaxNo = "MVAXYZ";}|];
 Orders =
  [|{Id = "1";
     CustomerId = "1";
     Rows = [|{Product = "Silver Tape";
               Quantity = 1.0;}; {Product = "Milk";
                                  Quantity = 2.0;}|];};
    {Id = "2";
     CustomerId = "2";
     Rows = [|{Product = "Handbag";
               Quantity = -1.0;}|];}|];}

The transformer builds up a Record but during the transformation process it discovered an error:

Errors: [|([Field "quantity"; Index 0; Field "rows"; Index 1; Field "orders"],
   General "Quantity must be positive")|]

The path is in reverse order and using that we can navigate to the problematic JSON:

    "rows": [{
      "product": "Handbag",
      "quantity": "-1"
    }]

Conclusion

JSON transformers are useful when processing JSON documents w/o a strict schema. With monadic JSON transformer combinators we can define a transformer succinct, type-safe, composable and get good error reporting.

Full source at: https://gist.github.com/mrange/7c39333de480a8de5c812a1f6ba70173

@cloudRoutine
Copy link

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment