Extendable Json schema

Schema.fs

type PropertyName = string

type Schema =
  { title       : string option
    description : string option
    ``type``    : JsonType option
    items       : Schema option
    properties  : Map<PropertyName, Schema> option
    extensions  : Map<string, Json> }

  static member ToJson (schema : Schema) =
    let jsonId = fun json -> Value (), json

    let writeKnown =
      maybeWrite "title" schema.title
      *> maybeWrite "description" schema.description
      *> maybeWrite "type" schema.``type``
      *> maybeWrite "items" schema.items
      *> maybeWrite "properties" schema.properties

    schema.extensions
    |> Map.toList
    |> List.map (fun (k, j) -> Json.write k j)
    |> List.fold ( *>) writeKnown

  static member FromJson (_ : Schema) : Json<Schema> =
    fun json ->
      let extensions =
        match json with
        | Json.Object o ->
            ["title";"description";"type";"items";"properties"]
            |> List.fold (fun m k -> Map.remove k m) o
        | _ -> failwithf "Expected json schema, recieved %A" json

      
      ((fun tit d tp is ps ->
        { title = tit
          description = d
          ``type`` = tp
          items = is
          properties = ps
          extensions = extensions
        })
      <!> Json.tryRead "title"
      <*> Json.tryRead "description"
      <*> Json.tryRead "type"
      <*> Json.tryRead "items"
      <*> Json.tryRead "properties") json