aboutsummaryrefslogtreecommitdiff
path: root/editor/state
diff options
context:
space:
mode:
Diffstat (limited to 'editor/state')
-rwxr-xr-xeditor/state/dune9
-rwxr-xr-xeditor/state/state.ml70
-rwxr-xr-xeditor/state/state.mli24
-rwxr-xr-xeditor/state/storage.ml137
-rwxr-xr-xeditor/state/storage.mli36
5 files changed, 276 insertions, 0 deletions
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/state/storage.ml b/editor/state/storage.ml
new file mode 100755
index 0000000..f893c2d
--- /dev/null
+++ b/editor/state/storage.ml
@@ -0,0 +1,137 @@
+open Brr
+module Js = Js_of_ocaml.Js
+
+let storage_key = (Jstr.v "editor")
+
+let storage = Brr_io.Storage.local G.window
+
+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
+
+let page_id
+ : unit -> Jstr.t option
+ = fun () ->
+ let uri = Brr.Window.location Brr.G.window in
+ let query = Brr.Uri.query uri in
+ let params = Brr.Uri.Params.of_jstr query in
+ Brr.Uri.Params.find (Jstr.v "page") params
+
+(** [load' pm schema content key] will load the content stored in the local
+ storage for the [key].
+*)
+let load'
+ : Jstr.t -> content Js.t
+ = fun key ->
+
+ let opt_data = Brr_io.Storage.get_item storage key in
+ match opt_data with
+ | 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 _ ->
+ object%js
+ val title = Js.null
+ val content = Js.null
+ val date = Js.null
+ end
+
+ | Ok json ->
+ Jv.Id.of_jv json
+
+(** Save the view *)
+let save'
+ : 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
+ : Jstr.t option -> content Js.t
+ = fun key ->
+ match key with
+ | None -> load' storage_key
+ | Some value ->
+ let key = Jstr.concat
+ ~sep:(Jstr.v "_")
+ [storage_key ; value] in
+ load' key
+
+let save
+ : check:(content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
+ = fun ~check object_content key ->
+ match key with
+ | None ->
+ save' ~check object_content storage_key
+ | Some value ->
+ let key = Jstr.concat
+ ~sep:(Jstr.v "_")
+ [storage_key ; value] in
+ save' ~check object_content key
+
+let delete
+ : (unit -> Jstr.t option) -> unit
+ = fun f ->
+ match f () with
+ | None -> ()
+ | Some value ->
+ let key = Jstr.concat
+ ~sep:(Jstr.v "_")
+ [storage_key ; value] in
+ let storage = Brr_io.Storage.local G.window in
+ Brr_io.Storage.remove_item storage key
+
+let get_ids
+ : unit -> Jstr.t list
+ = fun () ->
+ let open Brr_io in
+ let storage = Storage.local G.window in
+ let items = Storage.length storage in
+
+ let sub = Jstr.( storage_key + (v "_") ) in
+ let start = Jstr.length sub in
+
+ let rec add_element acc = function
+ | -1 -> acc
+ | nb ->
+ begin match Storage.key storage nb with
+ | Some key when (Jstr.starts_with ~sub key) ->
+
+ let key_name = Jstr.sub key
+ ~start in
+ add_element (key_name::acc) (nb -1)
+ | _ ->
+ add_element acc (nb -1)
+ end
+
+ in
+ add_element [] items
diff --git a/editor/state/storage.mli b/editor/state/storage.mli
new file mode 100755
index 0000000..5b7e0a0
--- /dev/null
+++ b/editor/state/storage.mli
@@ -0,0 +1,36 @@
+module Js = Js_of_ocaml.Js
+
+(** Provide a function for extracting the page id from the URL *)
+val page_id
+ : unit -> Jstr.t option
+
+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
+ : Jstr.t option -> content Js.t
+
+val save
+ : check:(content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
+
+(** Remove the page from the storage. *)
+val delete
+ : (unit -> Jstr.t option) -> unit
+
+(** Collect all the keys to the existing pages *)
+val get_ids
+ : unit -> Jstr.t list