From fe2cced55e1b44dbae57e55fe0f459c85e7369cb Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 7 Feb 2022 16:21:26 +0100
Subject: Application unification
---
editor/actions/actions.ml | 47 ++++++++++++----------
editor/actions/add_page.ml | 44 +++++++++++++++++----
editor/actions/delete_page.ml | 37 ++++++++++++------
editor/actions/event.ml | 1 +
editor/actions/load_page.ml | 12 ++++++
editor/app.ml | 91 ++-----------------------------------------
editor/editor.ml | 70 ++++++++++++++++++++++++++++-----
editor/forms/add_page.ml | 40 +++----------------
editor/forms/add_page.mli | 5 ++-
editor/forms/delete_page.ml | 27 +++----------
editor/forms/delete_page.mli | 5 +++
editor/forms/events.ml | 15 -------
editor/forms/ui.ml | 58 ++++++++++++++-------------
13 files changed, 216 insertions(+), 236 deletions(-)
create mode 100755 editor/actions/load_page.ml
create mode 100755 editor/forms/delete_page.mli
delete mode 100755 editor/forms/events.ml
(limited to 'editor')
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 ]
--
cgit v1.2.3