Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
open-source
SemWeb
libview
Commits
3ce97a46ea78
Commit
c2e1a67c
authored
Jun 22, 2018
by
Laurent Wouters
Browse files
Full deserialization for the hypermedia client
parent
54c1a577b5c9
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/services/hypermedia.ml
View file @
3ce97a46
...
...
@@ -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
:
proper
tyValue
;
value
:
enti
tyValue
;
}
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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment