Application unification

13 files changed, 216 insertions, 236 deletions

diff --git a/editor/actions/actions.ml b/editor/actions/actions.ml
index e8b4d71..b150279 100755
--- a/editor/actions/actions.ml
+++ b/editor/actions/actions.ml
@@ -7,16 +7,17 @@ module Event = Event
 
 type button_actions =
   { delete : Event.t Note.event
-  ; redirect : Jstr.t option Note.event
+  ; redirect : Event.t Note.event
   ; add: Event.t Note.event
   }
 
 let populate_menu
-  : Forms.Events.event option Note.E.send -> button_actions option
-  = fun sender ->
+  : unit -> button_actions option
+  = fun () ->
     match Blog.Sidebar.get () with
     | None -> None
     | Some element ->
+
       let () = Blog.Sidebar.clean element in
 
       let delete_button = El.button
@@ -39,24 +40,27 @@ let populate_menu
               ~at:At.[ class' (Jstr.v "fa")
                      ; class' (Jstr.v "fa-2x")
                      ; class' (Jstr.v "fa-plus") ] ]
-
       in
 
+      (* We are waiting for event inside another event ( form validation inside
+         popup creation.
+
+         Note.E.join is used here in order to get only te popup validation. *)
       let delete_event =
-        Evr.on_el
-          Ev.click
-          (fun _ -> Event.E
-              ( sender
-              , (module Delete_page: Event.Handler with type t = Delete_page.t)) )
-          delete_button
+        Note.E.join (
+          Evr.on_el
+            Ev.click
+            (fun _ -> Delete_page.create ())
+            delete_button)
 
+      (* Event on popup creation *)
       and add_event =
-        Evr.on_el
-          Ev.click
-          (fun _ -> Event.E
-              ( sender
-              , (module Add_page: Event.Handler with type t = Add_page.t)) )
-          add_button in
+        Note.E.join (
+          Evr.on_el
+            Ev.click
+            (fun _ -> Add_page.create ())
+            add_button) in
+
 
       let stored_pages = State.Storage.get_ids () in
       let pages =
@@ -73,8 +77,7 @@ let populate_menu
               El.li
                 [ El.a
                     ~at:[At.href target]
-                    [ El.txt name ] ]
-            ) in
+                    [ El.txt name ] ]) in
 
       (* Wait for a click on an existing page in order to sent the associated
          event.
@@ -82,17 +85,21 @@ let populate_menu
          We compose the resulting event with both :
          - the home button
          - the list for all the pages presents in the sidebar *)
+
+      let redirect_handler =
+        (module Load_page.M : Event.Handler with type t = Load_page.M.t ) in
+
       let redirect_event = Note.E.select
           (( Evr.on_el
                Ev.click
-               (fun _ -> None)
+               (fun _ -> Event.E (None, redirect_handler))
                home_button
            ) :: (
              List.map2 stored_pages pages
                ~f:(fun name el ->
                    Evr.on_el
                      Ev.click
-                     (fun _ -> Some name)
+                     (fun _ -> Event.E ((Some name), redirect_handler))
                      el ))) in
 
       let childs =
diff --git a/editor/actions/add_page.ml b/editor/actions/add_page.ml
index b817573..3ada726 100755
--- a/editor/actions/add_page.ml
+++ b/editor/actions/add_page.ml
@@ -1,11 +1,41 @@
-type t = Forms.Events.event option Note.E.send
+module Js = Js_of_ocaml.Js
 
-let apply
-  : t -> State.t -> State.t
-  = fun close_sender state ->
+module M = struct
+
+  type t = Forms.Add_page.t
+
+  let key_of_title
+    : Jstr.t -> Jstr.t
+    = fun title ->
+      title
+
+  let apply
+    : t -> State.t -> State.t
+    = fun {title} state ->
+      let page_id = key_of_title title in
+      let new_date = (new%js Js.date_now)##getTime in
+      let content_obj = object%js
+        val content = Js.null
+        val title = Js.some title
+        val date = Js.some new_date
+      end in
+      State.load_page (Some page_id) state content_obj
+end
+
+(** Create a new element *)
+let create
+  : unit -> Event.t Note.event
+  = fun () ->
     let title = Jstr.v "Nouvelle page" in
