diff options
author | Sébastien Dailly <sebastien@dailly.me> | 2022-02-07 16:14:09 +0100 |
---|---|---|
committer | Sébastien Dailly <sebastien@dailly.me> | 2022-02-07 16:43:33 +0100 |
commit | bf94695abeda0d7bb296ae4cd0f9a53782587d4a (patch) | |
tree | 06dac432cfaa57dc6ad428b116332fdf777c84d8 | |
parent | 4d35508a76676a548ac45e0bff2d63eafaf014e2 (diff) |
Update editor organisation
-rwxr-xr-x | editor/actions.ml | 23 | ||||
-rwxr-xr-x | editor/app.ml | 118 | ||||
-rwxr-xr-x | editor/dune | 2 | ||||
-rwxr-xr-x | editor/editor.ml | 197 | ||||
-rwxr-xr-x | editor/forms/add_page.ml | 22 | ||||
-rwxr-xr-x | editor/forms/add_page.mli | 6 | ||||
-rwxr-xr-x | editor/forms/delete_page.ml | 10 | ||||
-rwxr-xr-x | editor/forms/dune | 1 | ||||
-rwxr-xr-x | editor/forms/events.ml | 17 | ||||
-rwxr-xr-x | editor/plugins/dune | 9 | ||||
-rwxr-xr-x | editor/plugins/footnotes.ml (renamed from editor/footnotes.ml) | 0 | ||||
-rwxr-xr-x | editor/plugins/link_editor.ml (renamed from editor/link_editor.ml) | 0 | ||||
-rwxr-xr-x | editor/plugins/plugins.ml (renamed from editor/plugins.ml) | 2 | ||||
-rwxr-xr-x | editor/plugins/popin.ml (renamed from editor/popin.ml) | 0 | ||||
-rwxr-xr-x | editor/plugins/tooltip.ml (renamed from editor/tooltip.ml) | 0 | ||||
-rwxr-xr-x | editor/state/dune | 9 | ||||
-rwxr-xr-x | editor/state/state.ml | 70 | ||||
-rwxr-xr-x | editor/state/state.mli | 24 | ||||
-rwxr-xr-x | editor/state/storage.ml (renamed from editor/storage.ml) | 0 | ||||
-rwxr-xr-x | editor/state/storage.mli (renamed from editor/storage.mli) | 0 |
20 files changed, 321 insertions, 189 deletions
diff --git a/editor/actions.ml b/editor/actions.ml index f7633e1..0f107f9 100755 --- a/editor/actions.ml +++ b/editor/actions.ml @@ -17,30 +17,24 @@ let populate_menu () = let delete_button = El.button ~at:At.[ class' (Jstr.v "action-button") ] - [ El.i - [] + [ El.i [] ~at:At.[ class' (Jstr.v "fa") ; class' (Jstr.v "fa-2x") - ; class' (Jstr.v "fa-trash") - ] ] + ; class' (Jstr.v "fa-trash") ] ] and home_button = El.button ~at:At.[ class' (Jstr.v "action-button") ] - [ El.i - [] + [ El.i [] ~at:At.[ class' (Jstr.v "fa") ; class' (Jstr.v "fa-2x") - ; class' (Jstr.v "fa-home") - ] ] + ; class' (Jstr.v "fa-home") ] ] and add_button = El.button ~at:At.[ class' (Jstr.v "action-button") ] - [ El.i - [] + [ El.i [] ~at:At.[ class' (Jstr.v "fa") ; class' (Jstr.v "fa-2x") - ; class' (Jstr.v "fa-plus") - ] ] + ; class' (Jstr.v "fa-plus") ] ] in @@ -49,19 +43,20 @@ let populate_menu () = Ev.click Evr.unit delete_button + and add_event = Evr.on_el Ev.click Evr.unit add_button in - let stored_pages = Storage.get_ids () in + let stored_pages = State.Storage.get_ids () in let pages = List.map stored_pages ~f:(fun id -> - let name_opt = (Storage.load (Some id))##.title in + let name_opt = (State.Storage.load (Some id))##.title in let name = Js.Opt.get name_opt (fun () -> id) in diff --git a/editor/app.ml b/editor/app.ml new file mode 100755 index 0000000..aee396a --- /dev/null +++ b/editor/app.ml @@ -0,0 +1,118 @@ +open Brr +module PM = Prosemirror +module Js = Js_of_ocaml.Js + +type events = + | DeleteEvent + | StoreEvent + | LoadEvent of Jstr.t option + | AddEvent + | CloseEvent of Forms.Events.kind option + | GEvent of Forms.Events.event + +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 + : 'a option Note.E.send -> (events, State.t) Application.t + = fun close_sender event state -> + match event with + + | GEvent (Event (t, (module Handler))) -> + Handler.on_close t state + + | 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 + + | CloseEvent res -> + + let state = match state.window with + | [] -> { state with window = [] } + | el::tl -> El.remove el + ; { state with window = tl } in + + (* The actions is confirmed by the user. Handle the form result *) + begin match res with + (* Delete the current page, then load the home page *) + | Some (Forms.Delete_page.DeletePage id) -> + State.Storage.delete (fun () -> Some id); + let json = State.Storage.load None in + State.load_page None state json + (* Add a new page *) + | Some (Forms.Add_page.AddPage {title}) -> + 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 + + | _ -> 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. *) + date <= state.last_backup)) in + begin match save with + | Ok true -> { state with last_backup = new_date } + | other -> + (* TODO In case of error, notify the user *) + Console.(log [other]); + state + end + + | LoadEvent page_id -> + let json = State.Storage.load page_id in + State.load_page page_id state json + + diff --git a/editor/dune b/editor/dune index c8dfe3c..295c39f 100755 --- a/editor/dune +++ b/editor/dune @@ -8,6 +8,8 @@ prosemirror blog application + state + plugins forms ) (modes js) diff --git a/editor/editor.ml b/editor/editor.ml index d3a9624..1a34dfc 100755 --- a/editor/editor.ml +++ b/editor/editor.ml @@ -2,56 +2,6 @@ open Brr module PM = Prosemirror module Js = Js_of_ocaml.Js -(** This is the state for the application *) -type state = - { editable : bool - ; view : PM.View.editor_view Js.t - ; last_backup: float - ; page_id: Jstr.t option - - ; window : El.t list - } - -type events = - | DeleteEvent - | StoreEvent - | LoadEvent of Jstr.t option - | AddEvent - | CloseEvent of Forms.Events.kind option - -let set_title - : Storage.content Js.t -> unit - = fun content -> - let title = - Js.Opt.get - content##.title - (fun () -> Jstr.empty) in - let title_element = Document.find_el_by_id G.document (Jstr.v "title") in - Option.iter - (fun el -> El.set_prop (El.Prop.value) title el) - title_element - -let key_of_title - : Jstr.t -> Jstr.t - = fun title -> - title - -let state_of_storage - : PM.t -> Storage.content Js.t -> PM.Model.schema Js.t -> PM.State.editor_state Js.t - = fun pm content schema -> - Js.Opt.case - content##.content - (fun () -> - let obj = PM.State.creation_prop () in - obj##.plugins := Plugins.default pm schema; - obj##.schema := Js.some schema; - PM.State.create pm obj) - (fun page_content -> - let obj = PM.State.configuration_prop () in - obj##.plugins := Plugins.default pm schema; - obj##.schema := Js.some schema; - PM.State.fromJSON pm obj page_content) - (** Create a new editor view [build_view element state] will create the editor and attach it to [element]. @@ -68,7 +18,7 @@ let build_view This could be improved, instead of creating a new schema, just fetch the node and marks from the plungin *) let custom_schema = - Footnotes.footnote_schema + Plugins.Footnotes.footnote_schema pm (PM.SchemaBasic.schema pm) in @@ -83,7 +33,7 @@ let build_view (Some custom_schema##.spec##.marks) None in let full_schema = PM.Model.schema pm specs in - let stored_content = Storage.load page_id in + let stored_content = State.Storage.load page_id in (* This variable contains the last update time, either because it is stored, or because it is the date where we create the first page. *) @@ -92,11 +42,11 @@ let build_view (fun () -> (new%js Js.date_now)##getTime) in let props = PM.View.direct_editor_props () in - props##.state := state_of_storage pm stored_content full_schema; + props##.state := State.state_of_storage pm stored_content full_schema; (* Add the custom nodes *) props##.nodeViews := PM.O.init - [| ( "footnote", (Footnotes.footnote_view pm)) + [| ( "footnote", (Plugins.Footnotes.footnote_view pm)) |]; let view = PM.View.editor_view @@ -105,114 +55,21 @@ let build_view props in view, last_backup -let load_page - : PM.t -> Jstr.t option -> state -> Storage.content Js.t -> state - = fun pm page_id state json -> - let editor_state = state_of_storage pm json state.view##.state##.schema in - let () = state.view##updateState editor_state - and () = set_title json in - { state with page_id } (** [update] is the event loop. The function take a new event, and apply it to the current state. *) let update - : PM.t -> 'a option Note.E.send -> (events, state) Application.t - = fun pm close_sender event state -> - match event with - - | 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 - - | CloseEvent res -> - - let state = match state.window with - | [] -> { state with window = [] } - | el::tl -> El.remove el - ; { state with window = tl } in - - (* The actions is confirmed by the user. Handle the form result *) - begin match res with - (* Delete the current page, then load the home page *) - | Some (Forms.Delete_page.DeletePage id) -> - Storage.delete (fun () -> Some id); - let json = Storage.load None in - load_page pm None state json - (* Add a new page *) - | Some (Forms.Add_page.AddPage {title}) -> - let page_id = key_of_title title in - Console.(log [title]); - 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 - load_page pm (Some page_id) state content_obj - - | _ -> 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 = 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. *) - date <= state.last_backup)) in - begin match save with - | Ok true -> { state with last_backup = new_date } - | _ -> - (* TODO In case of error, notify the user *) - state - end - - | LoadEvent page_id -> - let json = Storage.load page_id in - load_page pm page_id state json - + : '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 + subroutine in order to track the window closing *) + let event, sender = Note.E.create () in + (* Check the pre-requisite *) let events_opt = Actions.populate_menu () in match (Jv.is_none id), (Jv.is_none content), events_opt with @@ -221,34 +78,32 @@ let app id content = let pm = PM.v () in let editor:El.t = Jv.Id.of_jv id in (* Load the cache for the given page *) - let page_id = Storage.page_id () in + let page_id = State.Storage.page_id () in let view, last_backup = build_view pm page_id editor in - (* This event is used in the pop process. The sender is given to the - subroutine in order to track the window closing *) - let event, sender = Note.E.create () in - let _ = sender in let init_state = - { editable = true - ; view - ; last_backup - ; page_id - - ; window = [] - } + State.{ editable = true + ; view + ; last_backup + ; page_id + + ; window = [] + ; pm + } in let app_state = Application.run - (update pm sender) + ~eq:State.eq + (App.update sender) init_state (Note.E.select - [ Note.E.map (fun () -> DeleteEvent) btn_events.Actions.delete - ; Brr_note.Evr.on_el Ev.focusout (fun _ -> StoreEvent) editor - ; Note.E.map (fun v -> LoadEvent v) btn_events.Actions.redirect - ; Note.E.map (fun () -> AddEvent) btn_events.Actions.add - ; Note.E.map (fun v -> CloseEvent v) event + [ 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 v -> App.LoadEvent v) btn_events.Actions.redirect + ; Note.E.map (fun v -> App.CloseEvent v) event ]) in let () = diff --git a/editor/forms/add_page.ml b/editor/forms/add_page.ml index 597e9d3..ac45824 100755 --- a/editor/forms/add_page.ml +++ b/editor/forms/add_page.ml @@ -1,9 +1,12 @@ open Brr open Brr_note open Note +module Js = Js_of_ocaml.Js + +type t = { title : Jstr.t } type Events.kind += - | AddPage of { title : Jstr.t } + | AddPage of t [@@unboxed] let create : unit -> Events.t @@ -34,3 +37,20 @@ let create [ input ] ] ] ) + +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 diff --git a/editor/forms/add_page.mli b/editor/forms/add_page.mli index 97b1d6c..6be1611 100755 --- a/editor/forms/add_page.mli +++ b/editor/forms/add_page.mli @@ -1,5 +1,9 @@ +type t = { title : Jstr.t } type Events.kind += - | AddPage of { title : Jstr.t } + | AddPage of t [@@unboxed] val create : unit -> Events.t + +val on_close + : t -> State.t -> State.t diff --git a/editor/forms/delete_page.ml b/editor/forms/delete_page.ml index 701162c..3328dd7 100755 --- a/editor/forms/delete_page.ml +++ b/editor/forms/delete_page.ml @@ -1,8 +1,10 @@ open Brr open Note +type t = Jstr.t + type Events.kind += - | DeletePage of Jstr.t [@@unboxed] + | DeletePage of t [@@unboxed] let create : Jstr.t -> Events.t @@ -23,3 +25,9 @@ let create , El.txt message ) +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 diff --git a/editor/forms/dune b/editor/forms/dune index 9876654..124ce01 100755 --- a/editor/forms/dune +++ b/editor/forms/dune @@ -7,6 +7,7 @@ js_lib blog application + state ) (preprocess (pps js_of_ocaml-ppx)) ) diff --git a/editor/forms/events.ml b/editor/forms/events.ml index 339e15d..f7f5711 100755 --- a/editor/forms/events.ml +++ b/editor/forms/events.ml @@ -1,5 +1,20 @@ -(** This type is designed to be extended for each form *) +(** This type is designed to be extended for each form. + + Each of them hold the values inside the form. + +*) type kind = .. +(** The signal has to be log in order to be completely working *) type t = kind Note.signal * Brr.El.t +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 + diff --git a/editor/plugins/dune b/editor/plugins/dune new file mode 100755 index 0000000..046dc5a --- /dev/null +++ b/editor/plugins/dune @@ -0,0 +1,9 @@ +(library + (name plugins) + (libraries + brr + prosemirror + js_lib + ) + (preprocess (pps js_of_ocaml-ppx)) + ) diff --git a/editor/footnotes.ml b/editor/plugins/footnotes.ml index 794171f..794171f 100755 --- a/editor/footnotes.ml +++ b/editor/plugins/footnotes.ml diff --git a/editor/link_editor.ml b/editor/plugins/link_editor.ml index 9bfdfd4..9bfdfd4 100755 --- a/editor/link_editor.ml +++ b/editor/plugins/link_editor.ml diff --git a/editor/plugins.ml b/editor/plugins/plugins.ml index 91dedeb..3a92df8 100755 --- a/editor/plugins.ml +++ b/editor/plugins/plugins.ml @@ -1,6 +1,8 @@ module Js = Js_of_ocaml.Js module PM = Prosemirror +module Footnotes = Footnotes + (** Commands *) let change_level diff --git a/editor/popin.ml b/editor/plugins/popin.ml index 63dcad1..63dcad1 100755 --- a/editor/popin.ml +++ b/editor/plugins/popin.ml diff --git a/editor/tooltip.ml b/editor/plugins/tooltip.ml index 05d56d4..05d56d4 100755 --- a/editor/tooltip.ml +++ b/editor/plugins/tooltip.ml diff --git a/editor/state/dune b/editor/state/dune new file mode 100755 index 0000000..dd405a1 --- /dev/null +++ b/editor/state/dune @@ -0,0 +1,9 @@ +(library + (name state) + (libraries + brr + prosemirror + plugins + ) + (preprocess (pps js_of_ocaml-ppx)) + ) diff --git a/editor/state/state.ml b/editor/state/state.ml new file mode 100755 index 0000000..48b4d58 --- /dev/null +++ b/editor/state/state.ml @@ -0,0 +1,70 @@ +open Brr +module PM = Prosemirror +module Js = Js_of_ocaml.Js + +module Storage = Storage + +(** This is the state for the application *) +type t = + { editable : bool + ; view : PM.View.editor_view Js.t + ; last_backup: float + ; page_id: Jstr.t option + + ; window : Brr.El.t list + ; pm : PM.t + } + +(** Compare two states together. + + The prosemirror elemens are ignored + +*) +let eq s1 s2 = + Stdlib.(==) + ( s1.editable + , s1.last_backup + , s1.page_id + , s1.window ) + + ( s2.editable + , s2.last_backup + , s2.page_id + , s2.window ) + +let set_title + : Storage.content Js.t -> unit + = fun content -> + let title = + Js.Opt.get + content##.title + (fun () -> Jstr.empty) in + let title_element = Document.find_el_by_id G.document (Jstr.v "title") in + Option.iter + (fun el -> El.set_prop (El.Prop.value) title el) + title_element + +let state_of_storage + : PM.t -> Storage.content Js.t -> PM.Model.schema Js.t -> PM.State.editor_state Js.t + = fun pm content schema -> + Js.Opt.case + content##.content + (fun () -> + let obj = PM.State.creation_prop () in + obj##.plugins := Plugins.default pm schema; + obj##.schema := Js.some schema; + PM.State.create pm obj) + (fun page_content -> + let obj = PM.State.configuration_prop () in + obj##.plugins := Plugins.default pm schema; + obj##.schema := Js.some schema; + PM.State.fromJSON pm obj page_content) + +let load_page + : Jstr.t option -> t -> Storage.content Js.t -> t + = fun page_id state json -> + 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 } + diff --git a/editor/state/state.mli b/editor/state/state.mli new file mode 100755 index 0000000..e370015 --- /dev/null +++ b/editor/state/state.mli @@ -0,0 +1,24 @@ +module Js = Js_of_ocaml.Js + +module Storage = Storage + +type t = + { editable : bool + ; view : Prosemirror.View.editor_view Js.t + ; last_backup: float + ; page_id: Jstr.t option + + ; window : Brr.El.t list + ; pm : Prosemirror.t + } + +val eq: t -> t -> bool + +val set_title + : Storage.content Js.t -> unit + +val state_of_storage + : Prosemirror.t -> Storage.content Js.t -> Prosemirror.Model.schema Js.t -> Prosemirror.State.editor_state Js.t + +val load_page + : Jstr.t option -> t -> Storage.content Js.t -> t diff --git a/editor/storage.ml b/editor/state/storage.ml index f893c2d..f893c2d 100755 --- a/editor/storage.ml +++ b/editor/state/storage.ml diff --git a/editor/storage.mli b/editor/state/storage.mli index 5b7e0a0..5b7e0a0 100755 --- a/editor/storage.mli +++ b/editor/state/storage.mli |