diff options
| -rwxr-xr-x | editor/actions.ml | 96 | ||||
| -rwxr-xr-x | editor/dune | 1 | ||||
| -rw-r--r-- | editor/editor.css | 15 | ||||
| -rwxr-xr-x | editor/editor.ml | 254 | ||||
| -rwxr-xr-x | editor/footnotes.ml | 2 | ||||
| -rwxr-xr-x | editor/storage.ml | 85 | ||||
| -rwxr-xr-x | editor/storage.mli | 21 |
7 files changed, 331 insertions, 143 deletions
diff --git a/editor/actions.ml b/editor/actions.ml new file mode 100755 index 0000000..c02584f --- /dev/null +++ b/editor/actions.ml @@ -0,0 +1,96 @@ +open StdLabels +open Brr +open Brr_note + +type button_actions = + { edit : El.t * (unit Note.event) + } + +let populate_menu () = + match Blog.Sidebar.get () with + | None -> None + | Some element -> + let () = Blog.Sidebar.clean element in + let uri = Brr.Window.location Brr.G.window in + + let edit_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-pen") + ] + ] in + + let edit_event = + Evr.on_el + Ev.click + Evr.unit + edit_button 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-home") ] + ] + ; edit_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") ] + ] + ; 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") ] + ] + ; 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") ] + ] + ; 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 + { edit = (edit_button, edit_event) + } diff --git a/editor/dune b/editor/dune index 767d35e..4d6d03c 100755 --- a/editor/dune +++ b/editor/dune @@ -7,6 +7,7 @@ js_lib prosemirror blog + application ) (modes js) (preprocess (pps js_of_ocaml-ppx)) diff --git a/editor/editor.css b/editor/editor.css index 09fc472..0be2237 100644 --- a/editor/editor.css +++ b/editor/editor.css @@ -442,11 +442,20 @@ footnote::after { } .action-button { - background-color: unset; - color: unset; - border: 0px + background-color: unset; + color: unset; + border: 0px } +.action-button.active { + background-color: white; + color: #333; + border-radius: 5px; +} + +.action-button:hover { + border-bottom: 1px solid white; +} .action-button:active { transform: translateY(1px); } 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 diff --git a/editor/footnotes.ml b/editor/footnotes.ml index a3ba9cd..794171f 100755 --- a/editor/footnotes.ml +++ b/editor/footnotes.ml @@ -136,7 +136,7 @@ let footnote_view method _open = (* Append a tooltip to the outer node *) let tooltip = El.div [] - ~at:At.([class' (Jstr.v "footnote-tooltip")]) in + ~at:At.([class' (Jstr.v "popin")]) in El.append_children _self##.dom [ tooltip ]; diff --git a/editor/storage.ml b/editor/storage.ml index 0d74a05..5dbaab9 100755 --- a/editor/storage.ml +++ b/editor/storage.ml @@ -1,27 +1,22 @@ open Brr -module PM = Prosemirror module Js = Js_of_ocaml.Js let storage_key = (Jstr.v "editor") let storage = Brr_io.Storage.local G.window -let create_new_state pm mySchema content = - let module PM = Prosemirror in +class type content = object - let doc = PM.Model.( - DOMParser.parse - (DOMParser.from_schema pm mySchema) - content) in + method title + : Jstr.t Js.opt Js.readonly_prop - let props = PM.State.creation_prop () in - props##.doc := Js.some doc; - props##.plugins := Plugins.default pm mySchema; + method content + : Jv.t Js.opt Js.readonly_prop - PM.State.create - pm - props + method date + : float Js.opt Js.readonly_prop +end let page_id : unit -> Jstr.t option @@ -35,59 +30,73 @@ let page_id storage for the [key]. *) let load' - : PM.t -> PM.Model.schema Js.t -> El.t -> Jstr.t -> PM.State.editor_state Js.t - = fun pm schema content key -> + : Jstr.t -> content Js.t + = fun key -> let opt_data = Brr_io.Storage.get_item storage key in match opt_data with - | None -> create_new_state pm schema content + | None -> + object%js + val title = Js.null + val content = Js.null + val date = Js.null + end | Some contents -> + (* Try to load from the storage *) match Json.decode contents with - | Error _ -> create_new_state pm schema content + | Error _ -> + object%js + val title = Js.null + val content = Js.null + val date = Js.null + end + | Ok json -> - let obj = PM.State.configuration_prop () in - obj##.plugins := Plugins.default pm schema; - obj##.schema := Js.some schema; - PM.State.fromJSON pm obj json + Jv.Id.of_jv json (** Save the view *) let save' - : PM.View.editor_view Js.t -> Jstr.t -> unit - = fun view key -> - let contents = view##.state##toJSON () in - let storage = Brr_io.Storage.local G.window in - Brr_io.Storage.set_item - storage - key - (Json.encode @@ contents) - |> Console.log_if_error ~use:() + : check:(content Js.t -> bool) -> content Js.t -> Jstr.t -> (bool, Jv.Error.t) result + = fun ~check object_content key -> + + (* First load the content from the storage *) + match check (load' key) with + | false -> Ok false + | true -> + let storage = Brr_io.Storage.local G.window in + let operation = Brr_io.Storage.set_item + storage + key + (Json.encode @@ Jv.Id.to_jv @@ object_content) in + Result.map (fun () -> true) operation (** [load pm schema content f] will try load the content stored in the local storage. The right key is given by the result of the function [f] *) let load - : PM.t -> PM.Model.schema Js.t -> El.t -> (unit -> Jstr.t option) -> PM.State.editor_state Js.t - = fun pm schema content f -> + : (unit -> Jstr.t option) -> content Js.t + = fun f -> match f () with - | None -> load' pm schema content storage_key + | None -> load' storage_key | Some value -> let key = Jstr.concat ~sep:(Jstr.v "_") [storage_key ; value] in - load' pm schema content key + load' key let save - : PM.View.editor_view Js.t -> (unit -> Jstr.t option) -> unit - = fun view f -> + : check:(content Js.t -> bool) -> content Js.t -> (unit -> Jstr.t option) -> (bool, Jv.Error.t) result + = fun ~check object_content f -> match f () with - | None -> save' view storage_key + | None -> + save' ~check object_content storage_key | Some value -> let key = Jstr.concat ~sep:(Jstr.v "_") [storage_key ; value] in - save' view key + save' ~check object_content key let delete : (unit -> Jstr.t option) -> unit diff --git a/editor/storage.mli b/editor/storage.mli index 5424119..7ae77a6 100755 --- a/editor/storage.mli +++ b/editor/storage.mli @@ -1,20 +1,31 @@ -module PM = Prosemirror module Js = Js_of_ocaml.Js (** Provide a function for extracting the page id from the URL *) val page_id : unit -> Jstr.t option -(** load pm schema content f] will load the content and store it into the - element [content]. +class type content = object + + method title + : Jstr.t Js.opt Js.readonly_prop + + method content + : Jv.t Js.opt Js.readonly_prop + + method date + : float Js.opt Js.readonly_prop + +end + +(** load f] will try to load the content associated with the given key. The function [f] is called to identified which is the appropriate page id. *) val load - : PM.t -> PM.Model.schema Js.t -> Brr.El.t -> (unit -> Jstr.t option) -> PM.State.editor_state Js.t + : (unit -> Jstr.t option) -> content Js.t val save - : PM.View.editor_view Js.t -> (unit -> Jstr.t option) -> unit + : check:(content Js.t -> bool) -> content Js.t -> (unit -> Jstr.t option) -> (bool, Jv.Error.t) result (** Remove the page from the storage and reload the page *) val delete |