From 179720a7f2c790ea5557bb5caabe22a926b3e106 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 7 Feb 2022 15:19:47 +0100 Subject: Editor : on import, preserve the newest notes --- editor/actions/import.ml | 31 +++++++++++++++++++++--- editor/editor.ml | 11 +++++++-- editor/forms/selector.ml | 63 ++++++++++++++++++++++++++++++++++++++++++------ editor/state/storage.ml | 29 ++++++++++++++-------- editor/state/storage.mli | 4 +-- 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 -- cgit v1.2.3