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
|