-    let popup = Forms.Ui.popup
+    let ev = Forms.Ui.popup
         ~title
         ~form:(Some (Forms.Add_page.create ()))
-        close_sender in
-    { state with window = popup::state.window}
+    in
+    Note.E.map
+      (fun v -> Event.E
+          (v
+          , (module M : Event.Handler with type t = M.t )))
+      (* Option.on_some trigger the event only when the pop up is validated.
+         Closing the popup doesn't do anything.
+      *)
+      (Note.E.Option.on_some ev)
diff --git a/editor/actions/delete_page.ml b/editor/actions/delete_page.ml
index cc15693..5c625bd 100755
--- a/editor/actions/delete_page.ml
+++ b/editor/actions/delete_page.ml
@@ -1,16 +1,29 @@
-type t = Forms.Events.event option Note.E.send
+module M = struct
 
-let apply
-  : t -> State.t -> State.t
-  = fun close_sender state ->
-    begin match state.page_id with
+  type t = unit
+
+  let apply
+    : t -> State.t -> State.t
+    = fun () state ->
+      match state.page_id with
       | None -> state
       | Some page_id ->
-        let title = Jstr.v "Confirmation" in
-        let popup = Forms.Ui.popup
-            ~title
-            ~form:(Some (Forms.Delete_page.create page_id))
-            close_sender in
-        { state with window = popup::state.window}
-    end
+        State.Storage.delete (fun () -> Some page_id);
+        let json = State.Storage.load None in
+        State.load_page None state json
+
+end
 
+let create
+  : unit -> Event.t Note.event
+  = fun () ->
+    let title = Jstr.v "Confirmation" in
+    let ev = Forms.Ui.popup
+        ~title
+        ~form:(Some (Forms.Delete_page.create () ))
+    in
+    Note.E.map
+      (fun v -> Event.E
+          ( v
+          , (module M : Event.Handler with type t = M.t )))
+      (Note.E.Option.on_some ev)
diff --git a/editor/actions/event.ml b/editor/actions/event.ml
index 5e30587..21e3d3a 100755
--- a/editor/actions/event.ml
+++ b/editor/actions/event.ml
@@ -1,4 +1,5 @@
 module type Handler = sig
+
   type t
 
   val apply: t -> State.t -> State.t
diff --git a/editor/actions/load_page.ml b/editor/actions/load_page.ml
new file mode 100755
index 0000000..eb4afac
--- /dev/null
+++ b/editor/actions/load_page.ml
@@ -0,0 +1,12 @@
+module M = struct
+
+  type t = Jstr.t option
+
+  let apply
+    : t -> State.t -> State.t
+    = fun page_id state ->
+      let json = State.Storage.load page_id in
+      State.load_page page_id state json
+
+end
+
diff --git a/editor/app.ml b/editor/app.ml
index 4559044..9edc947 100755
--- a/editor/app.ml
+++ b/editor/app.ml
@@ -1,92 +1,7 @@
-open Brr
-module Js = Js_of_ocaml.Js
-
-type events =
-  | StoreEvent
-  | LoadEvent of Jstr.t option
-  | ClosePopup of Forms.Events.event option
-  | Generic of Actions.Event.t
-
-let key_of_title
-  : Jstr.t -> Jstr.t
-  = fun title ->
-    title
-
 (** [update] is the event loop.
 
     The function take a new event, and apply it to the current state. *)
-
 let update
