diff options
| -rwxr-xr-x | editor/actions.ml | 120 | ||||
| -rwxr-xr-x | editor/actions/actions.ml | 128 | ||||
| -rwxr-xr-x | editor/actions/add_page.ml | 11 | ||||
| -rwxr-xr-x | editor/actions/delete_page.ml | 16 | ||||
| -rwxr-xr-x | editor/actions/dune | 13 | ||||
| -rwxr-xr-x | editor/actions/event.ml | 8 | ||||
| -rwxr-xr-x | editor/app.ml | 50 | ||||
| -rwxr-xr-x | editor/dune | 1 | ||||
| -rwxr-xr-x | editor/editor.ml | 27 | ||||
| -rwxr-xr-x | editor/forms/add_page.ml | 1 | ||||
| -rwxr-xr-x | editor/forms/delete_page.ml | 6 | ||||
| -rwxr-xr-x | editor/forms/events.ml | 5 | ||||
| -rwxr-xr-x | editor/forms/ui.ml (renamed from editor/ui.ml) | 2 | ||||
| -rwxr-xr-x | editor/state/state.ml | 26 | ||||
| -rwxr-xr-x | editor/state/state.mli | 6 | ||||
| -rwxr-xr-x | editor/state/storage.ml | 3 |
16 files changed, 241 insertions, 182 deletions
diff --git a/editor/actions.ml b/editor/actions.ml deleted file mode 100755 index 0f107f9..0000000 --- a/editor/actions.ml +++ /dev/null @@ -1,120 +0,0 @@ -open StdLabels -open Js_of_ocaml -open Brr -open Brr_note - -type button_actions = - { delete : unit Note.event - ; redirect : Jstr.t option Note.event - ; add: unit Note.event - } - -let populate_menu () = - match Blog.Sidebar.get () with - | None -> None - | Some element -> - let () = Blog.Sidebar.clean element in - - let delete_button = El.button - ~at:At.[ class' (Jstr.v "action-button") ] - [ El.i [] - ~at:At.[ class' (Jstr.v "fa") - ; class' (Jstr.v "fa-2x") - ; class' (Jstr.v "fa-trash") ] ] - - and home_button = El.button - ~at:At.[ class' (Jstr.v "action-button") ] - [ El.i [] - ~at:At.[ class' (Jstr.v "fa") - ; class' (Jstr.v "fa-2x") - ; class' (Jstr.v "fa-home") ] ] - - and add_button = El.button - ~at:At.[ class' (Jstr.v "action-button") ] - [ El.i [] - ~at:At.[ class' (Jstr.v "fa") - ; class' (Jstr.v "fa-2x") - ; class' (Jstr.v "fa-plus") ] ] - - in - - let delete_event = - Evr.on_el - Ev.click - Evr.unit - delete_button - - and add_event = - Evr.on_el - Ev.click - Evr.unit - add_button in - - let stored_pages = State.Storage.get_ids () in - let pages = - List.map - stored_pages - ~f:(fun id -> - - let name_opt = (State.Storage.load (Some id))##.title in - let name = Js.Opt.get - name_opt - (fun () -> id) in - - let target = Jstr.v "#" in - El.li - [ El.a - ~at:[At.href target] - [ El.txt name ] ] - ) in - - (* Wait for a click on an existing page in order to sent the associated - event. - - We compose the resulting event with both : - - the home button - - the list for all the pages presents in the sidebar *) - let redirect_event = Note.E.select - (( Evr.on_el - Ev.click - (fun _ -> None) - home_button - ) :: ( - List.map2 stored_pages pages - ~f:(fun name el -> - Evr.on_el - Ev.click - (fun _ -> Some name) - el ))) in - - let childs = - [ home_button - ; add_button - ; El.button - ~at:At.[class' (Jstr.v "action-button")] - [ El.i - [] - ~at:At.[ class' (Jstr.v "fa") - ; class' (Jstr.v "fa-2x") - ; class' (Jstr.v "fa-download") ] - ] - ; delete_button - ; El.button - ~at:At.[class' (Jstr.v "action-button")] - [ El.i - [] - ~at:At.[ class' (Jstr.v "fa") - ; class' (Jstr.v "fa-2x") - ; class' (Jstr.v "fa-cog") ] - ] - ; El.hr () - ; El.ul - pages - ] in - - let () = El.append_children element childs in - Some - { delete = delete_event - ; redirect = redirect_event - ; add = add_event - } diff --git a/editor/actions/actions.ml b/editor/actions/actions.ml new file mode 100755 index 0000000..e8b4d71 --- /dev/null +++ b/editor/actions/actions.ml @@ -0,0 +1,128 @@ +open StdLabels +open Js_of_ocaml +open Brr +open Brr_note + +module Event = Event + +type button_actions = + { delete : Event.t Note.event + ; redirect : Jstr.t option Note.event + ; add: Event.t Note.event + } + +let populate_menu + : Forms.Events.event option Note.E.send -> button_actions option + = fun sender -> + match Blog.Sidebar.get () with + | None -> None + | Some element -> + let () = Blog.Sidebar.clean element in + + let delete_button = El.button + ~at:At.[ class' (Jstr.v "action-button") ] + [ El.i [] + ~at:At.[ class' (Jstr.v "fa") + ; class' (Jstr.v "fa-2x") + ; class' (Jstr.v "fa-trash") ] ] + + and home_button = El.button + ~at:At.[ class' (Jstr.v "action-button") ] + [ El.i [] + ~at:At.[ class' (Jstr.v "fa") + ; class' (Jstr.v "fa-2x") + ; class' (Jstr.v "fa-home") ] ] + + and add_button = El.button + ~at:At.[ class' (Jstr.v "action-button") ] + [ El.i [] + ~at:At.[ class' (Jstr.v "fa") + ; class' (Jstr.v "fa-2x") + ; class' (Jstr.v "fa-plus") ] ] + + in + + 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 + + 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 + + let stored_pages = State.Storage.get_ids () in + let pages = + List.map + stored_pages + ~f:(fun id -> + + let name_opt = (State.Storage.load (Some id))##.title in + let name = Js.Opt.get + name_opt + (fun () -> id) in + + let target = Jstr.v "#" in + El.li + [ El.a + ~at:[At.href target] + [ El.txt name ] ] + ) in + + (* Wait for a click on an existing page in order to sent the associated + event. + + We compose the resulting event with both : + - the home button + - the list for all the pages presents in the sidebar *) + let redirect_event = Note.E.select + (( Evr.on_el + Ev.click + (fun _ -> None) + home_button + ) :: ( + List.map2 stored_pages pages + ~f:(fun name el -> + Evr.on_el + Ev.click + (fun _ -> Some name) + el ))) in + + let childs = + [ home_button + ; add_button + ; El.button + ~at:At.[class' (Jstr.v "action-button")] + [ El.i + [] + ~at:At.[ class' (Jstr.v "fa") + ; class' (Jstr.v "fa-2x") + ; class' (Jstr.v "fa-download") ] + ] + ; delete_button + ; El.button + ~at:At.[class' (Jstr.v "action-button")] + [ El.i + [] + ~at:At.[ class' (Jstr.v "fa") + ; class' (Jstr.v "fa-2x") + ; class' (Jstr.v "fa-cog") ] + ] + ; El.hr () + ; El.ul + pages + ] in + + let () = El.append_children element childs in + Some + { delete = delete_event + ; redirect = redirect_event + ; add = add_event + } diff --git a/editor/actions/add_page.ml b/editor/actions/add_page.ml new file mode 100755 index 0000000..b817573 --- /dev/null +++ b/editor/actions/add_page.ml @@ -0,0 +1,11 @@ +type t = Forms.Events.event option Note.E.send + +let apply + : t -> State.t -> State.t + = fun close_sender state -> + let title = Jstr.v "Nouvelle page" in + let popup = Forms.Ui.popup + ~title + ~form:(Some (Forms.Add_page.create ())) + close_sender in + { state with window = popup::state.window} diff --git a/editor/actions/delete_page.ml b/editor/actions/delete_page.ml new file mode 100755 index 0000000..cc15693 --- /dev/null +++ b/editor/actions/delete_page.ml @@ -0,0 +1,16 @@ +type t = Forms.Events.event option Note.E.send + +let apply + : t -> State.t -> State.t + = fun close_sender state -> + begin 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 + diff --git a/editor/actions/dune b/editor/actions/dune new file mode 100755 index 0000000..5d269c4 --- /dev/null +++ b/editor/actions/dune @@ -0,0 +1,13 @@ +(library + (name actions) + (libraries + brr + brr.note + elements + blog + js_lib + forms + state + ) + (preprocess (pps js_of_ocaml-ppx)) + ) diff --git a/editor/actions/event.ml b/editor/actions/event.ml new file mode 100755 index 0000000..5e30587 --- /dev/null +++ b/editor/actions/event.ml @@ -0,0 +1,8 @@ +module type Handler = sig + type t + + val apply: t -> State.t -> State.t + +end + +type t = E : 'a * (module Handler with type t = 'a) -> t diff --git a/editor/app.ml b/editor/app.ml index 219ce80..4559044 100755 --- a/editor/app.ml +++ b/editor/app.ml @@ -2,11 +2,10 @@ open Brr module Js = Js_of_ocaml.Js type events = - | DeleteEvent | StoreEvent | LoadEvent of Jstr.t option - | AddEvent | ClosePopup of Forms.Events.event option + | Generic of Actions.Event.t let key_of_title : Jstr.t -> Jstr.t @@ -18,41 +17,27 @@ let key_of_title The function take a new event, and apply it to the current state. *) let update - : Forms.Events.event option Note.E.send -> (events, State.t) Application.t - = fun close_sender event state -> + : (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 - | AddEvent -> - let title = Jstr.v "Nouvelle page" in - let popup = Ui.popup - ~title - ~form:(Some (Forms.Add_page.create ())) - close_sender in - { state with window = popup::state.window} - - | DeleteEvent -> - begin match state.page_id with - | None -> state - | Some page_id -> - let title = Jstr.v "Confirmation" in - let popup = Ui.popup - ~title - ~form:(Some (Forms.Delete_page.create page_id)) - close_sender in - { state with window = popup::state.window} - end - | StoreEvent -> let title_element = Document.find_el_by_id G.document (Jstr.v "title") in @@ -80,12 +65,23 @@ let update - more recent (if the content has been updated elsewhere) but older shoud be a bug. *) - date <= state.last_backup)) in + 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 } - | other -> + | Ok false -> + Console.(log [Jstr.v "Didn't save"]); + state + | Error other -> (* TODO In case of error, notify the user *) - Console.(log [other]); + Console.(log [Jstr.v "Couldn't save" ; other]); state end diff --git a/editor/dune b/editor/dune index 295c39f..8f2e3d1 100755 --- a/editor/dune +++ b/editor/dune @@ -11,6 +11,7 @@ state plugins forms + actions ) (modes js) (preprocess (pps js_of_ocaml-ppx)) diff --git a/editor/editor.ml b/editor/editor.ml index 2849b29..bca8fb2 100755 --- a/editor/editor.ml +++ b/editor/editor.ml @@ -56,14 +56,6 @@ let build_view view, last_backup -(** [update] is the event loop. - - The function take a new event, and apply it to the current state. *) - -let update - : 'a option Note.E.send -> (App.events, State.t) Application.t - = App.update - let app id content = (* This event is used in the pop process. The sender is given to the @@ -71,7 +63,7 @@ let app id content = let (event: Forms.Events.event option Note.event), sender = Note.E.create () in (* Check the pre-requisite *) - let events_opt = Actions.populate_menu () in + let events_opt = Actions.populate_menu sender in match (Jv.is_none id), (Jv.is_none content), events_opt with | false, false, Some btn_events -> @@ -81,25 +73,16 @@ let app id content = let page_id = State.Storage.page_id () in let view, last_backup = build_view pm page_id editor in - let init_state = - State.{ editable = true - ; view - ; last_backup - ; page_id - - ; window = [] - ; pm - } - in + let init_state = State.init pm view last_backup page_id in let app_state = Application.run ~eq:State.eq - (App.update sender) + (App.update ) init_state (Note.E.select [ Brr_note.Evr.on_el Ev.focusout (fun _ -> App.StoreEvent) editor - ; Note.E.map (fun () -> App.DeleteEvent) btn_events.Actions.delete - ; Note.E.map (fun () -> App.AddEvent) btn_events.Actions.add + ; 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 ]) in diff --git a/editor/forms/add_page.ml b/editor/forms/add_page.ml index 9786f47..edcbc37 100755 --- a/editor/forms/add_page.ml +++ b/editor/forms/add_page.ml @@ -62,4 +62,3 @@ let create [ input ] ] ] ) - diff --git a/editor/forms/delete_page.ml b/editor/forms/delete_page.ml index 7c973c2..eb36560 100755 --- a/editor/forms/delete_page.ml +++ b/editor/forms/delete_page.ml @@ -26,12 +26,10 @@ let create let message = begin let open Jstr in - (v "La page " ) + (v "La page ") + name + (v " sera définitivement supprimée") end in ( state - , El.txt message - ) - + , El.txt message ) diff --git a/editor/forms/events.ml b/editor/forms/events.ml index a88aa76..28780d9 100755 --- a/editor/forms/events.ml +++ b/editor/forms/events.ml @@ -8,5 +8,8 @@ end type event = Event : 'a * (module Handler with type t = 'a) -> event -(** The signal has to be log in order to be completely working *) +(* 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/ui.ml b/editor/forms/ui.ml index cc90481..d8a259a 100755 --- a/editor/ui.ml +++ b/editor/forms/ui.ml @@ -3,7 +3,7 @@ open Brr_note module Js = Js_of_ocaml.Js let popup - : title:Jstr.t -> ?form:Forms.Events.t option -> Forms.Events.event option Note.E.send -> El.t + : title:Jstr.t -> ?form:Events.t option -> Events.event option Note.E.send -> El.t = fun ~title ?(form = None) send -> (* Ensure we keep a track for the signal event. diff --git a/editor/state/state.ml b/editor/state/state.ml index 48b4d58..569f26c 100755 --- a/editor/state/state.ml +++ b/editor/state/state.ml @@ -17,9 +17,7 @@ type t = (** Compare two states together. - The prosemirror elemens are ignored - -*) + The prosemirror elemens are ignored *) let eq s1 s2 = Stdlib.(==) ( s1.editable @@ -66,5 +64,25 @@ let load_page let editor_state = state_of_storage state.pm json state.view##.state##.schema in let () = state.view##updateState editor_state and () = set_title json in - { state with page_id } + + let last_backup = + Js.Opt.case json##.date + (fun () -> state.last_backup ) + (fun v -> v) in + + { state with page_id + ; last_backup } + + +let init + : PM.t -> PM.View.editor_view Js.t -> float -> Jstr.t option -> t + = fun pm view last_backup page_id -> + { editable = true + ; view + ; last_backup + ; page_id + + ; window = [] + ; pm + } diff --git a/editor/state/state.mli b/editor/state/state.mli index e370015..6984067 100755 --- a/editor/state/state.mli +++ b/editor/state/state.mli @@ -1,5 +1,4 @@ module Js = Js_of_ocaml.Js - module Storage = Storage type t = @@ -14,6 +13,7 @@ type t = val eq: t -> t -> bool +(** Update the title element according to the page. *) val set_title : Storage.content Js.t -> unit @@ -22,3 +22,7 @@ val state_of_storage val load_page : Jstr.t option -> t -> Storage.content Js.t -> t + +(** Initialise a new state *) +val init + : Prosemirror.t -> Prosemirror.View.editor_view Js.t -> float -> Jstr.t option -> t diff --git a/editor/state/storage.ml b/editor/state/storage.ml index f893c2d..b0c00de 100755 --- a/editor/state/storage.ml +++ b/editor/state/storage.ml @@ -62,7 +62,8 @@ let save' (* First load the content from the storage *) match check (load' key) with - | false -> Ok false + | false -> + Ok false | true -> let storage = Brr_io.Storage.local G.window in let operation = Brr_io.Storage.set_item |