summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xeditor/actions/import.ml31
-rwxr-xr-xeditor/editor.ml11
-rwxr-xr-xeditor/forms/selector.ml63
-rwxr-xr-xeditor/state/storage.ml29
-rwxr-xr-xeditor/state/storage.mli4
5 files changed, 112 insertions, 26 deletions
diff --git a/editor/actions/import.ml b/editor/actions/import.ml
index cb0c16d..4cac76c 100755
--- a/editor/actions/import.ml
+++ b/editor/actions/import.ml
@@ -1,5 +1,21 @@
module Js = Js_of_ocaml.Js
+let uncheck_import =
+ fun ~previous ~update ->
+ let _ = previous
+ and _ = update in
+ true
+
+let check_import =
+ fun ~previous ~update ->
+ Js.Opt.case previous##.date
+ (fun () -> true)
+ (fun previous_date ->
+ Js.Opt.case update##.date
+ (fun () -> true)
+ (fun update_date ->
+ update_date >= previous_date ))
+
module M = struct
type t = Forms.Selector.t
@@ -7,13 +23,20 @@ module M = struct
let update
: t -> State.t -> State.t
= fun t state ->
- match t with
+ match t.Forms.Selector.file with
| None -> state
| Some file ->
- (* Back to UTF-16 *)
let content = file.Elements.Input.content in
- Brr.Console.(log [content] );
- match State.Storage.of_json content with
+ let check =
+ if t.Forms.Selector.preserve_newest then
+ check_import
+ else
+ uncheck_import
+ in
+ match
+ State.Storage.of_json
+ ~check
+ content with
| Error _ -> state
| Ok _obj ->
State.load_page state.State.page_id state
diff --git a/editor/editor.ml b/editor/editor.ml
index c80b426..51ff3e4 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -77,8 +77,15 @@ module Store = struct
let save = State.Storage.save
content_obj
state.page_id
- ~check:(fun previous_state ->
- Js.Opt.case previous_state##.date
+ (* There three date here :
+ - The actual date at the time we save the note
+ - The date associated with the note when we loaded it first time
+ - The date associated with the note at the time we want to update it
+
+ The two last may differ if the note has been updated in another one tab. *)
+ ~check:(fun ~previous ~update ->
+ let _ = update in
+ Js.Opt.case previous##.date
(fun () -> true)
(fun date ->
(* I do not figure how the previous date could be older
diff --git a/editor/forms/selector.ml b/editor/forms/selector.ml
index de11499..d4e4795 100755
--- a/editor/forms/selector.ml
+++ b/editor/forms/selector.ml
@@ -1,16 +1,63 @@
+open Brr
+
type file = Elements.Input.file
-type t = file option
+
+type t =
+ { file : file option
+ ; preserve_newest : bool
+ }
+
+let update
+ : 'a -> t -> t
+ = fun event state ->
+ match event with
+ | `Add_file v -> {state with file = Some v}
+ | `Check v -> { state with preserve_newest = v}
let create
- : unit -> t Note.signal * Brr.El.t
+ : unit -> t Note.signal * El.t
= fun () ->
- let add_file_event, i = Elements.Input.file_loader
- (Jstr.v ".json") in
+ let i, add_file_event = Elements.Input.file_loader
+ (Jstr.v ".json")
+
+ and checkbox = El.input ()
+ ~at:(At.
+ [ type' (Jstr.v "checkbox")
+ ; id (Jstr.v "check_date")
+ ; checked
+ ])
+
+ and label = El.label
+ ~at:(At.[
+ for' (Jstr.v "check_date")
+ ])
+ [El.txt' "Conserver les notes plus récentes"] in
+
+ let check_event = Brr_note.Evr.on_el
+ Brr.Ev.change
+ (fun _ -> `Check (El.prop (El.Prop.checked) checkbox))
+ checkbox in
+
+ let init =
+ { file = None
+ ; preserve_newest = true} in
+
+ let update_event =
+ (Note.E.map update)
+ (Note.E.select
+ [ Note.E.map (fun v -> `Add_file v) add_file_event
+ ; check_event
+ ]) in
- let state = Note.S.hold
- None
- (Note.E.map (fun v -> Some v) add_file_event)
+ let state = Note.S.accum
+ init
+ update_event
in
( state
- , i )
+ , El.div
+ [ i
+ ; El.div
+ [ checkbox
+ ; label ]
+ ])
diff --git a/editor/state/storage.ml b/editor/state/storage.ml
index 1bb8b81..4688881 100755
--- a/editor/state/storage.ml
+++ b/editor/state/storage.ml
@@ -58,20 +58,29 @@ let load'
(** Save the view *)
let save'
- : check:(content Js.t -> bool) -> content Js.t -> Jstr.t -> (bool, Jv.Error.t) result
+ : 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 *)
- match check (load' key) with
- | false ->
- Ok false
- | true ->
+ (* 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
@@ -89,7 +98,7 @@ let load
load' key
let save
- : check:(content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
+ : 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 ->
@@ -159,8 +168,8 @@ let to_json
Brr.Json.encode (Jv.Id.to_jv pages)
let of_json
- : Jstr.t -> (unit, Jv.Error.t) result
- = fun 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 ->
@@ -174,7 +183,7 @@ let of_json
end in
ignore @@
save
- ~check:(fun _ -> true)
+ ~check
content
key
))
diff --git a/editor/state/storage.mli b/editor/state/storage.mli
index 4d022d1..cad2982 100755
--- a/editor/state/storage.mli
+++ b/editor/state/storage.mli
@@ -25,7 +25,7 @@ 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
+ : check:(previous:content Js.t -> update:content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
(** Remove the page from the storage. *)
val delete
@@ -39,4 +39,4 @@ val to_json
: unit -> Jstr.t
val of_json
- : Jstr.t -> (unit, Jv.Error.t) result
+ : check:(previous:content Js.t -> update:content Js.t -> bool) -> Jstr.t -> (unit, Jv.Error.t) result