aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xeditor/actions.ml120
-rwxr-xr-xeditor/actions/actions.ml128
-rwxr-xr-xeditor/actions/add_page.ml11
-rwxr-xr-xeditor/actions/delete_page.ml16
-rwxr-xr-xeditor/actions/dune13
-rwxr-xr-xeditor/actions/event.ml8
-rwxr-xr-xeditor/app.ml50
-rwxr-xr-xeditor/dune1
-rwxr-xr-xeditor/editor.ml27
-rwxr-xr-xeditor/forms/add_page.ml1
-rwxr-xr-xeditor/forms/delete_page.ml6
-rwxr-xr-xeditor/forms/events.ml5
-rwxr-xr-xeditor/forms/ui.ml (renamed from editor/ui.ml)2
-rwxr-xr-xeditor/state/state.ml26
-rwxr-xr-xeditor/state/state.mli6
-rwxr-xr-xeditor/state/storage.ml3
16 files changed, 241 insertions, 182 deletions
diff --git a/editor/actions.ml b/editor/actions.ml
deleted file mode 100755
index 0f107f9..0000000
--- a/editor/actions.ml
+++ /dev/null
@@ -1,120 +0,0 @@
-open StdLabels
-open Js_of_ocaml
-open Brr
-open Brr_note
-
-type button_actions =
- { delete : unit Note.event
- ; redirect : Jstr.t option Note.event
- ; add: unit Note.event
- }
-
-let populate_menu () =
- match Blog.Sidebar.get () with
- | None -> None
- | Some element ->
- let () = Blog.Sidebar.clean element in
-
- let delete_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-trash") ] ]
-
- 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
-
- and add_event =
- Evr.on_el
- Ev.click
- Evr.unit
- add_button in
-
- let stored_pages = State.Storage.get_ids () in
- let pages =
- List.map
- stored_pages
- ~f:(fun id ->
-
- let name_opt = (State.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 =
- [ home_button
- ; 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-download") ]
- ]
- ; delete_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-cog") ]
- ]
- ; El.hr ()
- ; El.ul
- pages
- ] in
-
- let () = El.append_children element childs in
- Some
- { delete = delete_event
- ; redirect = redirect_event
- ; add = add_event
- }
diff --git a/editor/actions/actions.ml b/editor/actions/actions.ml
new file mode 100755
index 0000000..e8b4d71
--- /dev/null
+++ b/editor/actions/actions.ml
@@ -0,0 +1,128 @@
+open StdLabels
+open Js_of_ocaml
+open Brr
+open Brr_note
+
+module Event = Event
+
+type button_actions =
+ { delete : Event.t Note.event
+ ; redirect : Jstr.t option Note.event
+ ; add: Event.t Note.event
+ }
+
+let populate_menu
+ : Forms.Events.event option Note.E.send -> button_actions option
+ = fun sender ->
+ match Blog.Sidebar.get () with
+ | None -> None
+ | Some element ->
+ let () = Blog.Sidebar.clean element in
+
+ let delete_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-trash") ] ]
+
+ 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
+ (fun _ -> Event.E
+ ( sender
+ , (module Delete_page: Event.Handler with type t = Delete_page.t)) )
+ delete_button
+
+ and add_event =
+ Evr.on_el
+ Ev.click
+ (fun _ -> Event.E
+ ( sender
+ , (module Add_page: Event.Handler with type t = Add_page.t)) )
+ add_button in
+
+ let stored_pages = State.Storage.get_ids () in
+ let pages =
+ List.map
+ stored_pages
+ ~f:(fun id ->
+
+ let name_opt = (State.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 =
+ [ home_button
+ ; 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-download") ]
+ ]
+ ; delete_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-cog") ]
+ ]
+ ; El.hr ()
+ ; El.ul
+ pages
+ ] in
+
+ let () = El.append_children element childs in
+ Some
+ { delete = delete_event
+ ; redirect = redirect_event
+ ; add = add_event
+ }
diff --git a/editor/actions/add_page.ml b/editor/actions/add_page.ml
new file mode 100755
index 0000000..b817573
--- /dev/null
+++ b/editor/actions/add_page.ml
@@ -0,0 +1,11 @@
+type t = Forms.Events.event option Note.E.send
+
+let apply
+ : t -> State.t -> State.t
+ = fun close_sender state ->
+ let title = Jstr.v "Nouvelle page" in
+ let popup = Forms.Ui.popup
+ ~title
+ ~form:(Some (Forms.Add_page.create ()))
+ close_sender in
+ { state with window = popup::state.window}
diff --git a/editor/actions/delete_page.ml b/editor/actions/delete_page.ml
new file mode 100755
index 0000000..cc15693
--- /dev/null
+++ b/editor/actions/delete_page.ml
@@ -0,0 +1,16 @@
+type t = Forms.Events.event option Note.E.send
+
+let apply
+ : t -> State.t -> State.t
+ = fun close_sender state ->
+ begin match state.page_id with
+ | None -> state
+ | Some page_id ->
+ let title = Jstr.v "Confirmation" in
+ let popup = Forms.Ui.popup
+ ~title
+ ~form:(Some (Forms.Delete_page.create page_id))
+ close_sender in
+ { state with window = popup::state.window}
+ end
+
diff --git a/editor/actions/dune b/editor/actions/dune
new file mode 100755
index 0000000..5d269c4
--- /dev/null
+++ b/editor/actions/dune
@@ -0,0 +1,13 @@
+(library
+ (name actions)
+ (libraries
+ brr
+ brr.note
+ elements
+ blog
+ js_lib
+ forms
+ state
+ )
+ (preprocess (pps js_of_ocaml-ppx))
+ )
diff --git a/editor/actions/event.ml b/editor/actions/event.ml
new file mode 100755
index 0000000..5e30587
--- /dev/null
+++ b/editor/actions/event.ml
@@ -0,0 +1,8 @@
+module type Handler = sig
+ type t
+
+ val apply: t -> State.t -> State.t
+
+end
+
+type t = E : 'a * (module Handler with type t = 'a) -> t
diff --git a/editor/app.ml b/editor/app.ml
index 219ce80..4559044 100755
--- a/editor/app.ml
+++ b/editor/app.ml
@@ -2,11 +2,10 @@ open Brr
module Js = Js_of_ocaml.Js
type events =
- | DeleteEvent
| StoreEvent
| LoadEvent of Jstr.t option
- | AddEvent
| ClosePopup of Forms.Events.event option
+ | Generic of Actions.Event.t
let key_of_title
: Jstr.t -> Jstr.t
@@ -18,41 +17,27 @@ let key_of_title
The function take a new event, and apply it to the current state. *)
let update
- : Forms.Events.event option Note.E.send -> (events, State.t) Application.t
- = fun close_sender event state ->
+ : (events, State.t) Application.t
+ = fun event state ->
match event with
+ | Generic (E (t, (module EventHandler))) ->
+ EventHandler.apply t state
+
+
| ClosePopup result ->
+ (* First close the last popin. *)
let state = match state.window with
| [] -> { state with window = [] }
| el::tl -> El.remove el
; { state with window = tl } in
+ (* Call the handler associated with the event *)
begin match result with
| None -> state
| Some (Event (t, (module Handler))) ->
Handler.on_close t state
end
- | 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 ->
- 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
-
| StoreEvent ->
let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
@@ -80,12 +65,23 @@ let update
- more recent (if the content has been updated elsewhere)
but older shoud be a bug. *)
- date <= state.last_backup)) in
+ let is_ok = date <= state.last_backup in
+ if (not is_ok) then (
+ let open Console in
+ log
+ [ Jstr.v "Last backup date is "
+ ; new%js Js.date_fromTimeValue state.last_backup
+ ; Jstr.v " but date is "
+ ; new%js Js.date_fromTimeValue date] );
+ is_ok)) in
begin match save with
| Ok true -> { state with last_backup = new_date }
- | other ->
+ | Ok false ->
+ Console.(log [Jstr.v "Didn't save"]);
+ state
+ | Error other ->
(* TODO In case of error, notify the user *)
- Console.(log [other]);
+ Console.(log [Jstr.v "Couldn't save" ; other]);
state
end
diff --git a/editor/dune b/editor/dune
index 295c39f..8f2e3d1 100755
--- a/editor/dune
+++ b/editor/dune
@@ -11,6 +11,7 @@
state
plugins
forms
+ actions
)
(modes js)
(preprocess (pps js_of_ocaml-ppx))
diff --git a/editor/editor.ml b/editor/editor.ml
index 2849b29..bca8fb2 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -56,14 +56,6 @@ let build_view
view, last_backup
-(** [update] is the event loop.
-
- The function take a new event, and apply it to the current state. *)
-
-let update
- : 'a option Note.E.send -> (App.events, State.t) Application.t
- = App.update
-
let app id content =
(* This event is used in the pop process. The sender is given to the
@@ -71,7 +63,7 @@ let app id content =
let (event: Forms.Events.event option Note.event), sender = Note.E.create () in
(* Check the pre-requisite *)
- let events_opt = Actions.populate_menu () in
+ let events_opt = Actions.populate_menu sender in
match (Jv.is_none id), (Jv.is_none content), events_opt with
| false, false, Some btn_events ->
@@ -81,25 +73,16 @@ let app id content =
let page_id = State.Storage.page_id () in
let view, last_backup = build_view pm page_id editor in
- let init_state =
- State.{ editable = true
- ; view
- ; last_backup
- ; page_id
-
- ; window = []
- ; pm
- }
- in
+ let init_state = State.init pm view last_backup page_id in
let app_state = Application.run
~eq:State.eq
- (App.update sender)
+ (App.update )
init_state
(Note.E.select
[ Brr_note.Evr.on_el Ev.focusout (fun _ -> App.StoreEvent) editor
- ; Note.E.map (fun () -> App.DeleteEvent) btn_events.Actions.delete
- ; Note.E.map (fun () -> App.AddEvent) btn_events.Actions.add
+ ; Note.E.map (fun ev -> App.Generic ev) btn_events.Actions.delete
+ ; Note.E.map (fun ev -> App.Generic ev) btn_events.Actions.add
; Note.E.map (fun v -> App.LoadEvent v) btn_events.Actions.redirect
; Note.E.map (fun v -> App.ClosePopup v) event
]) in
diff --git a/editor/forms/add_page.ml b/editor/forms/add_page.ml
index 9786f47..edcbc37 100755
--- a/editor/forms/add_page.ml
+++ b/editor/forms/add_page.ml
@@ -62,4 +62,3 @@ let create
[ input ]
]
] )
-
diff --git a/editor/forms/delete_page.ml b/editor/forms/delete_page.ml
index 7c973c2..eb36560 100755
--- a/editor/forms/delete_page.ml
+++ b/editor/forms/delete_page.ml
@@ -26,12 +26,10 @@ let create
let message = begin
let open Jstr in
- (v "La page " )
+ (v "La page ")
+ name
+ (v " sera définitivement supprimée")
end in
( state
- , El.txt message
- )
-
+ , El.txt message )
diff --git a/editor/forms/events.ml b/editor/forms/events.ml
index a88aa76..28780d9 100755
--- a/editor/forms/events.ml
+++ b/editor/forms/events.ml
@@ -8,5 +8,8 @@ end
type event = Event : 'a * (module Handler with type t = 'a) -> event
-(** The signal has to be log in order to be completely working *)
+(* The type is both the form handler, the form value, and the HTML element
+ which contains the form.
+
+ The signal has to be log in order to be completely working. *)
type t = event Note.signal * Brr.El.t
diff --git a/editor/ui.ml b/editor/forms/ui.ml
index cc90481..d8a259a 100755
--- a/editor/ui.ml
+++ b/editor/forms/ui.ml
@@ -3,7 +3,7 @@ open Brr_note
module Js = Js_of_ocaml.Js
let popup
- : title:Jstr.t -> ?form:Forms.Events.t option -> Forms.Events.event option Note.E.send -> El.t
+ : title:Jstr.t -> ?form:Events.t option -> Events.event option Note.E.send -> El.t
= fun ~title ?(form = None) send ->
(* Ensure we keep a track for the signal event.
diff --git a/editor/state/state.ml b/editor/state/state.ml
index 48b4d58..569f26c 100755
--- a/editor/state/state.ml
+++ b/editor/state/state.ml
@@ -17,9 +17,7 @@ type t =
(** Compare two states together.
- The prosemirror elemens are ignored
-
-*)
+ The prosemirror elemens are ignored *)
let eq s1 s2 =
Stdlib.(==)
( s1.editable
@@ -66,5 +64,25 @@ let load_page
let editor_state = state_of_storage state.pm json state.view##.state##.schema in
let () = state.view##updateState editor_state
and () = set_title json in
- { state with page_id }
+
+ let last_backup =
+ Js.Opt.case json##.date
+ (fun () -> state.last_backup )
+ (fun v -> v) in
+
+ { state with page_id
+ ; last_backup }
+
+
+let init
+ : PM.t -> PM.View.editor_view Js.t -> float -> Jstr.t option -> t
+ = fun pm view last_backup page_id ->
+ { editable = true
+ ; view
+ ; last_backup
+ ; page_id
+
+ ; window = []
+ ; pm
+ }
diff --git a/editor/state/state.mli b/editor/state/state.mli
index e370015..6984067 100755
--- a/editor/state/state.mli
+++ b/editor/state/state.mli
@@ -1,5 +1,4 @@
module Js = Js_of_ocaml.Js
-
module Storage = Storage
type t =
@@ -14,6 +13,7 @@ type t =
val eq: t -> t -> bool
+(** Update the title element according to the page. *)
val set_title
: Storage.content Js.t -> unit
@@ -22,3 +22,7 @@ val state_of_storage
val load_page
: Jstr.t option -> t -> Storage.content Js.t -> t
+
+(** Initialise a new state *)
+val init
+ : Prosemirror.t -> Prosemirror.View.editor_view Js.t -> float -> Jstr.t option -> t
diff --git a/editor/state/storage.ml b/editor/state/storage.ml
index f893c2d..b0c00de 100755
--- a/editor/state/storage.ml
+++ b/editor/state/storage.ml
@@ -62,7 +62,8 @@ let save'
(* First load the content from the storage *)
match check (load' key) with
- | false -> Ok false
+ | false ->
+ Ok false
| true ->
let storage = Brr_io.Storage.local G.window in
let operation = Brr_io.Storage.set_item