Editor : on import, preserve the newest notes

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