Commit c2e1a67c authored by Laurent Wouters's avatar Laurent Wouters
Browse files

Full deserialization for the hypermedia client

parent 54c1a577b5c9
......@@ -13,85 +13,156 @@ let headersForResources = [|
type reference = { ref: string }
type schemaLink = {
href: string;
rel: string;
submissionSchema: reference;
targetSchema: reference;
title: string;
anchor: string option;
href: string option;
rel: string option;
submissionSchema: reference option;
targetSchema: reference option;
title: string option;
}
type rootSchema = {
type schemaObjectType = {
(* "type" = "object" *)
title: string option;
links: schemaLink list;
title: string;
}
type entityPreview = {
id: string;
title: string;
meta: string;
}
type itemLink = {
anchor: string;
href: string;
rel: string;
properties: schemaObjectProperty list;
}
type valueSchema =
| Primitive of string
| Object of objectSchema
| Array of arraySchema
and propertySchema = {
and schemaObjectProperty = {
name: string;
meta: valueSchema;
format: string option;
ptype: schemaType;
}
and objectSchema = {
links: itemLink list;
properties: propertySchema list;
and schemaArrayType = {
(* "type" = "array" *)
title: string option;
links: schemaLink list;
items: schemaType
}
and arraySchema = {
and schemaRoot = {
(* "type" = "null" *)
title: string;
links: schemaLink list;
items: valueSchema;
}
and schemaType =
| PrimitiveType of string
| ArrayType of schemaArrayType
| ObjectType of schemaObjectType
| RootType of schemaRoot
type propertyValue =
| Simple of string
| Collection of string list;;
type property = {
type entity = {
properties: entityProperty list;
}
and entityProperty = {
name: string;
value: propertyValue;
value: entityValue;
}
and entityValue =
| ValueNull
| ValuePrimitive of string
| ValueArray of entityValue list
| ValueObject of entity
type entity = {
id: string;
properties: property list;
}
module Decode = struct
exception DecodeError of string
let optional_field key decode json = begin
let dict = (Obj.magic (json : Js.Json.t) : Js.Json.t Js.Dict.t) in
match Js.Dict.get dict key with
| Some value -> Some(decode value)
| None -> None
end;;
let reference json = {
ref = (Json.Decode.field "$ref" Json.Decode.string json)
ref = (Json.Decode.field "$ref" Json.Decode.string json)
};;
let schemaLink json = {
href = (Json.Decode.field "href" Json.Decode.string json);
rel = (Json.Decode.field "rel" Json.Decode.string json);
submissionSchema = (Json.Decode.field "submissionSchema" reference json);
targetSchema = (Json.Decode.field "targetSchema" reference json);
title = (Json.Decode.field "title" Json.Decode.string json);
};;
let rootSchema json = {
title = (Json.Decode.field "title" Json.Decode.string json);
links = (Json.Decode.field "links" (fun x -> Json.Decode.list schemaLink x) json)
anchor = (optional_field "anchor" Json.Decode.string json);
href = (optional_field "href" Json.Decode.string json);
rel = (optional_field "rel" Json.Decode.string json);
submissionSchema = (optional_field "submissionSchema" reference json);
targetSchema = (optional_field "targetSchema" reference json);
title = (optional_field "title" Json.Decode.string json);
};;
let entityPreview json = {
id = (Json.Decode.field "id" Json.Decode.string json);
let rec schemaObjectType json = {
title = (optional_field "title" Json.Decode.string json);
links = (Json.Decode.field "links" (fun x -> Json.Decode.list schemaLink x) json);
properties = (Json.Decode.field "properties" schemaObjectProperties json);
}
and schemaObjectProperties json = begin
let source = (Obj.magic (json : Js.Json.t) : Js.Json.t Js.Dict.t) in
let keys = Js.Dict.keys source in
let result = Js.Array.map
(fun key -> schemaObjectProperty key (Js.Dict.unsafeGet source key))
keys in
Array.to_list result
end
and schemaObjectProperty name json = {
name = name;
format = (optional_field "format" Json.Decode.string json);
ptype = (Json.Decode.field "type" schemaType json)
}
and schemaArrayType json = {
title = (optional_field "title" Json.Decode.string json);
links = (Json.Decode.field "links" (fun x -> Json.Decode.list schemaLink x) json);
items = (Json.Decode.field "items" schemaType json);
}
and schemaRoot json = {
title = (Json.Decode.field "title" Json.Decode.string json);
meta = (Json.Decode.field "type" Json.Decode.string json);
};;
let entityPreviews json = (Json.Decode.list entityPreview json);;
links = (Json.Decode.field "links" (fun x -> Json.Decode.list schemaLink x) json);
}
and schemaType json = begin
let ty = Js.typeof json in
if ty = "string" then
PrimitiveType(Obj.magic json)
else
let dict = (Obj.magic (json : Js.Json.t) : Js.Json.t Js.Dict.t) in
match Js.Dict.get dict "type" with
| Some value -> schemaTypeComplex (Obj.magic value) json
| None -> RootType(schemaRoot json)
end
and schemaTypeComplex itype json =
if itype = "object" then
ObjectType(schemaObjectType json)
else if itype = "array" then
ArrayType(schemaArrayType json)
else
RootType(schemaRoot json)
;;
let rec entity json = {
properties = (Json.Decode.field "properties" entityProperties json);
}
and entityProperties json = begin
let source = (Obj.magic (json : Js.Json.t) : Js.Json.t Js.Dict.t) in
let keys = Js.Dict.keys source in
let result = Js.Array.map
(fun key -> entityProperty key (Js.Dict.unsafeGet source key))
keys in
Array.to_list result
end
and entityProperty name json = {
name = name;
value = entityValue json;
}
and entityValue json = begin
let ty = Js.typeof json in
if ty = "string" then
ValuePrimitive(Obj.magic json)
else if ty = "number" then
ValuePrimitive(Obj.magic json)
else if ty = "boolean" then
ValuePrimitive(Obj.magic json)
else if (Obj.magic json) == Js.null then
ValueNull
else if Js_array.isArray json then
ValueArray(Array.to_list (Json.Decode.array entityValue json))
else
ValueObject(entity json)
end;;
end
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment