From 47e4ab0cf1b7d364439a1a47df53f2d58a216239 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Fri, 3 Dec 2021 04:37:14 +0100
Subject: Helper to build application events

---
 editor/actions/add_page.ml       |  4 +---
 editor/actions/delete_page.ml    |  4 +---
 editor/actions/editor_actions.ml |  7 ++-----
 editor/actions/export.ml         |  5 +----
 editor/actions/import.ml         |  4 +---
 editor/actions/to_markdown.ml    |  4 +---
 editor/app/editor_app.ml         | 11 ++++++++++-
 editor/app/editor_app.mli        |  2 ++
 editor/editor.ml                 |  5 +----
 9 files changed, 20 insertions(+), 26 deletions(-)

(limited to 'editor')

diff --git a/editor/actions/add_page.ml b/editor/actions/add_page.ml
index 5e52d43..1da8e3f 100755
--- a/editor/actions/add_page.ml
+++ b/editor/actions/add_page.ml
@@ -36,9 +36,7 @@ let create
         ()
     in
     Note.E.map
-      (fun v -> App.E
-          (v
-          , (module M : App.Event with type t = M.t )))
+      (fun v -> App.ev (module M) v)
       (* Option.on_some trigger the event only when the pop up is validated.
          Closing the popup doesn't do anything.
       *)
diff --git a/editor/actions/delete_page.ml b/editor/actions/delete_page.ml
index 7fa609b..858f6b9 100755
--- a/editor/actions/delete_page.ml
+++ b/editor/actions/delete_page.ml
@@ -27,7 +27,5 @@ let create
         ()
     in
     Note.E.map
-      (fun v -> App.E
-          ( v
-          , (module M : App.Event with type t = M.t )))
+      (fun v -> App.ev (module M) v)
       (Note.E.Option.on_some ev)
diff --git a/editor/actions/editor_actions.ml b/editor/actions/editor_actions.ml
index 48974c0..8ff2cab 100755
--- a/editor/actions/editor_actions.ml
+++ b/editor/actions/editor_actions.ml
@@ -108,9 +108,6 @@ let build
     in
 
 
-    let redirect_handler =
-      (module Load_page.M : App.Event with type t = Load_page.M.t ) in
-
     let ul = El.ul [] in
 
     (* Wait for a click on an existing page in order to sent the associated
@@ -128,14 +125,14 @@ let build
       Note.E.select
         [ Evr.on_el
             Ev.click
-            (fun _ -> App.E (None, redirect_handler))
+            (fun _ -> App.ev (module Load_page.M) None)
             home_button
         ; Evr.on_el
             Ev.click
             (fun ev ->
                let el = Jv.Id.of_jv @@ Jv.Id.to_jv @@ Ev.target ev in
                let name = El.at note_id_attribute el in
-               App.E (name, redirect_handler))
+               App.ev (module Load_page.M) name)
             ul ] in
 
     let childs =
diff --git a/editor/actions/export.ml b/editor/actions/export.ml
index 657e0da..ea4f8ce 100755
--- a/editor/actions/export.ml
+++ b/editor/actions/export.ml
@@ -33,7 +33,4 @@ end
 (** Create a new element *)
 let create
   : unit -> App.event
-  = fun () ->
-    App.E
-      ( ()
-      , (module M : App.Event with type t = M.t ))
+  = fun () -> App.ev (module M) ()
diff --git a/editor/actions/import.ml b/editor/actions/import.ml
index c847ed3..da74b50 100755
--- a/editor/actions/import.ml
+++ b/editor/actions/import.ml
@@ -54,7 +54,5 @@ let create () =
   in
 
   Note.E.map
-    (fun v -> App.E
-        ( v
-        , (module M : App.Event with type t = M.t )))
+    (fun v -> App.ev (module M) v)
     (Note.E.Option.on_some ev)
diff --git a/editor/actions/to_markdown.ml b/editor/actions/to_markdown.ml
index 80191f9..f3c6517 100755
--- a/editor/actions/to_markdown.ml
+++ b/editor/actions/to_markdown.ml
@@ -291,6 +291,4 @@ end
 let create
   : PM.t -> App.event
   = fun pm ->
-    App.E
-      ( pm
-      , (module ToMarkdown : App.Event with type t = ToMarkdown.t ))
+    App.ev (module ToMarkdown) pm
diff --git a/editor/app/editor_app.ml b/editor/app/editor_app.ml
index 2d23cfb..e4c944a 100644
--- a/editor/app/editor_app.ml
+++ b/editor/app/editor_app.ml
@@ -1 +1,10 @@
-include Application.Make(struct type t = State.t end)
+module App = Application.Make(struct type t = State.t end)
+
+let ev
+ : (module App.Event with type t = 's) -> 's -> App.event
+ = fun (type s) (module M: App.Event with type t = s) v ->
+    App.E
+      ( v
+      , (module M : App.Event with type t = M.t ))
+
+include App
diff --git a/editor/app/editor_app.mli b/editor/app/editor_app.mli
index 3c7646b..dade546 100644
--- a/editor/app/editor_app.mli
+++ b/editor/app/editor_app.mli
@@ -12,3 +12,5 @@ type event = E : 'a * (module Event with type t = 'a) -> event
 val run
   : ?eq:(State.t -> State.t -> bool) -> State.t -> event Note.E.t -> State.t Note.S.t
 
+val ev
+ : (module Event with type t = 's) -> 's -> event
diff --git a/editor/editor.ml b/editor/editor.ml
index d272f56..ee2ee0d 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -145,10 +145,7 @@ let app id content =
         init_state
         (Note.E.select
            [ Brr_note.Evr.on_els Ev.focusout
-               (fun _ _ ->
-                  App.E
-                    ( title
-                    , (module Store:App.Event with type t = Store.t)))
+               (fun _ _ -> App.ev (module Store) title)
                [ editor ; title ]
            ; btn_events
            ]) in
-- 
cgit v1.2.3