Changed the application structure in the editor

7 files changed, 331 insertions, 143 deletions

diff --git a/editor/actions.ml b/editor/actions.ml
new file mode 100755
index 0000000..c02584f
--- /dev/null
+++ b/editor/actions.ml
@@ -0,0 +1,96 @@
+open StdLabels
+open Brr
+open Brr_note
+
+type button_actions =
+  { edit : El.t * (unit Note.event)
+  }
+
+let populate_menu () =
+  match Blog.Sidebar.get () with
+  | None -> None
+  | Some element ->
+    let () = Blog.Sidebar.clean element in
+    let uri = Brr.Window.location Brr.G.window in
+
+    let edit_button = El.button
+        ~at:At.[ class' (Jstr.v "action-button") ]
+        [ El.i
+            []
+            ~at:At.[ class' (Jstr.v "fa")
+                   ; class' (Jstr.v "fa-2x")
+                   ; class' (Jstr.v "fa-pen")
+                   ]
+        ] in
+
+    let edit_event =
+      Evr.on_el
+        Ev.click
+        Evr.unit
+        edit_button in
+
+    let pages =
+
+      List.map (Storage.get_ids ())
+        ~f:(fun name ->
+            let target =
+              Jstr.( (Brr.Uri.path uri)
+                     + (Jstr.v "?page=")
+                     + name) in
+            El.li
+              [ El.a
+                  ~at:[At.href target]
+                  [ El.txt name ] ]
+          ) in
+
+    let childs =
+      [ El.button
+          ~at:At.[class' (Jstr.v "action-button")]
+          [ El.i
+              []
+              ~at:At.[ class' (Jstr.v "fa")
+                     ; class' (Jstr.v "fa-2x")
+                     ; class' (Jstr.v "fa-home") ]
+          ]
+      ; edit_button
+      ; El.button
+          ~at:At.[class' (Jstr.v "action-button")]
+          [ El.i
+              []
+              ~at:At.[ class' (Jstr.v "fa")
+                     ; class' (Jstr.v "fa-2x")
+                     ; class' (Jstr.v "fa-plus") ]
+          ]
+      ; El.button
+          ~at:At.[class' (Jstr.v "action-button")]
+          [ El.i
+              []
+              ~at:At.[ class' (Jstr.v "fa")
+                     ; class' (Jstr.v "fa-2x")
+                     ; class' (Jstr.v "fa-download") ]
+          ]
+      ; El.button
+          ~at:At.[class' (Jstr.v "action-button")]
+          [ El.i
+              []
+              ~at:At.[ class' (Jstr.v "fa")
+                     ; class' (Jstr.v "fa-2x")
+                     ; class' (Jstr.v "fa-trash") ]
+          ]
+      ; El.button
+          ~at:At.[class' (Jstr.v "action-button")]
+          [ El.i
+              []
+              ~at:At.[ class' (Jstr.v "fa")
+                     ; class' (Jstr.v "fa-2x")
+                     ; class' (Jstr.v "fa-cog") ]
+          ]
+      ; El.hr ()
+      ; El.ul
+          pages
+      ] in
+
+    let () = El.append_children element childs in
+    Some
+      { edit = (edit_button, edit_event)
+      }
diff --git a/editor/dune b/editor/dune
index 767d35e..4d6d03c 100755
--- a/editor/dune
+++ b/editor/dune
@@ -7,6 +7,7 @@
    js_lib
    prosemirror
    blog
+   application
    )
  (modes js)
  (preprocess (pps js_of_ocaml-ppx))
diff --git a/editor/editor.css b/editor/editor.css
index 09fc472..0be2237 100644
--- a/editor/editor.css
+++ b/editor/editor.css
@@ -442,11 +442,20 @@ footnote::after {
 }
 
 .action-button  {
-    background-color: unset; 
-    color: unset;
-    border: 0px
+  background-color: unset; 
+  color: unset;
+  border: 0px
 }
 
+.action-button.active {
+  background-color: white; 
+  color: #333;
+  border-radius: 5px;
+}
+
+.action-button:hover {
+  border-bottom: 1px solid white;
+}
 .action-button:active {
     transform: translateY(1px);
 }
diff --git a/editor/editor.ml b/editor/editor.ml
index c3cad1e..53a6029 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -1,108 +1,170 @@
-open StdLabels
 open Brr
 module PM = Prosemirror
 module Js = Js_of_ocaml.Js
 
-let populate_menu () =
-  match Blog.Sidebar.get () with
-  | None -> ()
-  | Some element ->
-    let () = Blog.Sidebar.clean element in
-    let uri = Brr.Window.location Brr.G.window in
-
-    let pages =
-
-      List.map (Storage.get_ids ())
-        ~f:(fun name ->
-            let target =
-              Jstr.( (Brr.Uri.path uri)
-                     + (Jstr.v "?page=")
-                     + name) in
-            El.li
-              [ El.a
-                  ~at:[At.href target]
-                  [ El.txt name ] ]
-          ) in
-
-    let childs =
-      [ El.button
-          ~at:At.[class' (Jstr.v "action-button")]
-          [ El.i
-              []
-              ~at:At.[ class' (Jstr.v "fa")
-                     ; class' (Jstr.v "fa-2x")
-                     ; class' (Jstr.v "fa-times-circle")
-                     ]
-          ]
-      ; El.hr ()
-      ; El.ul
-          pages
-      ] in
-
-    El.append_children element childs
-
-
-let prosemirror id content =
-  begin match (Jv.is_none id), (Jv.is_none content) with
-    | false, false ->
-
-      let module PM = Prosemirror in
-      let pm = PM.v () in
-
-      let schema = (PM.SchemaBasic.schema pm) in
-      let schema = Footnotes.footnote_schema pm schema in
-
-      let specs = PM.Model.schema_spec
-          (PM.SchemaList.add_list_nodes
-             pm
-             (schema##.spec##.nodes)
-             (Jstr.v "paragraph block*")
-             (Some (Jstr.v "block")))
-          (Some schema##.spec##.marks)
-          None in
-      let mySchema = PM.Model.schema pm specs in
-
-      populate_menu ();
-
-      (* Create the initial state *)
-      let state = Storage.load pm mySchema (Jv.Id.of_jv content) Storage.page_id in
-
-      let props = PM.View.direct_editor_props () in
-      props##.state := state;
-
-      (* Each time the state is update, handle the copy *)
-      props##.dispatchTransaction := Js.wrap_meth_callback @@ (fun view tr ->
-          let state = view##.state##apply tr in
-          view##updateState state
-        );
-
-      let view' = (Footnotes.footnote_view pm) in
-
-      let nodes = PM.O.init
-          [| ("footnote", view')  |] in
-      props##.nodeViews := nodes;
-      let view = PM.View.editor_view
-          pm
-          (Jv.Id.of_jv id)
-          props in
-
-      (* Attach an event on focus out *)
-      let _ = Brr_note.Evr.on_el
-          (Ev.focusout)
-          (fun _ -> Storage.save view Storage.page_id)
-          (Jv.Id.of_jv id) in
-
-      ()
-
-    | _, _ -> Console.(error [str "No element with id '%s' '%s' found"; id ; content])
-
-  end
+(** This is the state for the application *)
+type state =
+  { editable : bool
+  }
+
+type events =
+  | EditEvent
+
+let editor_of_storage
+  : PM.t -> Storage.content Js.t -> PM.Model.schema Js.t -> PM.State.editor_state Js.t
+  = fun pm content schema ->
+    Js.Opt.case
+      content##.content
+      (fun () ->
+         let obj = PM.State.creation_prop () in
+         obj##.plugins := Plugins.default pm schema;
+         obj##.schema := Js.some schema;
+         PM.State.create pm obj
+      )
+      (fun page_content ->
+         let obj = PM.State.configuration_prop () in
+         obj##.plugins := Plugins.default pm schema;
+         obj##.schema := Js.some schema;
+         PM.State.fromJSON pm obj page_content)
+
+let update
+  : (events, state) Application.t
+  = fun event state ->
+    match event with
+    | EditEvent ->
+      { editable = not state.editable }
+
+let init_state =
+  { editable = true
+  }
+
+let build_view
+  : El.t -> state Note.S.t -> PM.View.editor_view Js.t * float ref
+  = fun editor app_state ->
+    let pm = PM.v () in
+
+    (* Remove all the elements if any *)
+    El.set_children editor [];
+
+    (* TODO
+       This could be improved, instead of creating a new schema, just fetch
+       the node and marks from the plungin *)
+    let custom_schema =
+      Footnotes.footnote_schema
+        pm
+        (PM.SchemaBasic.schema pm) in
+
+    (* Recreate the full schema by adding all the nodes and marks from the
+       plugings *)
+    let specs = PM.Model.schema_spec
+        (PM.SchemaList.add_list_nodes
+           pm
+           (custom_schema##.spec##.nodes)
+           (Jstr.v "paragraph block*")
+           (Some (Jstr.v "block")))
+        (Some custom_schema##.spec##.marks)
+        None in
+    let full_schema = PM.Model.schema pm specs in
+    (* Load the cache for the given page *)
+    let stored_content = Storage.load Storage.page_id in
+
+    (* This variable contains the last update time, either because it is
+       stored, or because it is the date where we create the first page. *)
+    let last_backup = ref @@ Js.Opt.get
+        stored_content##.date
+        (fun () -> (new%js Js.date_now)##getTime) in
+
+    let props = PM.View.direct_editor_props () in
+    props##.state := editor_of_storage pm stored_content full_schema;
+    props##.editable := Js.wrap_callback @@ (fun _state ->
+        Js.bool ( (Note.S.value app_state).editable) );
+
+    (* Add the custom nodes *)
+    props##.nodeViews := PM.O.init
+        [| ( "footnote", (Footnotes.footnote_view pm))
+        |];
+
+    let view = PM.View.editor_view
+        pm
+        editor
+        props in
+    view, last_backup
+
+let app id content =
+
+  (* Check the pre-requisite *)
+  let events_opt = Actions.populate_menu () in
+  match (Jv.is_none id), (Jv.is_none content), events_opt with
+  | false, false, Some btn_events ->
+
+    let editor:El.t = Jv.Id.of_jv id in
+    let app_state = Application.run
+        update
+        init_state
+        (Note.E.select
+           [ Note.E.map (fun () -> EditEvent) (snd btn_events.Actions.edit)
+           ]) in
+
+    let () =
+      Note.S.log app_state (fun _ -> ())
+      |> Note.Logr.hold in
+
+    (** Map active style of the button with the state *)
+    let () =
+      Brr_note.Elr.def_class
+        (Jstr.v "active")
+        (Note.S.map (fun s -> s.editable) app_state)
+        (fst btn_events.Actions.edit) in
+
+    let view, last_backup = build_view editor app_state in
+
+    (* Attach an event on focus out *)
+    let _ = Brr_note.Evr.on_el
+        (Ev.focusout)
+        (fun _ ->
+           let new_date = (new%js Js.date_now)##getTime in
+           let content_obj = object%js
+             val content = Js.some @@ Jv.Id.to_jv (view##.state##toJSON ())
+             val title = Js.null
+             val date = Js.some new_date
+           end in
+           let save = Storage.save
+               content_obj
+               Storage.page_id
+               ~check:(fun previous_state ->
+                   Js.Opt.case previous_state##.date
+                     (fun () -> true)
+                     (fun date ->
+                        (* I do not figure how the previous date could be older
+                           than the last backup. It could be either :
+
+                           - equal (if we are the only one to update it)
+                           - more recent (if the content has been updated elsewhere)
+
+                           but older shoud be a bug. *)
+                        date <= !last_backup)) in
+           match save with
+           | Ok true -> last_backup := new_date
+           | _ -> ())
+        editor in
+
+    let ev =
+      Note.E.map
+        (fun _ -> view##dispatch view##.state##.tr)
+        (Note.S.changes (Note.S.map (fun s -> s.editable) app_state)) in
+    let () =
+      Note.E.log ev (fun _ -> ())
+      |> Option.iter Note.Logr.hold in
+    ()
+
+  | _, _, _ ->
+    Console.(error [str "No element with id '%s' '%s' found"; id ; content])
 
 let () =
 
   let open Jv in
   let editor = obj
-      [| "attach_prosemirror", (repr prosemirror)
+      [| "attach_prosemirror", (repr app)
       |] in
 
   set global "editor" editor
diff --git a/editor/footnotes.ml b/editor/footnotes.ml
index a3ba9cd..794171f 100755
--- a/editor/footnotes.ml
+++ b/editor/footnotes.ml
@@ -136,7 +136,7 @@ let footnote_view
       method _open =
         (* Append a tooltip to the outer node *)
         let tooltip = El.div []
-            ~at:At.([class' (Jstr.v "footnote-tooltip")]) in
+            ~at:At.([class' (Jstr.v "popin")]) in
         El.append_children _self##.dom
           [ tooltip ];
 
diff --git a/editor/storage.ml b/editor/storage.ml
index 0d74a05..5dbaab9 100755
--- a/editor/storage.ml
+++ b/editor/storage.ml
@@ -1,27 +1,22 @@
 open Brr
-module PM = Prosemirror
 module Js = Js_of_ocaml.Js
 
 let storage_key = (Jstr.v "editor")
 
 let storage = Brr_io.Storage.local G.window
 
-let create_new_state pm mySchema content =
-  let module PM = Prosemirror in
+class type content = object
 
-  let doc = PM.Model.(
-      DOMParser.parse
-        (DOMParser.from_schema pm mySchema)
-        content) in
+  method title
+    : Jstr.t Js.opt Js.readonly_prop
 
-  let props = PM.State.creation_prop () in
-  props##.doc := Js.some doc;
-  props##.plugins := Plugins.default pm mySchema;
+  method content
+    : Jv.t Js.opt Js.readonly_prop
 
-  PM.State.create
-    pm
-    props
+  method date
+    : float Js.opt Js.readonly_prop
 
+end
 
 let page_id
   : unit -> Jstr.t option
@@ -35,59 +30,73 @@ let page_id
     storage for the [key].
 *)
 let load'
-  : PM.t -> PM.Model.schema Js.t -> El.t -> Jstr.t -> PM.State.editor_state Js.t
-  = fun pm schema content key ->
+  : Jstr.t -> content Js.t
+  = fun key ->
 
     let opt_data = Brr_io.Storage.get_item storage key in
     match opt_data with
-    | None -> create_new_state pm schema content
+    | 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 _ -> create_new_state pm schema content
+      | Error _ ->
+        object%js
+          val title = Js.null
+          val content = Js.null
+          val date = Js.null
+        end
+
       | Ok json ->
-        let obj = PM.State.configuration_prop () in
-        obj##.plugins := Plugins.default pm schema;
-        obj##.schema := Js.some schema;
-        PM.State.fromJSON pm obj json
+        Jv.Id.of_jv json
 
 (** Save the view *)
 let save'
-  : PM.View.editor_view Js.t -> Jstr.t -> unit
-  = fun view key ->
-    let contents = view##.state##toJSON () in
-    let storage = Brr_io.Storage.local G.window in
-    Brr_io.Storage.set_item
-      storage
-      key
-      (Json.encode @@ contents)
-    |> Console.log_if_error ~use:()
+  : check:(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 ->
+      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
 
 
 (** [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
-  : PM.t -> PM.Model.schema Js.t -> El.t -> (unit -> Jstr.t option) -> PM.State.editor_state Js.t
-  = fun pm schema content f ->
+  : (unit -> Jstr.t option) -> content Js.t
+  = fun f ->
     match f () with
-    | None -> load' pm schema content storage_key
+    | None -> load' storage_key
     | Some value ->
       let key = Jstr.concat
           ~sep:(Jstr.v "_")
           [storage_key ;  value] in
-      load' pm schema content key
+      load' key
 
 let save
-  : PM.View.editor_view Js.t -> (unit -> Jstr.t option) -> unit
-  = fun view f ->
+  : check:(content Js.t -> bool) -> content Js.t -> (unit -> Jstr.t option) -> (bool, Jv.Error.t) result
+  = fun ~check object_content f ->
     match f () with
-    | None -> save' view storage_key
+    | None ->
+      save' ~check object_content storage_key
     | Some value ->
       let key = Jstr.concat
           ~sep:(Jstr.v "_")
           [storage_key ;  value] in
-      save' view key
+      save' ~check object_content key
 
 let delete
   : (unit -> Jstr.t option) -> unit
diff --git a/editor/storage.mli b/editor/storage.mli
index 5424119..7ae77a6 100755
--- a/editor/storage.mli
+++ b/editor/storage.mli
@@ -1,20 +1,31 @@
-module PM = Prosemirror
 module Js = Js_of_ocaml.Js
 
 (** Provide a function for extracting the page id from the URL *)
 val page_id
   : unit -> Jstr.t option
 
-(** load pm schema content f] will load the content and store it into the
-    element [content]. 
+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
+
+(** load f] will try to load the content associated with the given key.
 
     The function [f] is called to identified which is the appropriate page id.
 *)
 val load
-  : PM.t -> PM.Model.schema Js.t -> Brr.El.t -> (unit -> Jstr.t option) -> PM.State.editor_state Js.t
+  : (unit -> Jstr.t option) -> content Js.t
 
 val save
-  : PM.View.editor_view Js.t -> (unit -> Jstr.t option) -> unit
+  : check:(content Js.t -> bool) -> content Js.t -> (unit -> Jstr.t option) -> (bool, Jv.Error.t) result
 
 (** Remove the page from the storage and reload the page *)
 val delete