diff options
| -rwxr-xr-x | editor/actions/actions.ml | 47 | ||||
| -rwxr-xr-x | editor/actions/add_page.ml | 44 | ||||
| -rwxr-xr-x | editor/actions/delete_page.ml | 37 | ||||
| -rwxr-xr-x | editor/actions/event.ml | 1 | ||||
| -rwxr-xr-x | editor/actions/load_page.ml | 12 | ||||
| -rwxr-xr-x | editor/app.ml | 91 | ||||
| -rwxr-xr-x | editor/editor.ml | 70 | ||||
| -rwxr-xr-x | editor/forms/add_page.ml | 40 | ||||
| -rwxr-xr-x | editor/forms/add_page.mli | 5 | ||||
| -rwxr-xr-x | editor/forms/delete_page.ml | 27 | ||||
| -rwxr-xr-x | editor/forms/delete_page.mli | 5 | ||||
| -rwxr-xr-x | editor/forms/events.ml | 15 | ||||
| -rwxr-xr-x | editor/forms/ui.ml | 58 |
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 ] |