aboutsummaryrefslogtreecommitdiff
path: root/editor
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@dailly.me>2022-02-07 16:09:50 +0100
committerSébastien Dailly <sebastien@dailly.me>2022-02-07 16:43:33 +0100
commit37485464a4da41462fc285d03229221f44860397 (patch)
tree38e9969c62e865ba7d9e258eb8c5d22172496ded /editor
parent7c23b96ce5634550341b9554eda9d7c89a79e3c0 (diff)
Changed the application structure in the editor
Diffstat (limited to 'editor')
-rwxr-xr-xeditor/actions.ml96
-rwxr-xr-xeditor/dune1
-rw-r--r--editor/editor.css15
-rwxr-xr-xeditor/editor.ml254
-rwxr-xr-xeditor/footnotes.ml2
-rwxr-xr-xeditor/storage.ml85
-rwxr-xr-xeditor/storage.mli21
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