summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xeditor/actions.ml93
-rwxr-xr-xeditor/dune1
-rw-r--r--editor/editor.css4
-rwxr-xr-xeditor/editor.ml136
-rwxr-xr-xeditor/forms.css32
-rwxr-xr-xeditor/forms/add_page.ml36
-rwxr-xr-xeditor/forms/add_page.mli5
-rwxr-xr-xeditor/forms/delete_page.ml25
-rwxr-xr-xeditor/forms/dune12
-rwxr-xr-xeditor/forms/events.ml5
-rwxr-xr-xeditor/index.html6
-rwxr-xr-xeditor/modal.css69
-rwxr-xr-xeditor/storage.ml26
-rwxr-xr-xeditor/storage.mli6
-rwxr-xr-xeditor/ui.ml67
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