Added pop-up and events in editor

15 files changed, 459 insertions, 64 deletions

diff --git a/editor/actions.ml b/editor/actions.ml
index 3b17dae..f7633e1 100755
--- a/editor/actions.ml
+++ b/editor/actions.ml
@@ -1,9 +1,12 @@
 open StdLabels
+open Js_of_ocaml
 open Brr
 open Brr_note
 
 type button_actions =
-  { delete : El.t * (unit Note.event)
+  { delete : unit Note.event
+  ; redirect : Jstr.t option Note.event
+  ; add: unit Note.event
   }
 
 let populate_menu () =
@@ -11,7 +14,6 @@ let populate_menu () =
   | None -> None
   | Some element ->
     let () = Blog.Sidebar.clean element in
-    let uri = Brr.Window.location Brr.G.window in
 
     let delete_button = El.button
         ~at:At.[ class' (Jstr.v "action-button") ]
@@ -20,46 +22,79 @@ let populate_menu () =
             ~at:At.[ class' (Jstr.v "fa")
                    ; class' (Jstr.v "fa-2x")
                    ; class' (Jstr.v "fa-trash")
-                   ]
-        ] in
+                   ] ]
+
+    and home_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-home")
+                   ] ]
+
+    and add_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")
+                   ] ]
+
+    in
 
     let delete_event =
       Evr.on_el
         Ev.click
         Evr.unit
-        delete_button in
+        delete_button
+    and add_event =
+      Evr.on_el
+        Ev.click
+        Evr.unit
+        add_button in
 
+    let stored_pages = Storage.get_ids () in
     let pages =
