summaryrefslogtreecommitdiff
path: root/editor/state/storage.ml
blob: a10e75fb337445d54d83d5c87cb5acd3f11a9881 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
open Brr
open StdLabels
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:(previous:content Js.t -> update: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. If there is already a note
       with the same id, send the two notes to the checker to ensure we
       really need to save it. *)
    let stored = load' key in

    let process () =
      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
    in

    Js.Opt.case stored##.date
      (process)
      (fun _ -> match check ~previous:stored ~update:object_content with
         | false -> Ok false
         | true -> process ()
      )


(** [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:(previous:content Js.t -> update: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 prefix = Jstr.( storage_key + (v "_") ) in
    let start = Jstr.length prefix in

    let rec add_element acc = function
      | -1 -> acc
      | nb ->
        begin match Storage.key storage nb with
          | Some key when (Jstr.starts_with ~prefix 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

let save_for_id
  : Jstr.t option -> 'a Js.t
  = fun id ->
    let element = load id in
    object%js
      val title = element##.title
      val content = element##.content
      val date = element##.date
      val id = id
    end

let to_json
  : unit -> Jstr.t
  = fun () ->
    let keys = get_ids () in
    let pages = List.map ~f:(fun id -> save_for_id (Some id)) keys in
    (* Also add the home page *)
    let pages = Array.of_list @@ (save_for_id None)::pages in
    Brr.Json.encode (Jv.Id.to_jv pages)

let of_json
  : check:(previous:content Js.t -> update:content Js.t -> bool) -> Jstr.t -> (unit, Jv.Error.t) result
  = fun ~check json ->
    let result = Json.decode json in
    Result.map
      (fun v ->
         Array.iter (Jv.Id.of_jv v)
           ~f:(fun element ->
               let key = element##.id
               and content = object%js
                 val title = element##.title
                 val content = element##.content
                 val date = element##.date
               end in
               ignore @@
               save
                 ~check
                 content
                 key
             ))
      result