From bf94695abeda0d7bb296ae4cd0f9a53782587d4a Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 7 Feb 2022 16:14:09 +0100
Subject: Update editor organisation

---
 editor/state/storage.ml | 137 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 137 insertions(+)
 create mode 100755 editor/state/storage.ml

(limited to 'editor/state/storage.ml')

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
-- 
cgit v1.2.3