Skip to content

GitLab

Commit 487d92ff authored by Laurent Wouters's avatar Laurent Wouters
Browse files

Rendering entities

parent b5ce151270e2
Hide whitespace changes
Inline Side-by-side
src/components/App.re
View file @ 067a0e6b
......@@ -16,90 +16,6 @@ type action =
let component = ReasonReact.reducerComponent("Page");
let rec getTarget = path =>
switch (path) {
| [] => ""
| [first] => "/" ++ first
| [first, ...others] => "/" ++ first ++ getTarget(others)
};
let fetchSchema = path =>
Js.Promise.(
Fetch.fetchWithInit(
Hypermedia.baseUrl ++ getTarget(path) ++ "/schema",
Fetch.RequestInit.make(
~headers=Fetch.HeadersInit.makeWithArray(Hypermedia.headersForSchema),
(),
),
)
|> then_(Fetch.Response.json)
|> then_(json =>
json
|> Hypermedia.Decode.schemaType
|> (schema => Some(schema) |> resolve)
)
|> catch(_err => resolve(None))
);
let doFetchSchema =
(
self: ReasonReact.self('state, 'retainedProps, 'action),
path: list(string),
) =>
Js.Promise.(
fetchSchema(path)
|> then_(result =>
switch (result) {
| Some(schema) => resolve(self.send(LoadedSchema(schema)))
| None => resolve(self.send(LoadingFailed))
}
)
|> ignore
);
let fetchData = path =>
Js.Promise.(
Fetch.fetchWithInit(
Hypermedia.baseUrl ++ getTarget(path),
Fetch.RequestInit.make(
~headers=
Fetch.HeadersInit.makeWithArray(Hypermedia.headersForResources),
(),
),
)
|> then_(Fetch.Response.json)
|> then_(json =>
json
|> Hypermedia.Decode.entityValue
|> (value => Some(value) |> resolve)
)
|> catch(_err => resolve(None))
);
let doFetchData = (self: ReasonReact.self(_, _, _), path: list(string)) =>
Js.Promise.(
fetchData(path)
|> then_(result =>
switch (result) {
| Some(data) => resolve(self.send(LoadedData(data)))
| None => resolve(self.send(LoadingFailed))
}
)
|> ignore
);
let onSchemaLoaded =
(
self: ReasonReact.self(_, _, _),
path: list(string),
schema: Hypermedia.schemaType,
) =>
switch (schema) {
| Hypermedia.ArrayType(_) => doFetchData(self, path)
| Hypermedia.ObjectType(_) => doFetchData(self, path)
| _ => ()
};
let goto = (_event, _self, link) => ReasonReact.Router.push(link);
let renderLoadedInitialSchema =
......@@ -144,7 +60,11 @@ let make = _children => {
...component,
didMount: self => {
let url = ReasonReact.Router.dangerouslyGetInitialUrl();
doFetchSchema(self, url.path);
Hypermedia.Fetch.fetch_shema(
url.path,
() => self.send(LoadingFailed),
data => self.send(LoadedSchema(data)),
);
let watcherID =
ReasonReact.Router.watchUrl(url => self.send(Goto(url.path)));
self.onUnmount(() => ReasonReact.Router.unwatchUrl(watcherID));
......@@ -173,7 +93,16 @@ let make = _children => {
didUpdate: oldNewSelf =>
switch (oldNewSelf.oldSelf.state, oldNewSelf.newSelf.state) {
| (Loading(_), LoadedInitialSchema(path, schema)) =>
onSchemaLoaded(oldNewSelf.newSelf, path, schema)
switch (schema) {
| Hypermedia.ArrayType(_)
| Hypermedia.ObjectType(_) =>
Hypermedia.Fetch.fetch_data(
path,
() => oldNewSelf.newSelf.send(LoadingFailed),
data => oldNewSelf.newSelf.send(LoadedData(data)),
)
| _ => ()
}
| _ => ()
},
render: self =>
......
src/components/Rendering.re
View file @ 067a0e6b
......@@ -57,9 +57,12 @@ let renderCollection =
(
data
|> List.map((entity: Hypermedia.entityValue) => {
let obj = Hypermedia.as_object(entity);
let link_target = Hypermedia.produce(link_href, obj);
let title = Hypermedia.as_string(Hypermedia.get(obj, "title"));
let obj = Hypermedia.Entity.as_object(entity);
let link_target = Hypermedia.Utils.produce(link_href, obj);
let title =
Hypermedia.Entity.as_string(
Hypermedia.Entity.get(obj, "title"),
);
<li>
<a
href=link_target
......@@ -91,18 +94,18 @@ let renderEntity =
<div>
<h1> (ReasonReact.string(schema_title)) </h1>
<div>
(
data.properties
|> List.map((property: Hypermedia.entityProperty) => {
let value = Hypermedia.as_string(property.value);
<div>
<div> (ReasonReact.string(property.name)) </div>
<div> (ReasonReact.string(value)) </div>
</div>
})
|> Array.of_list
|> ReasonReact.array
)
(
data.properties
|> List.map((property: Hypermedia.entityProperty) => {
let value = Hypermedia.Entity.as_string(property.value);
<div>
<div> (ReasonReact.string(property.name)) </div>
<div> (ReasonReact.string(value)) </div>
</div>;
})
|> Array.of_list
|> ReasonReact.array
)
</div>
</div>;
};
\ No newline at end of file
src/services/hypermedia.ml
View file @ 067a0e6b
(* The base URL for fetching all data *)
let baseUrl = "http://localhost:6543";;
(* Headers when fetching schema information *)
let headersForSchema = [|
("Content-Type", "application/schema+json");
("Accept", "application/schema+json")
|];;
(* Headers when fetching data *)
let headersForResources = [|
("Content-Type", "application/json");
("Accept", "application/json")
......@@ -62,19 +65,22 @@ and entityValue =
| ValueArray of entityValue list
| ValueObject of entity
let get entity key = begin
(List.find (fun p -> p.name = key) entity.properties).value
end
let as_string entityValue =
match entityValue with
| ValuePrimitive x -> x
| _ -> ""
module Entity = struct
let get entity key = begin
(List.find (fun p -> p.name = key) entity.properties).value
end
let as_string entityValue =
match entityValue with
| ValuePrimitive x -> x
| _ -> ""
let as_object entityValue =
match entityValue with
| ValueObject x -> x
| _ -> {properties= [];}
let as_object entityValue =
match entityValue with
| ValueObject x -> x
| _ -> {properties= [];}
end
module Decode = struct
......@@ -178,32 +184,86 @@ module Decode = struct
end;;
end
let produce template entity = begin
let re = [%re "/\{([a-zA-Z_][a-zA-Z0-9_]*)\}/g"] in
let break = ref false in
let last = ref 0 in
let result = ref "" in
while not !break do
match re |> Js.Re.exec template with
| None -> begin
break := true;
let len = String.length template - !last in
module Utils = struct
let produce template entity = begin
let re = [%re "/\{([a-zA-Z_][a-zA-Z0-9_]*)\}/g"] in
let break = ref false in
let last = ref 0 in
let result = ref "" in
while not !break do
match re |> Js.Re.exec template with
| None -> begin
break := true;
let len = String.length template - !last in
let sub = String.sub template !last len in
result := !result ^ sub
end
| Some mr ->
let maybe_id = Js.toOption (Js.Re.captures mr).(1) in
let start = Js.Re.index mr in
let next = Js.Re.lastIndex re in
let len = start - !last in
let sub = String.sub template !last len in
result := !result ^ sub
end
| Some mr ->
let maybe_id = Js.toOption (Js.Re.captures mr).(1) in
let start = Js.Re.index mr in
let next = Js.Re.lastIndex re in
let len = start - !last in
let sub = String.sub template !last len in
let value = match maybe_id with
| None -> ""
| Some id -> as_string (get entity id)
in begin
result := !result ^ sub ^ value;
last := next
end
done;
!result
let value = match maybe_id with
| None -> ""
| Some id -> Entity.as_string (Entity.get entity id)
in begin
result := !result ^ sub ^ value;
last := next
end
done;
!result
end
end
module Fetch = struct
let rec getTarget path =
match path with
| [] -> ""
| [first] -> "/" ^ first
| first :: others -> "/" ^ first ^ (getTarget others)
let do_fetch_schema path =
let headers = Fetch.HeadersInit.makeWithArray headersForSchema in
let reqInit = () |> Fetch.RequestInit.make ~headers: headers in
let url = baseUrl ^ (getTarget path) ^ "/schema" in
let promise = Fetch.fetchWithInit url reqInit in
Js.Promise.(
promise
|> then_ (Fetch.Response.json)
|> then_ (fun json -> json |> Decode.schemaType |> (fun schema -> Some(schema) |> resolve))
|> catch (fun _err -> resolve None)
)
let do_fetch_data path =
let headers = Fetch.HeadersInit.makeWithArray headersForResources in
let reqInit = () |> Fetch.RequestInit.make ~headers: headers in
let url = baseUrl ^ (getTarget path) in
let promise = Fetch.fetchWithInit url reqInit in
Js.Promise.(
promise
|> then_ (Fetch.Response.json)
|> then_ (fun json -> json |> Decode.entityValue |> (fun data -> Some(data) |> resolve))
|> catch (fun _err -> resolve None)
)
let fetch f path on_fail on_success =
let promise = f path in
Js.Promise.(
promise
|> then_ (fun result ->
match result with
| Some(data) -> resolve (on_success data)
| None -> resolve (on_fail ())
)
|> ignore
)
let fetch_shema path on_fail on_success =
fetch do_fetch_schema path on_fail on_success
let fetch_data path on_fail on_success =
fetch do_fetch_data path on_fail on_success
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