-  : (events, State.t) Application.t
-  = fun event state ->
-    match event with
-
-    | Generic (E (t, (module EventHandler))) ->
-      EventHandler.apply t state
-
-
-    | ClosePopup result ->
-      (* First close the last popin. *)
-      let state = match state.window with
-        | []     -> { state with window = [] }
-        | el::tl -> El.remove el
-                  ; { state with window = tl } in
-      (* Call the handler associated with the event *)
-      begin match result with
-        | None -> state
-        | Some (Event (t, (module Handler))) ->
-          Handler.on_close t state
-      end
-
-    | StoreEvent ->
-
-      let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
-      let content = Option.map
-          (fun el -> El.prop (El.Prop.value) el)
-          title_element in
-
-      let new_date = (new%js Js.date_now)##getTime in
-      let content_obj = object%js
-        val content = Js.some @@ Jv.Id.to_jv (state.view##.state##toJSON ())
-        val title = Js.Opt.option content
-        val date = Js.some new_date
-      end in
-      let save = State.Storage.save
-          content_obj
-          state.page_id
-          ~check:(fun previous_state ->
-              Js.Opt.case previous_state##.date
-                (fun () -> true)
-                (fun date ->
-                   (* I do not figure how the previous date could be older
-                      than the last backup. It could be either :
-
-                      - equal (if we are the only one to update it)
-                      - more recent (if the content has been updated elsewhere)
-
-                      but older shoud be a bug. *)
-                   let is_ok = date <= state.last_backup in
-                   if (not is_ok) then (
-                     let open Console in
-                     log
-                       [ Jstr.v "Last backup date is "
-                       ; new%js Js.date_fromTimeValue state.last_backup
-                       ; Jstr.v " but date is "
-                       ; new%js Js.date_fromTimeValue date] );
-                   is_ok)) in
-      begin match save with
-        | Ok true -> { state with last_backup = new_date }
-        | Ok false ->
-          Console.(log [Jstr.v "Didn't save"]);
-          state
-        | Error other ->
-          (* TODO In case of error, notify the user *)
-          Console.(log [Jstr.v "Couldn't save" ; other]);
-          state
-      end
-
-    | LoadEvent page_id ->
-      let json = State.Storage.load page_id in
-      State.load_page page_id state json
-
-
+  : (Actions.Event.t, State.t) Application.t
+  = fun (E (t, (module EventHandler))) state ->
+    EventHandler.apply t state
diff --git a/editor/editor.ml b/editor/editor.ml
index bca8fb2..a991b25 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -55,15 +55,63 @@ let build_view
         props in
     view, last_backup
 
+module Store = struct
+  type t = unit
+
+  let apply
+    : t -> State.t -> State.t
+    = fun () state ->
+      let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
+      let content = Option.map
+          (fun el -> El.prop (El.Prop.value) el)
+          title_element in
+
+      let new_date = (new%js Js.date_now)##getTime in
+      let content_obj = object%js
+        val content = Js.some @@ Jv.Id.to_jv (state.view##.state##toJSON ())
+        val title = Js.Opt.option content
+        val date = Js.some new_date
+      end in
+      let save = State.Storage.save
+          content_obj
+          state.page_id
+          ~check:(fun previous_state ->
+              Js.Opt.case previous_state##.date
+                (fun () -> true)
+                (fun date ->
+                   (* I do not figure how the previous date could be older
+                      than the last backup. It could be either :
+
+                      - equal (if we are the only one to update it)
+                      - more recent (if the content has been updated elsewhere)
+
+                      but older shoud be a bug. *)
+                   let is_ok = date <= state.last_backup in
+                   if (not is_ok) then (
+                     let open Console in
+                     log
+                       [ Jstr.v "Last backup date is "
+                       ; new%js Js.date_fromTimeValue state.last_backup
+                       ; Jstr.v " but date is "
+                       ; new%js Js.date_fromTimeValue date] );
+                   is_ok)) in
+      begin match save with
+        | Ok true -> { state with last_backup = new_date }
+        | Ok false ->
+          Console.(log [Jstr.v "Didn't save"]);
+          state
+        | Error other ->
+          (* TODO In case of error, notify the user *)
+          Console.(log [Jstr.v "Couldn't save" ; other]);
+          state
+      end
+end
 
-let app id content =
 
-  (* This event is used in the pop process. The sender is given to the
-     subroutine in order to track the window closing *)
-  let (event: Forms.Events.event option Note.event), sender = Note.E.create () in
+let app id content =
 
   (* Check the pre-requisite *)
-  let events_opt = Actions.populate_menu sender in
+  let events_opt = Actions.populate_menu () in
   match (Jv.is_none id), (Jv.is_none content), events_opt with
   | false, false, Some btn_events ->
 
@@ -80,11 +128,13 @@ let app id content =
         (App.update )
         init_state
         (Note.E.select
-           [ Brr_note.Evr.on_el Ev.focusout (fun _ -> App.StoreEvent) editor
-           ; Note.E.map (fun ev -> App.Generic ev)  btn_events.Actions.delete
-           ; Note.E.map (fun ev -> App.Generic ev)     btn_events.Actions.add
-           ; Note.E.map (fun v  -> App.LoadEvent v)  btn_events.Actions.redirect
-           ; Note.E.map (fun v  -> App.ClosePopup v) event
+           [ Brr_note.Evr.on_el Ev.focusout (fun _ ->
+                 (Actions.Event.E
+                    ( ()
+                    , (module Store:Actions.Event.Handler with type t = Store.t)))) editor
+           ; Note.E.map (fun ev -> ev) btn_events.Actions.delete
+           ; Note.E.map (fun ev -> ev) btn_events.Actions.add
+           ; Note.E.map (fun v  -> v)  btn_events.Actions.redirect
            ]) in
 
     let () =
diff --git a/editor/forms/add_page.ml b/editor/forms/add_page.ml
index edcbc37..08fb5d7 100755
--- a/editor/forms/add_page.ml
+++ b/editor/forms/add_page.ml
@@ -1,34 +1,10 @@
 open Brr
 open Brr_note
-open Note
-module Js = Js_of_ocaml.Js
 
-
-module Handler = struct
-
-  type t = { title : Jstr.t }
-
-  let key_of_title
-    : Jstr.t -> Jstr.t
-    = fun title ->
-      title
-
-  let on_close
-    : t -> State.t -> State.t
-    = fun {title} state ->
-      let page_id = key_of_title title in
-      let new_date = (new%js Js.date_now)##getTime in
-      let content_obj = object%js
-        val content = Js.null
-        val title = Js.some title
-        val date = Js.some new_date
-      end in
-      State.load_page (Some page_id) state content_obj
-
-end
+type t = { title : Jstr.t }
 
 let create
-  : unit -> Events.t
+  : unit -> t Note.signal * El.t
   = fun () ->
 
     (* The element which contains the information *)
@@ -37,18 +13,14 @@ let create
     in
 
     let init =
-      Events.Event
-        ( Handler.{ title = Jstr.empty }
-        , (module Handler : Events.Handler with type t = Handler.t)) in
+      ( { title = Jstr.empty }
+      ) in
 
     let state =
-      S.hold init
+      Note.S.hold init
       @@ Evr.on_el
         (Ev.input)
-        (fun _ ->
-           Events.Event
-             ( Handler.{ title = El.prop El.Prop.value input }
-             , (module Handler : Events.Handler with type t = Handler.t)) )
+        (fun _ -> { title = El.prop El.Prop.value input })
         input in
 
     ( state
diff --git a/editor/forms/add_page.mli b/editor/forms/add_page.mli
index 8a4ff6f..10badd6 100755
--- a/editor/forms/add_page.mli
+++ b/editor/forms/add_page.mli
@@ -1,2 +1,5 @@
+type t = { title : Jstr.t }
+
 val create
-  : unit -> Events.t
+  : unit -> t Note.signal * Brr.El.t
+
diff --git a/editor/forms/delete_page.ml b/editor/forms/delete_page.ml
index eb36560..37b1c32 100755
--- a/editor/forms/delete_page.ml
+++ b/editor/forms/delete_page.ml
@@ -1,34 +1,17 @@
 open Brr
 open Note
 
-module Handler = struct
-
-  type t = Jstr.t
-
-  let on_close
-    : t -> State.t -> State.t
-    = fun id state ->
-      State.Storage.delete (fun () -> Some id);
-      let json = State.Storage.load None in
-      State.load_page None state json
-end
+type t = unit
 
 let create
-  : Jstr.t -> Events.t
-  = fun name ->
-
-    let state =
-      S.const
-        (Events.Event
-           ( name
-           , (module Handler: Events.Handler with type t = Handler.t))) in
+  : unit -> t Note.signal * El.t
+  = fun () ->
+    let state = S.const () in
 
     let message = begin
       let open Jstr in
 
-      (v "La page ")
-      + name
-      + (v " sera définitivement supprimée")
+      (v "La page sera définitivement supprimée")
     end in
 
     ( state
diff --git a/editor/forms/delete_page.mli b/editor/forms/delete_page.mli
new file mode 100755
index 0000000..0a3d9f9
--- /dev/null
+++ b/editor/forms/delete_page.mli
@@ -0,0 +1,5 @@
+type t = unit
+
+val create
+  : unit -> t Note.signal * Brr.El.t
+
diff --git a/editor/forms/events.ml b/editor/forms/events.ml
deleted file mode 100755
index 28780d9..0000000
--- a/editor/forms/events.ml
+++ /dev/null
@@ -1,15 +0,0 @@
-module type Handler = sig
-
-  type t
-
-  val on_close: t -> State.t -> State.t
-
-end
-
-type event = Event : 'a * (module Handler with type t = 'a) -> event
-
-(* The type is both the form handler, the form value, and the HTML element
-   which contains the form.
-
-   The signal has to be log in order to be completely working. *)
-type t = event Note.signal * Brr.El.t
diff --git a/editor/forms/ui.ml b/editor/forms/ui.ml
index d8a259a..53039c4 100755
--- a/editor/forms/ui.ml
+++ b/editor/forms/ui.ml
@@ -3,8 +3,8 @@ open Brr_note
 module Js = Js_of_ocaml.Js
 
 let popup
-  : title:Jstr.t -> ?form:Events.t option -> Events.event option Note.E.send -> El.t
-  = fun ~title ?(form = None) send ->
+  : ?form:('a Note.signal * El.t) option -> title:Jstr.t -> 'a option Note.event
+  = fun ?(form = None) ~title ->
 
     (* Ensure we keep a track for the signal event.
 
@@ -17,15 +17,10 @@ let popup
     let close_btn =
       El.span
         ~at:At.[class' (Jstr.v "modal-close")]
-        [ El.txt' "×"] in
+        [ El.txt' "×"]
 
-    Evr.endless_listen
-      (El.as_target close_btn)
-      Ev.click
-      (fun _ ->
-         Option.iter Note.Logr.destroy log_opt;
-         send None
-      );
+    and submit_btn = El.input ()
+        ~at:At.[type' (Jstr.v "submit")] in
 
     let container = match form with
       | None -> El.div
@@ -37,23 +32,12 @@ let popup
 
     and footer = match form with
       | None -> El.txt Jstr.empty
-      | Some (values, _) ->
+      | Some _ ->
 
-        let btn = El.input ()
-            ~at:At.[type' (Jstr.v "submit")] in
-
-        Evr.endless_listen
-          (El.as_target btn)
-          Ev.click
-          (fun _ ->
-             Option.iter Note.Logr.force log_opt;
-             let form_content = (Note.S.value values) in
-             Option.iter Note.Logr.destroy log_opt;
-             send (Some form_content));
-
-        El.div [ btn ]
+        El.div [ submit_btn ]
           ~at:At.[class' (Jstr.v "row")] in
 
+    (* HTML Element creation *)
     let el = El.div
         ~at:At.[class' (Jstr.v "modal")]
         [ container
@@ -70,6 +54,26 @@ let popup
                 ~at:At.[class' (Jstr.v "modal-footer")]
                 [ footer ]]] in
 
-    El.append_children (Document.body G.document)
-      [ el ]
-  ; el
+    let () = El.append_children (Document.body G.document)
+        [ el ] in
+
+    (* Event handler *)
+    let close_event = Evr.on_el
+        Ev.click
+        (fun _ ->
+           El.remove el;
+           Option.iter Note.Logr.destroy log_opt;
+           None)
+        close_btn
+
+    and submit_event = Evr.on_el
+        Ev.click
+        (fun _ ->
+           El.remove el;
+           Option.iter Note.Logr.destroy log_opt;
+           Option.map (fun v -> Note.S.value (fst v)) form)
+        submit_btn in
+
+    Note.E.select
+      [ close_event
+      ; submit_event ]