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

Adding new application framework

parent 91f998469cbe
......@@ -61,7 +61,7 @@ let make = _children => {
didMount: self => {
let url = ReasonReact.Router.dangerouslyGetInitialUrl();
Hypermedia.Fetch.fetch_shema(
url.path,
Hypermedia.Fetch.getTarget(url.path),
() => self.send(LoadingFailed),
data => self.send(LoadedSchema(data)),
);
......@@ -97,7 +97,7 @@ let make = _children => {
| Hypermedia.ArrayType(_)
| Hypermedia.ObjectType(_) =>
Hypermedia.Fetch.fetch_data(
path,
Hypermedia.Fetch.getTarget(path),
() => oldNewSelf.newSelf.send(LoadingFailed),
data => oldNewSelf.newSelf.send(LoadedData(data)),
)
......
module StringMap = Map.Make(String);;
(* A piece of data that has to be fetched *)
type requestedData =
(* A schema that has to be fetched *)
| RequestedSchema of string
(* A piece of resource that has to be fetched *)
| RequestedData of string
(* The definition of a view has to be fetched *)
| RequestedViewDefinition of string
(* The specification of views has to be fetched *)
| RequestedViewSpecifications of string
(* Get a descriptor for requested data *)
let describe_requested data = match data with
| RequestedData(target) -> ("data", target)
| RequestedSchema(target) -> ("schema", target)
| RequestedViewDefinition(target) -> ("view", target)
| RequestedViewSpecifications(target) -> ("view specifications", target)
(* Possible kind of views *)
type viewKind =
(* A view for an application root *)
| RootView
(* A view for a collection of items *)
| CollectionView of string option
(* A view for a kind of entity *)
| EntityView of string option
(* A specification *)
type viewSpecification = {
(* The view's name *)
name: string;
(* The kind of view *)
kind: viewKind;
(* The priority given to the view *)
priority: int;
(* The location of the view's definition *)
definition: string;
}
(* A piece of fetched data *)
type fetchedData =
(* A fetched schema *)
| FetchedSchema of string * Hypermedia.schemaType
(* A fetched piece of data *)
| FetchedData of (string * Hypermedia.entityValue)
(* A fetched collection of view specifications *)
| FetchedSpecifications of viewSpecification list
(* An resource to be rendered *)
type resource = {
(* The path to the resource *)
path: string;
(* The schema for this resource *)
schema: Hypermedia.schemaType option;
(* The data for this resource, if applicable *)
data: Hypermedia.entityValue option;
}
(* Callback when a link is being activated *)
type linker = string -> unit
(* Type of a rendering function *)
type ('state, 'initialState, 'retainedProps, 'initialRetainedProps, 'action) renderer =
('state, 'retainedProps, 'action) ReasonReact.self
-> linker
-> (resource list)
-> ('state, 'initialState, 'retainedProps, 'initialRetainedProps, 'action) ReasonReact.componentSpec
(* The definition of a view *)
type ('state, 'initialState, 'retainedProps, 'initialRetainedProps, 'action) view = {
(* The specification of this view *)
specfication: viewSpecification;
(* The view rendering function *)
renderer: ('state, 'initialState, 'retainedProps, 'initialRetainedProps, 'action) renderer;
}
(* A registry of views *)
type 'a viewRegistry = {
(* The known specifications *)
specifications: viewSpecification list;
(* The known definitions *)
definitions: 'a list;
}
(* The state of an app while loading *)
type 'a appStateLoading = {
(* the location of the current resource *)
location: string;
(* The already loaded resources *)
loaded: resource StringMap.t;
(* The data remaining to be fetched *)
requested: requestedData list;
(* The view registry for the app *)
registry: 'a viewRegistry;
}
(* The state of an app while loading *)
type 'a appStateLoaded = {
(* the location of the current resource *)
location: string;
(* The already loaded resources *)
resources: resource StringMap.t;
(* The view registry for the app *)
registry: 'a viewRegistry;
}
(* The possible states of an app *)
type 'a appState =
(* The app failed with a message *)
| Failed of string * 'a viewRegistry
(* Initial state *)
| Init
(* The app is loading *)
| Loading of 'a appStateLoading
(* The completed state of an app *)
| Ready of 'a appStateLoaded
(* The possible actions of an app *)
type appAction =
(* Some fetching is being requested *)
| Request of requestedData
(* Some request has been launched *)
| LaunchedRequest of requestedData
(* The loading of a resource failed *)
| LoadingFailed of requestedData
(* The loading of a resource has been completed *)
| LoadingCompleted of fetchedData
(* The user requested going to another location *)
| GoTo of string
(* Fold fetched data into a map of resources *)
let fold_into fetchedData (resources: resource StringMap.t) =
match fetchedData with
| FetchedSchema(target, schema) ->
if StringMap.exists (fun k _ -> target = k) resources then
let old = StringMap.find target resources in
StringMap.add target {path=target; schema=Some(schema); data=old.data} resources
else
StringMap.add target {path=target; schema=Some(schema); data=None} resources
| FetchedData(target, data) ->
if StringMap.exists (fun k _ -> target = k) resources then
let old = StringMap.find target resources in
StringMap.add target {path=target; schema=old.schema; data=Some(data)} resources
else
StringMap.add target {path=target; schema=None; data=Some(data)} resources
| _ -> resources
(* Get the initial state for the application *)
let initial_state () = Init
(* Apply the reduction on a GoTo action *)
let reduce_on_goto state target = match state with
| Loading({
location = _;
loaded = _;
requested = _;
registry = registry;
})
| Ready({
location = _;
resources = _;
registry = registry;
})
| Failed(_, registry)-> ReasonReact.Update(Loading({
location = target;
loaded = StringMap.empty;
requested = [RequestedSchema(target)];
registry = registry;
}))
| Init -> ReasonReact.Update(Loading({
location = target;
loaded = StringMap.empty;
requested = [RequestedSchema(target)];
registry = {
specifications =[];
definitions = [];
};
}))
(* Apply the reduction on a Request action *)
let reduce_on_requested state requestedData = match state with
| Loading({
location = location;
loaded = loaded;
requested = requested;
registry = registry
}) -> ReasonReact.Update(Loading({
location = location;
loaded = loaded;
requested = requested @ [requestedData];
registry = registry;
}))
| Ready({
location = location;
resources = resources;
registry = registry;
}) -> ReasonReact.Update(Loading({
location = location;
loaded = resources;
requested = [requestedData];
registry = registry;
}))
| Failed(_, _)
| Init-> ReasonReact.NoUpdate
let reduce_on_request_launched state _ = match state with
| Loading({
location = location;
loaded = loaded;
requested = requested;
registry = registry
}) -> ReasonReact.Update(Loading({
location = location;
loaded = loaded;
requested = List.tl requested;
registry = registry;
}))
| Ready(_)
| Failed(_, _)
| Init-> ReasonReact.NoUpdate
(* Apply the reduction on a Loading Failed action *)
let reduce_on_failed state requestedData =
let what, target = describe_requested requestedData in
match state with
| Loading({
location = _;
loaded = _;
requested = _;
registry = registry;
})
| Ready({
location = _;
resources = _;
registry = registry;
})
| Failed(_, registry)-> ReasonReact.Update(Failed("Failed to fetch " ^ what ^ " at " ^ target, registry))
| Init -> ReasonReact.Update(Failed("Failed to fetch " ^ what ^ " at " ^ target, {
specifications = [];
definitions = [];
}))
(* Apply the reduction on a Loaded Data action *)
let reduce_on_loaded state fetchedData =
match state with
| Failed(_, _)
| Init -> ReasonReact.NoUpdate
| Loading({
location = location;
loaded = loaded;
requested = requested;
registry = registry
}) -> ReasonReact.Update(if List.length requested = 0 then
Ready({location=location; resources=fold_into fetchedData loaded; registry=registry}) else
Loading({location=location; loaded=fold_into fetchedData loaded; requested=requested; registry=registry}))
| Ready({
location = location;
resources = resources;
registry = registry;
}) -> ReasonReact.Update(Ready({location=location; resources=fold_into fetchedData resources; registry=registry}))
(* Default reduction function *)
let reduce action state = match action with
| GoTo(target) -> reduce_on_goto state target
| Request(requestedData) -> reduce_on_requested state requestedData
| LaunchedRequest(requestedData) -> reduce_on_request_launched state requestedData
| LoadingFailed(requestedData) -> reduce_on_failed state requestedData
| LoadingCompleted(fetchedData) -> reduce_on_loaded state fetchedData
(* When the app moved to a new target resource *)
let on_moved_to (self: ('a, 'b, 'c) ReasonReact.self) target =
Hypermedia.Fetch.fetch_shema
target
(fun () -> self.send(LoadingFailed(RequestedSchema(target))))
(fun data -> self.send(LoadingCompleted(FetchedSchema(target, data))))
(* Launched a request for some data *)
let do_fetch requestedData (self: (_, _, _) ReasonReact.self) = match requestedData with
| RequestedData(target) -> begin
(Hypermedia.Fetch.fetch_data
target
(fun () -> self.send(LoadingFailed(requestedData)))
(fun data -> self.send(LoadingCompleted(FetchedData(target, data)))));
self.send(LaunchedRequest(requestedData))
end
| RequestedSchema(target) -> begin
(Hypermedia.Fetch.fetch_shema
target
(fun () -> self.send(LoadingFailed(requestedData)))
(fun schema -> self.send(LoadingCompleted(FetchedSchema(target, schema)))));
self.send(LaunchedRequest(requestedData))
end
| _ -> self.send(LaunchedRequest(requestedData))
(* When the state has changed *)
let on_updated (oldNewSelf: (_, _, _) ReasonReact.oldNewSelf) =
let self = oldNewSelf.newSelf.state in
match self with
| Loading({
location = _;
loaded = _;
requested = requested;
registry = _;
}) -> if List.length requested = 0 then () else begin
do_fetch (List.hd requested) oldNewSelf.newSelf;
()
end
| _ -> ()
\ No newline at end of file
......@@ -232,10 +232,10 @@ module Fetch = struct
| first :: others -> "/" ^ first ^ (getTarget others)
(* Get a promise for fetching a schema for the specified target path *)
let do_fetch_schema path =
let do_fetch_schema target =
let headers = Fetch.HeadersInit.makeWithArray headersForSchema in
let reqInit = () |> Fetch.RequestInit.make ~headers: headers in
let url = baseUrl ^ (getTarget path) ^ "/schema" in
let url = baseUrl ^ target ^ "/schema" in
let promise = Fetch.fetchWithInit url reqInit in
Js.Promise.(
promise
......@@ -245,10 +245,10 @@ module Fetch = struct
)
(* Get a promise for fetching data at the specified target path *)
let do_fetch_data path =
let do_fetch_data target =
let headers = Fetch.HeadersInit.makeWithArray headersForResources in
let reqInit = () |> Fetch.RequestInit.make ~headers: headers in
let url = baseUrl ^ (getTarget path) in
let url = baseUrl ^ target in
let promise = Fetch.fetchWithInit url reqInit in
Js.Promise.(
promise
......@@ -257,9 +257,9 @@ module Fetch = struct
|> catch (fun _err -> resolve None)
)
(* Executes a fetch operation f for a path and react to failure or success *)
let fetch f path on_fail on_success =
let promise = f path in
(* Executes a fetch operation f for a target and react to failure or success *)
let fetch f target on_fail on_success =
let promise = f target in
Js.Promise.(
promise
|> then_ (fun result ->
......@@ -270,11 +270,11 @@ module Fetch = struct
|> ignore
)
(* Fetch the schema for a resource at the path and react to failure or success *)
let fetch_shema path on_fail on_success =
fetch do_fetch_schema path on_fail on_success
(* Fetch the schema for a resource at the target and react to failure or success *)
let fetch_shema target on_fail on_success =
fetch do_fetch_schema target on_fail on_success
(* Fetch the data for a resource at the path and react to failure or success *)
let fetch_data path on_fail on_success =
fetch do_fetch_data path on_fail on_success
(* Fetch the data for a resource at the target and react to failure or success *)
let fetch_data target on_fail on_success =
fetch do_fetch_data target 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