Skip to content

GitLab

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

Adding new application framework

parent 20e36bfd0957
Hide whitespace changes
Inline Side-by-side
src/services/defaults.re
View file @ fb4820a8
let renderLoading =
(
_resources: Framework.StringMap.t(Framework.resource),
_state: Framework.appStateLoaded,
) =>
let renderLoading = (_state: Framework.appState) =>
<div> (ReasonReact.string("Loading")) </div>;
let renderRoot =
(
_resources: Framework.StringMap.t(Framework.resource),
_state: Framework.appStateLoaded,
) =>
let renderFailed = (_state: Framework.appState) =>
<div> (ReasonReact.string("Failed")) </div>;
let renderRoot = (_state: Framework.appState) =>
<div> (ReasonReact.string("Root")) </div>;
let renderCollection =
(
_resources: Framework.StringMap.t(Framework.resource),
_state: Framework.appStateLoaded,
) =>
let renderCollection = (_state: Framework.appState) =>
<div> (ReasonReact.string("Collection")) </div>;
let renderEntity =
(
_resources: Framework.StringMap.t(Framework.resource),
_state: Framework.appStateLoaded,
) =>
let renderEntity = (_state: Framework.appState) =>
<div> (ReasonReact.string("Entity")) </div>;
let defaultRegistry =
Framework.Create.registry([
Framework.Create.view(
"::defaults::Loading",
"Default loading view",
Framework.LoadingView,
0,
renderLoading,
),
Framework.Create.view(
"::defaults::Failed",
"Default failed view",
Framework.FailedView,
0,
renderFailed,
),
Framework.Create.view(
"::defaults::Root",
"Default root view",
......
src/services/framework.ml
View file @ fb4820a8
......@@ -20,6 +20,10 @@ let describe_requested data = match data with
(* Possible kind of views *)
type viewKind =
(* The view when loading *)
| LoadingView
(* The view when loading failed *)
| FailedView
(* A view for an application root *)
| RootView
(* A view for a collection of items *)
......@@ -62,8 +66,7 @@ type resource = {
(* Type of a rendering function *)
type renderer =
resource StringMap.t
-> appStateLoaded
appState
-> ReasonReact.reactElement
(* The definition of a view *)
......@@ -128,198 +131,278 @@ type appAction =
(* 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
(* Register a new view into a registry *)
let register_view (registry: viewRegistry) (view: view) = {
specifications = StringMap.add view.specification.location view.specification registry.specifications;
definitions = StringMap.add view.specification.location view registry.definitions;
}
(* Get the initial state for the application *)
let initial_state viewRegistry = Init(viewRegistry)
(* Apply the reduction on a GoTo action *)
let reduce_on_goto state target = match state with
| Loading({
location = _;
loaded = _;
requested = _;
registry = registry;
})
| Ready({
(* Follow a link *)
let follow_link link =
ReasonReact.Router.push link
(* Module for state management *)
module States : sig
(* Get the initial state for the application *)
val initial_state: viewRegistry -> appState
(* Default reduction function *)
val reduce: appAction -> appState -> (appState, 'retainedProps, appAction) ReasonReact.update
(* When the state has changed *)
val on_updated: (appState, 'retainedProps, appAction) ReasonReact.oldNewSelf -> unit
end = struct
(* Fold fetched data into a map of resources *)
let append_resource 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 viewRegistry = Init(viewRegistry)
(* Apply the reduction on a GoTo action *)
let reduce_on_goto state target = match state with
| Loading({
location = _;
resources = _;
loaded = _;
requested = _;
registry = registry;
})
| Failed(_, registry)-> ReasonReact.Update(Loading({
location = target;
loaded = StringMap.empty;
requested = [RequestedSchema(target)];
registry = registry;
}))
| Init(registry) -> ReasonReact.Update(Loading({
location = target;
loaded = StringMap.empty;
requested = [RequestedSchema(target)];
registry = registry;
}))
(* 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({
| Ready({
location = _;
resources = _;
registry = registry;
})
| Failed(_, registry)-> ReasonReact.Update(Loading({
location = target;
loaded = StringMap.empty;
requested = [RequestedSchema(target)];
registry = registry;
}))
| Init(registry) -> ReasonReact.Update(Loading({
location = target;
loaded = StringMap.empty;
requested = [RequestedSchema(target)];
registry = registry;
}))
(* 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 = _;
resources = _;
loaded = _;
requested = _;
registry = registry;
})
| Failed(_, registry)-> ReasonReact.Update(Failed("Failed to fetch " ^ what ^ " at " ^ target, registry))
| Init(registry) -> ReasonReact.Update(Failed("Failed to fetch " ^ what ^ " at " ^ target, registry))
(* 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 some data has been loaded *)
let on_loaded_data (self: (_, _, _) ReasonReact.self) fetchedData = begin
self.send(LoadingCompleted(fetchedData));
match fetchedData with
| FetchedSchema(target, schema) -> begin
match schema with
| Hypermedia.ArrayType(_)
| Hypermedia.ObjectType(_) -> begin
self.send(Request(RequestedData(target)));
()
end
| _ -> ()
end
| _ -> ()
| Ready({
location = _;
resources = _;
registry = registry;
})
| Failed(_, registry)-> ReasonReact.Update(Failed("Failed to fetch " ^ what ^ " at " ^ target, registry))
| Init(registry) -> ReasonReact.Update(Failed("Failed to fetch " ^ what ^ " at " ^ target, registry))
(* 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=append_resource fetchedData loaded; registry=registry}) else
Loading({location=location; loaded=append_resource fetchedData loaded; requested=requested; registry=registry}))
| Ready({
location = location;
resources = resources;
registry = registry;
}) -> ReasonReact.Update(Ready({location=location; resources=append_resource 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 some data has been loaded *)
let on_loaded_data (self: (_, _, _) ReasonReact.self) fetchedData = begin
self.send(LoadingCompleted(fetchedData));
match fetchedData with
| FetchedSchema(target, schema) -> begin
match schema with
| Hypermedia.ArrayType(_)
| Hypermedia.ObjectType(_) -> begin
self.send(Request(RequestedData(target)));
()
end
| _ -> ()
end
| _ -> ()
end
(* 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 -> (on_loaded_data self (FetchedData(target, data)))));
self.send(LaunchedRequest(requestedData))
end
| RequestedSchema(target) -> begin
(Hypermedia.Fetch.fetch_shema
target
(fun () -> self.send(LoadingFailed(requestedData)))
(fun schema -> (on_loaded_data self (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
| _ -> ()
end
(* 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 -> (on_loaded_data self (FetchedData(target, data)))));
self.send(LaunchedRequest(requestedData))
end
| RequestedSchema(target) -> begin
(Hypermedia.Fetch.fetch_shema
target
(fun () -> self.send(LoadingFailed(requestedData)))
(fun schema -> (on_loaded_data self (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
| _ -> ()
(* Follow a link *)
let follow_link link =
ReasonReact.Router.push link
(* Module for rendering *)
module Rendering : sig
end = struct
(* Select the view if it is appropriate for this kind *)
let best_of_1 (view: view) (kind: viewKind) = match view.specification.kind, kind with
| LoadingView, LoadingView
| FailedView, FailedView
| RootView, RootView
| CollectionView(_), CollectionView(_)
| EntityView(_), EntityView(_) -> Some(view)
| _ -> None
(* Select the best view between two views and the requested view kind *)
let best_of_2 (existing: view) (candidate: view) (kind: viewKind) = match existing.specification.kind, candidate.specification.kind, kind with
| LoadingView, LoadingView, LoadingView
| FailedView, FailedView, FailedView
| RootView, RootView, RootView -> if candidate.specification.priority > existing.specification.priority then Some(candidate) else Some(existing)
| CollectionView(et), CollectionView(ct), CollectionView(rt) -> (match et, ct, rt with
| None, None, _ -> if candidate.specification.priority > existing.specification.priority then Some(candidate) else Some(existing)
| None, Some(x), Some(rt) -> if x = rt then Some(candidate) else Some(existing)
| Some(_), Some(x), Some(rt) -> if x = rt && candidate.specification.priority > existing.specification.priority then Some(candidate) else Some(existing)
| _ -> Some(existing)
)
| _ -> Some(existing)
(* Select the appropriate view in a registry *)
let select_view (registry: viewRegistry) (kind: viewKind) =
StringMap.fold
(fun _key view result -> match result with
| None -> best_of_1 view kind
| Some(existing) -> best_of_2 existing view kind
)
registry.definitions
None
(* Determine the type of view for a resource *)
let view_kind_for_resource resource = match resource.schema with
| Some(Hypermedia.ObjectType(_)) -> EntityView(None)
| Some(Hypermedia.ArrayType(_)) -> CollectionView(None)
| _ -> RootView
(* Get the appropriate view and resources from the application state *)
let get_view state = match state with
| Init(registry)
| Loading({
location = _;
loaded = _;
requested = _;
registry = registry;
}) -> select_view registry LoadingView
| Failed(_, registry) -> select_view registry FailedView
| Ready({
location = location;
resources = resources;
registry = registry;
}) ->
let resource = StringMap.find location resources in
let kind = view_kind_for_resource resource in
select_view registry kind
(* Renders an application state *)
let render state =
let maybe_view = get_view state in
match maybe_view with
| None -> ReasonReact.null
| Some(view) -> view.renderer state
end
(* Module for creating views *)
module Create = struct
let view location name kind priority renderer = {
specification = {
......@@ -331,6 +414,12 @@ module Create = struct
renderer = renderer;
}
(* Register a new view into a registry *)
let register_view (registry: viewRegistry) (view: view) = {
specifications = StringMap.add view.specification.location view.specification registry.specifications;
definitions = StringMap.add view.specification.location view registry.definitions;
}
let registry (views: view list) =
List.fold_left
(fun registry view -> register_view registry view)
......
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