From 37485464a4da41462fc285d03229221f44860397 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 7 Feb 2022 16:09:50 +0100 Subject: Changed the application structure in the editor --- editor/editor.ml | 254 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 158 insertions(+), 96 deletions(-) (limited to 'editor/editor.ml') diff --git a/editor/editor.ml b/editor/editor.ml index c3cad1e..53a6029 100755 --- a/editor/editor.ml +++ b/editor/editor.ml @@ -1,108 +1,170 @@ -open StdLabels open Brr module PM = Prosemirror module Js = Js_of_ocaml.Js -let populate_menu () = - match Blog.Sidebar.get () with - | None -> () - | Some element -> - let () = Blog.Sidebar.clean element in - let uri = Brr.Window.location Brr.G.window in - - let pages = - - List.map (Storage.get_ids ()) - ~f:(fun name -> - let target = - Jstr.( (Brr.Uri.path uri) - + (Jstr.v "?page=") - + name) in - El.li - [ El.a - ~at:[At.href target] - [ El.txt name ] ] - ) in - - let childs = - [ 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-times-circle") - ] - ] - ; El.hr () - ; El.ul - pages - ] in - - El.append_children element childs - - -let prosemirror id content = - begin match (Jv.is_none id), (Jv.is_none content) with - | false, false -> - - let module PM = Prosemirror in - let pm = PM.v () in - - let schema = (PM.SchemaBasic.schema pm) in - let schema = Footnotes.footnote_schema pm schema in - - let specs = PM.Model.schema_spec - (PM.SchemaList.add_list_nodes - pm - (schema##.spec##.nodes) - (Jstr.v "paragraph block*") - (Some (Jstr.v "block"))) - (Some schema##.spec##.marks) - None in - let mySchema = PM.Model.schema pm specs in - - populate_menu (); - - (* Create the initial state *) - let state = Storage.load pm mySchema (Jv.Id.of_jv content) Storage.page_id in - - let props = PM.View.direct_editor_props () in - props##.state := state; - - (* Each time the state is update, handle the copy *) - props##.dispatchTransaction := Js.wrap_meth_callback @@ (fun view tr -> - let state = view##.state##apply tr in - view##updateState state - ); - - let view' = (Footnotes.footnote_view pm) in - - let nodes = PM.O.init - [| ("footnote", view') |] in - props##.nodeViews := nodes; - let view = PM.View.editor_view - pm - (Jv.Id.of_jv id) - props in - - (* Attach an event on focus out *) - let _ = Brr_note.Evr.on_el - (Ev.focusout) - (fun _ -> Storage.save view Storage.page_id) - (Jv.Id.of_jv id) in - - () - - | _, _ -> Console.(error [str "No element with id '%s' '%s' found"; id ; content]) - - end +(** This is the state for the application *) +type state = + { editable : bool + } + +type events = + | EditEvent + +let editor_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 update + : (events, state) Application.t + = fun event state -> + match event with + | EditEvent -> + { editable = not state.editable } + +let init_state = + { editable = true + } + +let build_view + : El.t -> state Note.S.t -> PM.View.editor_view Js.t * float ref + = fun editor app_state -> + let pm = PM.v () in + + (* Remove all the elements if any *) + El.set_children editor []; + + (* TODO + 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 + pm + (PM.SchemaBasic.schema pm) in + + (* Recreate the full schema by adding all the nodes and marks from the + plugings *) + let specs = PM.Model.schema_spec + (PM.SchemaList.add_list_nodes + pm + (custom_schema##.spec##.nodes) + (Jstr.v "paragraph block*") + (Some (Jstr.v "block"))) + (Some custom_schema##.spec##.marks) + None in + let full_schema = PM.Model.schema pm specs in + (* Load the cache for the given page *) + let stored_content = Storage.load Storage.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. *) + let last_backup = ref @@ Js.Opt.get + stored_content##.date + (fun () -> (new%js Js.date_now)##getTime) in + + let props = PM.View.direct_editor_props () in + props##.state := editor_of_storage pm stored_content full_schema; + props##.editable := Js.wrap_callback @@ (fun _state -> + Js.bool ( (Note.S.value app_state).editable) ); + + (* Add the custom nodes *) + props##.nodeViews := PM.O.init + [| ( "footnote", (Footnotes.footnote_view pm)) + |]; + + let view = PM.View.editor_view + pm + editor + props in + view, last_backup + +let app id content = + + (* Check the pre-requisite *) + let events_opt = Actions.populate_menu () in + match (Jv.is_none id), (Jv.is_none content), events_opt with + | false, false, Some btn_events -> + + let editor:El.t = Jv.Id.of_jv id in + let app_state = Application.run + update + init_state + (Note.E.select + [ Note.E.map (fun () -> EditEvent) (snd btn_events.Actions.edit) + ]) in + + let () = + Note.S.log app_state (fun _ -> ()) + |> Note.Logr.hold in + + (** Map active style of the button with the state *) + let () = + Brr_note.Elr.def_class + (Jstr.v "active") + (Note.S.map (fun s -> s.editable) app_state) + (fst btn_events.Actions.edit) in + + let view, last_backup = build_view editor app_state in + + (* Attach an event on focus out *) + let _ = Brr_note.Evr.on_el + (Ev.focusout) + (fun _ -> + let new_date = (new%js Js.date_now)##getTime in + let content_obj = object%js + val content = Js.some @@ Jv.Id.to_jv (view##.state##toJSON ()) + val title = Js.null + val date = Js.some new_date + end in + let save = Storage.save + content_obj + Storage.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 <= !last_backup)) in + match save with + | Ok true -> last_backup := new_date + | _ -> ()) + editor in + + let ev = + Note.E.map + (fun _ -> view##dispatch view##.state##.tr) + (Note.S.changes (Note.S.map (fun s -> s.editable) app_state)) in + let () = + Note.E.log ev (fun _ -> ()) + |> Option.iter Note.Logr.hold in + () + + | _, _, _ -> + Console.(error [str "No element with id '%s' '%s' found"; id ; content]) let () = let open Jv in let editor = obj - [| "attach_prosemirror", (repr prosemirror) + [| "attach_prosemirror", (repr app) |] in set global "editor" editor -- cgit v1.2.3