Update application workflow

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