summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xeditor/app.ml46
-rwxr-xr-xeditor/editor.ml6
-rwxr-xr-xeditor/forms/add_page.ml53
-rwxr-xr-xeditor/forms/add_page.mli7
-rwxr-xr-xeditor/forms/delete_page.ml24
-rwxr-xr-xeditor/forms/events.ml12
-rwxr-xr-xeditor/ui.ml2
7 files changed, 62 insertions, 88 deletions
diff --git a/editor/app.ml b/editor/app.ml
index aee396a..219ce80 100755
--- a/editor/app.ml
+++ b/editor/app.ml
@@ -1,5 +1,4 @@
open Brr
-module PM = Prosemirror
module Js = Js_of_ocaml.Js
type events =
@@ -7,8 +6,7 @@ type events =
| StoreEvent
| LoadEvent of Jstr.t option
| AddEvent
- | CloseEvent of Forms.Events.kind option
- | GEvent of Forms.Events.event
+ | ClosePopup of Forms.Events.event option
let key_of_title
: Jstr.t -> Jstr.t
@@ -20,12 +18,20 @@ let key_of_title
The function take a new event, and apply it to the current state. *)
let update
- : 'a option Note.E.send -> (events, State.t) Application.t
+ : Forms.Events.event option Note.E.send -> (events, State.t) Application.t
= fun close_sender event state ->
match event with
- | GEvent (Event (t, (module Handler))) ->
- Handler.on_close t state
+ | ClosePopup result ->
+ let state = match state.window with
+ | [] -> { state with window = [] }
+ | el::tl -> El.remove el
+ ; { state with window = tl } in
+ 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
@@ -47,34 +53,6 @@ let update
{ 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) ->
- State.Storage.delete (fun () -> Some id);
- let json = State.Storage.load None in
- State.load_page None state json
- (* Add a new page *)
- | Some (Forms.Add_page.AddPage {title}) ->
- let page_id = key_of_title title in
- 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
- State.load_page (Some page_id) state content_obj
-
- | _ -> state
- end
-
| StoreEvent ->
let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
diff --git a/editor/editor.ml b/editor/editor.ml
index 1a34dfc..2849b29 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -68,7 +68,7 @@ let app id content =
(* 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 (event: Forms.Events.event option Note.event), sender = Note.E.create () in
(* Check the pre-requisite *)
let events_opt = Actions.populate_menu () in
@@ -81,8 +81,6 @@ 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
@@ -103,7 +101,7 @@ let app id content =
; Note.E.map (fun () -> App.DeleteEvent) btn_events.Actions.delete
; Note.E.map (fun () -> App.AddEvent) btn_events.Actions.add
; Note.E.map (fun v -> App.LoadEvent v) btn_events.Actions.redirect
- ; Note.E.map (fun v -> App.CloseEvent v) event
+ ; Note.E.map (fun v -> App.ClosePopup v) event
]) in
let () =
diff --git a/editor/forms/add_page.ml b/editor/forms/add_page.ml
index ac45824..9786f47 100755
--- a/editor/forms/add_page.ml
+++ b/editor/forms/add_page.ml
@@ -3,10 +3,29 @@ open Brr_note
open Note
module Js = Js_of_ocaml.Js
-type t = { title : Jstr.t }
-type Events.kind +=
- | AddPage of t [@@unboxed]
+module Handler = struct
+
+ type t = { title : Jstr.t }
+
+ let key_of_title
+ : Jstr.t -> Jstr.t
+ = fun title ->
+ title
+
+ let on_close
+ : t -> State.t -> State.t
+ = fun {title} state ->
+ let page_id = key_of_title title in
+ 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
+ State.load_page (Some page_id) state content_obj
+
+end
let create
: unit -> Events.t
@@ -17,13 +36,19 @@ let create
~at:At.[type' (Jstr.v "text")]
in
+ let init =
+ Events.Event
+ ( Handler.{ title = Jstr.empty }
+ , (module Handler : Events.Handler with type t = Handler.t)) in
+
let state =
- S.hold (AddPage { title = Jstr.empty })
+ S.hold init
@@ Evr.on_el
(Ev.input)
(fun _ ->
- AddPage { title = El.prop El.Prop.value input }
- )
+ Events.Event
+ ( Handler.{ title = El.prop El.Prop.value input }
+ , (module Handler : Events.Handler with type t = Handler.t)) )
input in
( state
@@ -38,19 +63,3 @@ let create
]
] )
-let key_of_title
- : Jstr.t -> Jstr.t
- = fun title ->
- title
-
-let on_close
- : t -> State.t -> State.t
- = fun {title} state ->
- let page_id = key_of_title title in
- 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
- State.load_page (Some page_id) state content_obj
diff --git a/editor/forms/add_page.mli b/editor/forms/add_page.mli
index 6be1611..8a4ff6f 100755
--- a/editor/forms/add_page.mli
+++ b/editor/forms/add_page.mli
@@ -1,9 +1,2 @@
-type t = { title : Jstr.t }
-type Events.kind +=
- | AddPage of t [@@unboxed]
-
val create
: unit -> Events.t
-
-val on_close
- : t -> State.t -> State.t
diff --git a/editor/forms/delete_page.ml b/editor/forms/delete_page.ml
index 3328dd7..7c973c2 100755
--- a/editor/forms/delete_page.ml
+++ b/editor/forms/delete_page.ml
@@ -1,17 +1,27 @@
open Brr
open Note
-type t = Jstr.t
+module Handler = struct
-type Events.kind +=
- | DeletePage of t [@@unboxed]
+ type t = Jstr.t
+
+ let on_close
+ : t -> State.t -> State.t
+ = fun id state ->
+ State.Storage.delete (fun () -> Some id);
+ let json = State.Storage.load None in
+ State.load_page None state json
+end
let create
: Jstr.t -> Events.t
= fun name ->
let state =
- S.const (DeletePage name) in
+ S.const
+ (Events.Event
+ ( name
+ , (module Handler: Events.Handler with type t = Handler.t))) in
let message = begin
let open Jstr in
@@ -25,9 +35,3 @@ let create
, El.txt message
)
-let on_close
- : t -> State.t -> State.t
- = fun id state ->
- State.Storage.delete (fun () -> Some id);
- let json = State.Storage.load None in
- State.load_page None state json
diff --git a/editor/forms/events.ml b/editor/forms/events.ml
index f7f5711..a88aa76 100755
--- a/editor/forms/events.ml
+++ b/editor/forms/events.ml
@@ -1,13 +1,3 @@
-(** This type is designed to be extended for each form.
-
- Each of them hold the values inside the form.
-
-*)
-type kind = ..
-
-(** The signal has to be log in order to be completely working *)
-type t = kind Note.signal * Brr.El.t
-
module type Handler = sig
type t
@@ -18,3 +8,5 @@ end
type event = Event : 'a * (module Handler with type t = 'a) -> event
+(** 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/ui.ml
index 2cd8ff8..cc90481 100755
--- a/editor/ui.ml
+++ b/editor/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 -> 'a option Note.E.send -> El.t
+ : title:Jstr.t -> ?form:Forms.Events.t option -> Forms.Events.event option Note.E.send -> El.t
= fun ~title ?(form = None) send ->
(* Ensure we keep a track for the signal event.