summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xcss/merger.ml36
-rwxr-xr-xlib/application/application.ml58
-rwxr-xr-xscript.it/script.ml23
-rwxr-xr-xscript.it/state/state.ml18
4 files changed, 71 insertions, 64 deletions
diff --git a/css/merger.ml b/css/merger.ml
index 514793d..d82df98 100755
--- a/css/merger.ml
+++ b/css/merger.ml
@@ -20,6 +20,8 @@ type state =
; elements : int
}
+module App = Application.Make(struct type t = state end)
+
let init =
{ files = new%js Js.array_empty
; result_css = None
@@ -42,20 +44,10 @@ let build_result
Css_lib.Merge.extract_css
merge_result
-module type Handler = sig
-
- type t
-
- val apply: t -> state -> state
-
-end
-
-type event = E : 'a * (module Handler with type t = 'a) -> event
-
module AddFile = struct
type t = file
- let apply file state =
+ let update file state =
let _ = state.files##push file in
let elements = state.files##.length
and result_css = build_result state.files in
@@ -64,7 +56,7 @@ end
module DelFile = struct
type t = File.t
- let apply file state =
+ let update file state =
let files = state.files##filter
(Js.wrap_callback @@ (fun elt _ _ -> Js.bool (elt.file != file))) in
let elements = files##.length
@@ -72,13 +64,6 @@ module DelFile = struct
{ files ; elements ; result_css }
end
-let do_action
- : (event, state) Application.t
- = fun (E (t, (module Handler))) state ->
- Handler.apply t state
-
-type file_event = event S.t
-
(** Read the content from the file *)
let file_loader
: file E.send -> File.t -> unit
@@ -119,7 +104,7 @@ let header =
block
let file_list
- : event E.send -> file -> El.t
+ : App.event E.send -> file -> El.t
= fun sender f ->
let icon =
El.i []
@@ -139,8 +124,8 @@ let file_list
Ev.listen
Ev.click
(fun _ -> sender (
- E( f.file
- , (module DelFile : Handler with type t = DelFile.t))))
+ App.E( f.file
+ , (module DelFile : App.Event with type t = DelFile.t))))
(El.as_target button);
match f.css with
@@ -248,13 +233,12 @@ let main id =
let state =
- Application.run
- do_action
+ App.run
init
(E.select
[ E.map (fun f ->
- E ( f
- , (module AddFile: Handler with type t = AddFile.t )))
+ App.E ( f
+ , (module AddFile: App.Event with type t = AddFile.t )))
add_file_event
; del_file_event
])
diff --git a/lib/application/application.ml b/lib/application/application.ml
index 15452fb..63e12ba 100755
--- a/lib/application/application.ml
+++ b/lib/application/application.ml
@@ -1,9 +1,49 @@
-(** The type for the applcation *)
-type ('a, 'b) t = 'a -> 'b -> 'b
-
-(** Simple helper for the main event loop *)
-let run
- : ?eq:('b -> 'b -> bool) -> ('a, 'b) t -> 'b -> 'a Note.E.t -> 'b Note.S.t
- = fun ?eq f init event ->
- let action = Note.E.map f event in
- Note.S.accum ?eq init action
+(** The Make module build the main application loop.contents
+
+ The function [run] update the state on each event, and return a new state.
+ Each event must follow the [event] type, which is composed from the type
+ [t], and a module with a fonction [update].
+
+ This example create an application with the state containing a simple
+ counter. An even which increment this counter is created and can be used to
+ update the state.
+
+
+ [
+ type state = { value : int }
+
+ (** Increment the state *)
+ module Incr = struct
+ type t = unit
+
+ let update () state = { value = state.value + 1 }
+ end
+
+ module App = Make(struct type t = state end)
+
+ (* Create the event itself *)
+ let incr_event = App.E ((), (module Incr:App.Event with type t = Incr.t))
+
+ ]
+
+*)
+module Make(S:sig type t end) = struct
+ module type Event = sig
+
+ type t
+
+ val update: t -> S.t -> S.t
+
+ end
+
+ type event = E : 'a * (module Event with type t = 'a) -> event
+
+ (** Simple helper for the main event loop *)
+ let run
+ : ?eq:(S.t -> S.t -> bool) -> S.t -> event Note.E.t -> S.t Note.S.t
+ = fun ?eq init event ->
+ let action = Note.E.map (fun (E (t, (module Event))) st -> Event.update t st) event in
+ Note.S.accum ?eq init action
+end
+
+
diff --git a/script.it/script.ml b/script.it/script.ml
index 29bf2c9..6c2b5d3 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -87,7 +87,7 @@ type 'a param_events =
; angle : float S.t
; export : unit E.t
; delete : unit E.t
- ; rendering : State.events E.t
+ ; rendering : State.event E.t
}
type slider =
@@ -174,7 +174,7 @@ let set_sidebar
State.E
( render_type
- , (module M: State.Handler with type t = Layer.Paths.printer ))
+ , (module M: State.Event with type t = Layer.Paths.printer ))
) rendering' in
@@ -377,7 +377,7 @@ let page_main id =
let module Delete = Script_event.Delete in
State.E
( Delete.{ worker }
- , (module Delete: State.Handler with type t = Delete.t )))
+ , (module Delete: State.Event with type t = Delete.t )))
parameters.delete
and export_event =
@@ -385,21 +385,21 @@ let page_main id =
let module Export = Script_event.Export in
State.E
( ()
- , (module Export: State.Handler with type t = Export.t )))
+ , (module Export: State.Event with type t = Export.t )))
parameters.export
and angle_event = S.changes parameters.angle
|> E.map (fun value ->
let module Property = Script_event.Property in
State.E
( Property.{ value ; worker ; prop = `Angle }
- , (module Property: State.Handler with type t = Property.t )))
+ , (module Property: State.Event with type t = Property.t )))
and width_event = S.changes parameters.width
|> E.map (fun value ->
let module Property = Script_event.Property in
State.E
( Property.{ value ; worker ; prop = `Width }
- , (module Property: State.Handler with type t = Property.t )))
+ , (module Property: State.Event with type t = Property.t )))
and worker_event = Note.E.filter_map
(function
| `Other t ->
@@ -410,7 +410,7 @@ let page_main id =
Some (
State.E
( outline
- , (module Complete_path: State.Handler with type t = Complete_path.t ))))
+ , (module Complete_path: State.Event with type t = Complete_path.t ))))
worker_event
in
@@ -439,13 +439,13 @@ let page_main id =
let module MouseDown = Script_event.Mouse_down in
State.E
( MouseDown.{ position = c ; timer }
- , (module MouseDown: State.Handler with type t = MouseDown.t ))
+ , (module MouseDown: State.Event with type t = MouseDown.t ))
| `Out c ->
let module Click = Script_event.Click in
State.E
( Click.{ point = c ; worker; timer }
- , (module Click: State.Handler with type t = Click.t ))
+ , (module Click: State.Event with type t = Click.t ))
) canva_events in
let tick_event =
@@ -456,14 +456,13 @@ let page_main id =
Option.map (fun p ->
State.E
( (f, p)
- , (module Tick: State.Handler with type t = Tick.t )))
+ , (module Tick: State.Event with type t = Tick.t )))
pos ) in
(* The first evaluation is the state. Which is the result of all the
successives events to the initial state *)
let state =
- Application.run
- State.do_action
+ State.run
State.init
(E.select
[ worker_event
diff --git a/script.it/state/state.ml b/script.it/state/state.ml
index e8cd87e..f3be91d 100755
--- a/script.it/state/state.ml
+++ b/script.it/state/state.ml
@@ -19,17 +19,7 @@ type state =
; mouse_down_position : Gg.v2
}
-module type Handler = sig
-
- type t
-
- val update: t -> state -> state
-
-end
-
-type t = E : 'a * (module Handler with type t = 'a) -> t
-
-type events = t
+include Application.Make(struct type t = state end)
let post
: Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
@@ -73,12 +63,6 @@ let select_segment _ (_, selected, p0, p1) state dist =
; width }
-let do_action
- : (events, state) Application.t
- = fun (E (t, (module Handler))) state ->
- Handler.update t state
-
-
let init =
{ paths = []
; current = Path.Path_Builder.empty