+      List.map
+        stored_pages
+        ~f:(fun id ->
 
-      List.map (Storage.get_ids ())
-        ~f:(fun name ->
-            let target =
-              Jstr.( (Brr.Uri.path uri)
-                     + (Jstr.v "?page=")
-                     + name) in
+            let name_opt = (Storage.load (Some id))##.title in
+            let name = Js.Opt.get
+                name_opt
+                (fun () -> id) in
+
+            let target = Jstr.v "#" in
             El.li
               [ El.a
                   ~at:[At.href target]
                   [ El.txt name ] ]
           ) in
 
+    (* Wait for a click on an existing page in order to sent the associated
+       event.
+
+       We compose the resulting event with both :
+       - the home button
+       - the list for all the pages presents in the sidebar *)
+    let redirect_event = Note.E.select
+        (( Evr.on_el
+             Ev.click
+             (fun _ -> None)
+             home_button
+         ) :: (
+           List.map2 stored_pages pages
+             ~f:(fun name el ->
+                 Evr.on_el
+                   Ev.click
+                   (fun _ -> Some name)
+                   el ))) 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") ]
-          ]
-      ; 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") ]
-          ]
+      [ home_button
+      ; add_button
       ; El.button
           ~at:At.[class' (Jstr.v "action-button")]
           [ El.i
@@ -84,5 +119,7 @@ let populate_menu () =
 
     let () = El.append_children element childs in
     Some
-      { delete = (delete_button, delete_event)
+      { delete = delete_event
+      ; redirect = redirect_event
+      ; add = add_event
       }
diff --git a/editor/dune b/editor/dune
index 4d6d03c..c8dfe3c 100755
--- a/editor/dune
+++ b/editor/dune
@@ -8,6 +8,7 @@
    prosemirror
    blog
    application
+   forms
    )
  (modes js)
  (preprocess (pps js_of_ocaml-ppx))
diff --git a/editor/editor.css b/editor/editor.css
index 0be2237..fde771d 100644
--- a/editor/editor.css
+++ b/editor/editor.css
@@ -464,3 +464,7 @@ aside ul {
   text-align: left;
 
 }
+
+main article {
+ margin: 0 10px 10px;
+}
diff --git a/editor/editor.ml b/editor/editor.ml
index fccaa76..d3a9624 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -7,11 +7,34 @@ type state =
   { editable : bool
   ; view : PM.View.editor_view Js.t
   ; last_backup: float
+  ; page_id: Jstr.t option
+
+  ; window : El.t list
   }
 
 type events =
   | DeleteEvent
   | StoreEvent
+  | LoadEvent of Jstr.t option
+  | AddEvent
+  | CloseEvent of Forms.Events.kind option
+
+let set_title
+  : Storage.content Js.t -> unit
+  = fun content ->
+    let title =
+      Js.Opt.get
+        content##.title
+        (fun () -> Jstr.empty) in
+    let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
+    Option.iter
+      (fun el -> El.set_prop (El.Prop.value) title el)
+      title_element
+
+let key_of_title
+  : Jstr.t -> Jstr.t
+  = fun title ->
+    title
 
 let state_of_storage
   : PM.t -> Storage.content Js.t -> PM.Model.schema Js.t -> PM.State.editor_state Js.t
@@ -22,8 +45,7 @@ let state_of_storage
          let obj = PM.State.creation_prop () in
          obj##.plugins := Plugins.default pm schema;
          obj##.schema := Js.some schema;
-         PM.State.create pm obj
-      )
+         PM.State.create pm obj)
       (fun page_content ->
          let obj = PM.State.configuration_prop () in
          obj##.plugins := Plugins.default pm schema;
@@ -36,9 +58,8 @@ let state_of_storage
 
 *)
 let build_view
-  : El.t -> PM.View.editor_view Js.t * float
-  = fun editor ->
-    let pm = PM.v () in
+  : PM.t -> Jstr.t option -> El.t -> PM.View.editor_view Js.t * float
+  = fun pm page_id editor ->
 
     (* Remove all the elements if any *)
     El.set_children editor [];
@@ -62,8 +83,7 @@ let build_view
         (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
+    let stored_content = Storage.load 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. *)
@@ -85,26 +105,88 @@ let build_view
         props in
     view, last_backup
 
+let load_page
+  : PM.t -> Jstr.t option -> state -> Storage.content Js.t -> state
+  = fun pm page_id state json ->
+    let editor_state = state_of_storage pm json state.view##.state##.schema in
+    let () = state.view##updateState editor_state
+    and () = set_title json in
+    { state with page_id }
+
 (** [update] is the event loop.
 
     The function take a new event, and apply it to the current state. *)
+
 let update
-  : (events, state) Application.t
-  = fun event state ->
+  : PM.t -> 'a option Note.E.send -> (events, state) Application.t
+  = fun pm close_sender event state ->
     match event with
+
+    | AddEvent ->
+      let title = Jstr.v "Nouvelle page" in
+      let popup = Ui.popup
+          ~title
+          ~form:(Some (Forms.Add_page.create ()))
+          close_sender in
+      { state with window = popup::state.window}
+
     | DeleteEvent ->
-      state
+      begin match state.page_id with
+        | None -> state
+        | Some page_id ->
+          let title = Jstr.v "Confirmation" in
+          let popup = Ui.popup
+              ~title
+              ~form:(Some (Forms.Delete_page.create page_id))
+              close_sender in
+          { state with window = popup::state.window}
+      end
+
+    | CloseEvent res ->
+
+      let state = match state.window with
+        | []     -> { state with window = [] }
+        | el::tl -> El.remove el
+                  ; { state with window = tl } in
+
+      (* The actions is confirmed by the user. Handle the form result *)
+      begin match res with
+        (* Delete the current page, then load the home page *)
+        | Some (Forms.Delete_page.DeletePage id) ->
+          Storage.delete (fun () -> Some id);
+          let json = Storage.load None in
+          load_page pm None state json
+        (* Add a new page *)
+        | Some (Forms.Add_page.AddPage {title}) ->
+          let page_id = key_of_title title in
+          Console.(log [title]);
+          let new_date = (new%js Js.date_now)##getTime in
+          let content_obj = object%js
+            val content = Js.null
+            val title = Js.some title
+            val date = Js.some new_date
+          end in
+          load_page pm (Some page_id) state content_obj
+
+        | _ -> state
+      end
 
     | StoreEvent ->
+
+      let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
+      let content = Option.map
+          (fun el -> El.prop (El.Prop.value) el)
+          title_element in
+
       let new_date = (new%js Js.date_now)##getTime in
       let content_obj = object%js
         val content = Js.some @@ Jv.Id.to_jv (state.view##.state##toJSON ())
-        val title = Js.null
+        val title = Js.Opt.option content
         val date = Js.some new_date
       end in
       let save = Storage.save
           content_obj
-          Storage.page_id
+          state.page_id
           ~check:(fun previous_state ->
               Js.Opt.case previous_state##.date
                 (fun () -> true)
@@ -119,9 +201,16 @@ let update
                    date <= state.last_backup)) in
       begin match save with
         | Ok true -> { state with last_backup = new_date }
-        | _ -> state
+        | _ ->
+          (* TODO In case of error, notify the user *)
+          state
       end
 
+    | LoadEvent page_id ->
+      let json = Storage.load page_id in
+      load_page pm page_id state json
+
+
 let app id content =
 
   (* Check the pre-requisite *)
@@ -129,22 +218,37 @@ let app id content =
   match (Jv.is_none id), (Jv.is_none content), events_opt with
   | false, false, Some btn_events ->
 
+    let pm = PM.v () in
     let editor:El.t = Jv.Id.of_jv id in
-    let view, last_backup = build_view editor in
+    (* Load the cache for the given page *)
+    let page_id = Storage.page_id () in
+    let view, last_backup = build_view pm page_id editor in
+
+
+    (* This event is used in the pop process. The sender is given to the
+       subroutine in order to track the window closing *)
+    let event, sender = Note.E.create () in
+    let _ = sender in
 
     let init_state =
       { editable = true
       ; view
       ; last_backup
+      ; page_id
+
+      ; window = []
       }
     in
 
     let app_state = Application.run
-        update
+        (update pm sender)
         init_state
         (Note.E.select
-           [ Note.E.map (fun () -> DeleteEvent) (snd btn_events.Actions.delete)
+           [ Note.E.map (fun () -> DeleteEvent) btn_events.Actions.delete
            ; Brr_note.Evr.on_el Ev.focusout (fun _ -> StoreEvent) editor
+           ; Note.E.map (fun v -> LoadEvent v) btn_events.Actions.redirect
+           ; Note.E.map (fun () -> AddEvent) btn_events.Actions.add
+           ; Note.E.map (fun v -> CloseEvent v) event
            ]) in
 
     let () =
diff --git a/editor/forms.css b/editor/forms.css
new file mode 100755
index 0000000..a75de92
--- /dev/null
+++ b/editor/forms.css
@@ -0,0 +1,32 @@
+form .row::after {
+
+    content: "";
+    display: table;
+    clear: both;
+
+}
+
+form .col-25 {
+    float: left;
+    width: 25%;
+}
+
+form .col-75 {
+    float: left;
+    width: 75%;
+}
+
+form label {
+    padding: 12px 12px 12px 0px;
+    display: inline-block;
+
+}
+
+form input[type="text"] {
+    padding: 12px 0px;
+    width: 100%;
+}
+
+input[type=submit] {
+    float: right;
+}
diff --git a/editor/forms/add_page.ml b/editor/forms/add_page.ml
new file mode 100755
index 0000000..597e9d3
--- /dev/null
+++ b/editor/forms/add_page.ml
@@ -0,0 +1,36 @@
+open Brr
+open Brr_note
+open Note
+
+type Events.kind +=
+  | AddPage of { title : Jstr.t }
+
+let create
+  : unit -> Events.t
+  = fun () ->
+
+    (* The element which contains the information *)
+    let input = El.input ()
+        ~at:At.[type' (Jstr.v "text")]
+    in
+
+    let state =
+      S.hold (AddPage { title = Jstr.empty })
+      @@ Evr.on_el
+        (Ev.input)
+        (fun _ ->
+           AddPage { title = El.prop El.Prop.value input }
+        )
+        input in
+
+    ( state
+    , El.div
+        [ El.div ~at:At.[class' (Jstr.v "row")]
+            [ El.div ~at:At.[class' (Jstr.v "col-25")]
+                [ El.label [ El.txt' "Titre"]
+                    ~at:[At.for' (Jstr.v "title")]
+                ]
+            ; El.div ~at:At.[class' (Jstr.v "col-75")]
+                [ input ]
+            ]
+        ] )
diff --git a/editor/forms/add_page.mli b/editor/forms/add_page.mli
new file mode 100755
index 0000000..97b1d6c
--- /dev/null
+++ b/editor/forms/add_page.mli
@@ -0,0 +1,5 @@
+type Events.kind +=
+  | AddPage of { title : Jstr.t }
+
+val create
+  : unit -> Events.t
diff --git a/editor/forms/delete_page.ml b/editor/forms/delete_page.ml
new file mode 100755
index 0000000..701162c
--- /dev/null
+++ b/editor/forms/delete_page.ml
@@ -0,0 +1,25 @@
+open Brr
+open Note
+
+type Events.kind +=
+  | DeletePage of Jstr.t [@@unboxed]
+
+let create
+  : Jstr.t -> Events.t
+  = fun name ->
+
+    let state =
+      S.const (DeletePage name) in
+
+    let message = begin
+      let open Jstr in
+
+      (v "La page " )
+      + name
+      + (v " sera définitivement supprimée")
+    end in
+
+    ( state
+    , El.txt message
+    )
+
diff --git a/editor/forms/dune b/editor/forms/dune
new file mode 100755
index 0000000..9876654
--- /dev/null
+++ b/editor/forms/dune
@@ -0,0 +1,12 @@
+(library
+ (name forms)
+ (libraries 
+   brr
+   brr.note
+   elements
+   js_lib
+   blog
+   application
+   )
+ (preprocess (pps js_of_ocaml-ppx))
+ )
diff --git a/editor/forms/events.ml b/editor/forms/events.ml
new file mode 100755
index 0000000..339e15d
--- /dev/null
+++ b/editor/forms/events.ml
@@ -0,0 +1,5 @@
+(** This type is designed to be extended for each form *)
+type kind = ..
+
+type t = kind Note.signal * Brr.El.t
+
diff --git a/editor/index.html b/editor/index.html
index ed1f9fe..da0d39d 100755
--- a/editor/index.html
+++ b/editor/index.html
@@ -14,6 +14,8 @@
   <link rel="stylesheet" type="text/css" href="/theme/font-awesome/css/brands.css">
   <link rel="stylesheet" type="text/css" href="/theme/font-awesome/css/solid.css">
   <link rel="stylesheet" type="text/css" href="./editor.css">
+  <link rel="stylesheet" type="text/css" href="./modal.css">
+  <link rel="stylesheet" type="text/css" href="./forms.css">
   <link href="//localhost:8000/custom.css" rel="stylesheet">
 
   <title>Chimrod &ndash; Editor</title>
@@ -29,12 +31,14 @@
 <body class="light-theme">
   <aside>
     <div>
+     <!-- 
       <a href="/">
         <img src="/profile.png" alt="Chimrod" title="Chimrod">
       </a>
+      -->
 
       <h1>
-        <a href="//localhost:8000">Chimrod</a>
+        <a href="//localhost:8000">Notes</a>
       </h1>
       <nav>
         <ul class="list">
diff --git a/editor/modal.css b/editor/modal.css
new file mode 100755
index 0000000..0c50a8d
--- /dev/null
+++ b/editor/modal.css
@@ -0,0 +1,69 @@
+/* The Modal (background) */
+.modal {
+  position: fixed; /* Stay in place */
+  z-index: 100; /* Sit on top */
+  padding-top: 100px; /* Location of the box */
+  left: 0;
+  top: 0;
+  width: 100%; /* Full width */
+  height: 100%; /* Full height */
+  overflow: auto; /* Enable scroll if needed */
+  background-color: rgb(0,0,0); /* Fallback color */
+  background-color: rgba(0,0,0,0.4); /* Black w/ opacity */
+}
+
+/* Modal Content */
+.modal-content {
+  position: relative;
+  background-color: #fefefe;
+  margin: auto;
+  padding: 0;
+  border: 1px solid #000;
+  width: 45%;
+  box-shadow: 0 4px 8px 0 rgba(0,0,0,0.2),0 6px 20px 0 rgba(0,0,0,0.19);
+  -webkit-animation-name: animatetop;
+  -webkit-animation-duration: 0.4s;
+  animation-name: animatetop;
+  animation-duration: 0.4s
+}
+
+/* Add Animation */
+@-webkit-keyframes animatetop {
+  from {top:-300px; opacity:0} 
+  to {top:0; opacity:1}
+}
+
+@keyframes animatetop {
+  from {top:-300px; opacity:0}
+  to {top:0; opacity:1}
+}
+
+
+/* The Close Button */
+.modal-close {
+  color: white;
+  float: right;
+  font-size: 28px;
+  font-weight: bold;
+}
+
+.modal-close:hover,
+.modal-close:focus {
+  color: #000;
+  text-decoration: none;
+  cursor: pointer;
+}
+
+.modal-header {
+  padding: 1px 16px;
+  background-color: #333;
+  color: white;
+}
+
+.modal-body {padding: 16px 16px;}
+
+.modal-footer {
+  padding: 1px 16px;
+  background-color: #333;
+  color: white;
+}
diff --git a/editor/storage.ml b/editor/storage.ml
index 5dbaab9..f893c2d 100755
--- a/editor/storage.ml
+++ b/editor/storage.ml
@@ -76,9 +76,9 @@ let save'
     storage. The right key is given by the result of the function [f]
 *)
 let load
-  : (unit -> Jstr.t option) -> content Js.t
-  = fun f ->
-    match f () with
+  : Jstr.t option -> content Js.t
+  = fun key ->
+    match key with
     | None -> load' storage_key
     | Some value ->
       let key = Jstr.concat
@@ -87,9 +87,9 @@ let load
       load' key
 
 let save
-  : 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
+  : check:(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 ->
@@ -103,11 +103,12 @@ let delete
   = fun f ->
     match f () with
     | None -> ()
-    | Some key ->
+    | Some value ->
+      let key = Jstr.concat
+          ~sep:(Jstr.v "_")
+          [storage_key ;  value] in
       let storage = Brr_io.Storage.local G.window in
-      let () = Brr_io.Storage.remove_item storage key in
-      (* Reload the page *)
-      Brr.Window.reload G.window
+      Brr_io.Storage.remove_item storage key
 
 let get_ids
   : unit -> Jstr.t list
@@ -120,7 +121,7 @@ let get_ids
     let start = Jstr.length sub in
 
     let rec add_element acc = function
-      | 0 -> acc
+      | -1 -> acc
       | nb ->
         begin match Storage.key storage nb with
           | Some key when (Jstr.starts_with ~sub key) ->
@@ -128,7 +129,8 @@ let get_ids
             let key_name = Jstr.sub key
                 ~start in
             add_element (key_name::acc) (nb -1)
-          | _ -> add_element acc (nb -1)
+          | _ ->
+            add_element acc (nb -1)
         end
 
     in
diff --git a/editor/storage.mli b/editor/storage.mli
index 7ae77a6..5b7e0a0 100755
--- a/editor/storage.mli
+++ b/editor/storage.mli
@@ -22,12 +22,12 @@ end
     The function [f] is called to identified which is the appropriate page id.
 *)
 val load
-  : (unit -> Jstr.t option) -> content Js.t
+  : Jstr.t option -> content Js.t
 
 val save
-  : check:(content Js.t -> bool) -> content Js.t -> (unit -> Jstr.t option) -> (bool, Jv.Error.t) result
+  : check:(content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
 
-(** Remove the page from the storage and reload the page *)
+(** Remove the page from the storage. *)
 val delete 
   : (unit -> Jstr.t option) -> unit
 
diff --git a/editor/ui.ml b/editor/ui.ml
index 001ae98..a4f5416 100755
--- a/editor/ui.ml
+++ b/editor/ui.ml
@@ -1,8 +1,67 @@
 open Brr
+open Brr_note
 module Js = Js_of_ocaml.Js
 
 let popup
-  : unit -> El.t
-  = fun () ->
-    El.div
-      []
+  : title:Jstr.t -> ?form:Forms.Events.t option -> 'a option Note.E.send -> El.t
+  = fun ~title ?(form = None) send ->
+    let _ = send in
+
+    let close_btn =
+      El.span
+        ~at:At.[class' (Jstr.v "modal-close")]
+        [ El.txt' "×"] in
+
+    Evr.endless_listen
+      (El.as_target close_btn)
+      Ev.click
+      (fun _ -> send None);
+
+    let container = match form with
+      | None -> El.div
+      | Some _ -> El.form
+
+    and body = match form with
+      | None -> El.div []
+      | Some (_, content) -> content
+
+
+    and footer = match form with
+      | None -> El.txt Jstr.empty
+      | Some (values, _) ->
+
+
+        let log = Note.S.log values (fun _ -> ()) in
+
+        let btn = El.input ()
+            ~at:At.[type' (Jstr.v "submit")] in
+
+        Evr.endless_listen
+          (El.as_target btn)
+          Ev.click
+          (fun _ -> Note.Logr.force log
+                  ; send (Some (Note.S.value values)));
+
+        El.div ~at:At.[class' (Jstr.v "row")]
+          [ btn ]
+    in
+
+    let el = El.div
+        ~at:At.[class' (Jstr.v "modal")]
+        [ container
+            ~at:At.[class' (Jstr.v "modal-content")]
+            [ El.div
+                ~at:At.[class' (Jstr.v "modal-header")]
+                [ close_btn
+                ; El.h3
+                    [ El.txt title ]]
+            ; El.div
+                ~at:At.[class' (Jstr.v "modal-body")]
+                [ body ]
+            ; El.div
+                ~at:At.[class' (Jstr.v "modal-footer")]
+                [ footer ]]] in
+
+    El.append_children (Document.body G.document)
+      [ el ]
+  ; el