diff options
Diffstat (limited to 'editor')
| -rwxr-xr-x | editor/actions.ml | 23 | ||||
| -rwxr-xr-x | editor/app.ml | 118 | ||||
| -rwxr-xr-x | editor/dune | 2 | ||||
| -rwxr-xr-x | editor/editor.ml | 197 | ||||
| -rwxr-xr-x | editor/forms/add_page.ml | 22 | ||||
| -rwxr-xr-x | editor/forms/add_page.mli | 6 | ||||
| -rwxr-xr-x | editor/forms/delete_page.ml | 10 | ||||
| -rwxr-xr-x | editor/forms/dune | 1 | ||||
| -rwxr-xr-x | editor/forms/events.ml | 17 | ||||
| -rwxr-xr-x | editor/plugins/dune | 9 | ||||
| -rwxr-xr-x | editor/plugins/footnotes.ml (renamed from editor/footnotes.ml) | 0 | ||||
| -rwxr-xr-x | editor/plugins/link_editor.ml (renamed from editor/link_editor.ml) | 0 | ||||
| -rwxr-xr-x | editor/plugins/plugins.ml (renamed from editor/plugins.ml) | 2 | ||||
| -rwxr-xr-x | editor/plugins/popin.ml (renamed from editor/popin.ml) | 0 | ||||
| -rwxr-xr-x | editor/plugins/tooltip.ml (renamed from editor/tooltip.ml) | 0 | ||||
| -rwxr-xr-x | editor/state/dune | 9 | ||||
| -rwxr-xr-x | editor/state/state.ml | 70 | ||||
| -rwxr-xr-x | editor/state/state.mli | 24 | ||||
| -rwxr-xr-x | editor/state/storage.ml (renamed from editor/storage.ml) | 0 | ||||
| -rwxr-xr-x | editor/state/storage.mli (renamed from editor/storage.mli) | 0 | 
20 files changed, 321 insertions, 189 deletions
| diff --git a/editor/actions.ml b/editor/actions.ml index f7633e1..0f107f9 100755 --- a/editor/actions.ml +++ b/editor/actions.ml @@ -17,30 +17,24 @@ let populate_menu () =      let delete_button = El.button          ~at:At.[ class' (Jstr.v "action-button") ] -        [ El.i -            [] +        [ El.i []              ~at:At.[ class' (Jstr.v "fa")                     ; class' (Jstr.v "fa-2x") -                   ; class' (Jstr.v "fa-trash") -                   ] ] +                   ; class' (Jstr.v "fa-trash") ] ]      and home_button = El.button          ~at:At.[ class' (Jstr.v "action-button") ] -        [ El.i -            [] +        [ El.i []              ~at:At.[ class' (Jstr.v "fa")                     ; class' (Jstr.v "fa-2x") -                   ; class' (Jstr.v "fa-home") -                   ] ] +                   ; class' (Jstr.v "fa-home") ] ]      and add_button = El.button          ~at:At.[ class' (Jstr.v "action-button") ] -        [ El.i -            [] +        [ El.i []              ~at:At.[ class' (Jstr.v "fa")                     ; class' (Jstr.v "fa-2x") -                   ; class' (Jstr.v "fa-plus") -                   ] ] +                   ; class' (Jstr.v "fa-plus") ] ]      in @@ -49,19 +43,20 @@ let populate_menu () =          Ev.click          Evr.unit          delete_button +      and add_event =        Evr.on_el          Ev.click          Evr.unit          add_button in -    let stored_pages = Storage.get_ids () in +    let stored_pages = State.Storage.get_ids () in      let pages =        List.map          stored_pages          ~f:(fun id -> -            let name_opt = (Storage.load (Some id))##.title in +            let name_opt = (State.Storage.load (Some id))##.title in              let name = Js.Opt.get                  name_opt                  (fun () -> id) in diff --git a/editor/app.ml b/editor/app.ml new file mode 100755 index 0000000..aee396a --- /dev/null +++ b/editor/app.ml @@ -0,0 +1,118 @@ +open Brr +module PM = Prosemirror +module Js = Js_of_ocaml.Js + +type events = +  | DeleteEvent +  | StoreEvent +  | LoadEvent of Jstr.t option +  | AddEvent +  | CloseEvent of Forms.Events.kind option +  | GEvent of Forms.Events.event + +let key_of_title +  : Jstr.t -> Jstr.t +  = fun title -> +    title + +(** [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 -> (events, State.t) Application.t +  = fun close_sender event state -> +    match event with + +    | GEvent (Event (t, (module Handler))) -> +      Handler.on_close t state + +    | 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 + +    | 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 +      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.Opt.option content +        val date = Js.some new_date +      end in +      let save = State.Storage.save +          content_obj +          state.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 <= state.last_backup)) in +      begin match save with +        | Ok true -> { state with last_backup = new_date } +        | other -> +          (* TODO In case of error, notify the user *) +          Console.(log [other]); +          state +      end + +    | LoadEvent page_id -> +      let json = State.Storage.load page_id in +      State.load_page page_id state json + + diff --git a/editor/dune b/editor/dune index c8dfe3c..295c39f 100755 --- a/editor/dune +++ b/editor/dune @@ -8,6 +8,8 @@     prosemirror     blog     application +   state +   plugins     forms     )   (modes js) diff --git a/editor/editor.ml b/editor/editor.ml index d3a9624..1a34dfc 100755 --- a/editor/editor.ml +++ b/editor/editor.ml @@ -2,56 +2,6 @@ open Brr  module PM = Prosemirror  module Js = Js_of_ocaml.Js -(** This is the state for the application *) -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 -  = 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) -  (** Create a new editor view      [build_view element state] will create the editor and attach it to [element]. @@ -68,7 +18,7 @@ let build_view         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 +      Plugins.Footnotes.footnote_schema          pm          (PM.SchemaBasic.schema pm) in @@ -83,7 +33,7 @@ let build_view          (Some custom_schema##.spec##.marks)          None in      let full_schema = PM.Model.schema pm specs in -    let stored_content = Storage.load page_id in +    let stored_content = State.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. *) @@ -92,11 +42,11 @@ let build_view          (fun () -> (new%js Js.date_now)##getTime) in      let props = PM.View.direct_editor_props () in -    props##.state := state_of_storage pm stored_content full_schema; +    props##.state := State.state_of_storage pm stored_content full_schema;      (* Add the custom nodes *)      props##.nodeViews := PM.O.init -        [| ( "footnote", (Footnotes.footnote_view pm)) +        [| ( "footnote", (Plugins.Footnotes.footnote_view pm))          |];      let view = PM.View.editor_view @@ -105,114 +55,21 @@ 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 -  : 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 -> -      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.Opt.option content -        val date = Js.some new_date -      end in -      let save = Storage.save -          content_obj -          state.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 <= state.last_backup)) in -      begin match save with -        | Ok true -> { state with last_backup = new_date } -        | _ -> -          (* 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 - +  : '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 +     subroutine in order to track the window closing *) +  let event, sender = Note.E.create () in +    (* Check the pre-requisite *)    let events_opt = Actions.populate_menu () in    match (Jv.is_none id), (Jv.is_none content), events_opt with @@ -221,34 +78,32 @@ let app id content =      let pm = PM.v () in      let editor:El.t = Jv.Id.of_jv id in      (* Load the cache for the given page *) -    let page_id = Storage.page_id () in +    let page_id = State.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 = [] -      } +      State.{ editable = true +            ; view +            ; last_backup +            ; page_id + +            ; window = [] +            ; pm +            }      in      let app_state = Application.run -        (update pm sender) +        ~eq:State.eq +        (App.update sender)          init_state          (Note.E.select -           [ 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 +           [ 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 v  -> App.LoadEvent v)  btn_events.Actions.redirect +           ; Note.E.map (fun v  -> App.CloseEvent v) event             ]) in      let () = diff --git a/editor/forms/add_page.ml b/editor/forms/add_page.ml index 597e9d3..ac45824 100755 --- a/editor/forms/add_page.ml +++ b/editor/forms/add_page.ml @@ -1,9 +1,12 @@  open Brr  open Brr_note  open Note +module Js = Js_of_ocaml.Js + +type t = { title : Jstr.t }  type Events.kind += -  | AddPage of { title : Jstr.t } +  | AddPage of t [@@unboxed]  let create    : unit -> Events.t @@ -34,3 +37,20 @@ let create                  [ input ]              ]          ] ) + +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 97b1d6c..6be1611 100755 --- a/editor/forms/add_page.mli +++ b/editor/forms/add_page.mli @@ -1,5 +1,9 @@ +type t = { title : Jstr.t }  type Events.kind += -  | AddPage of { title : Jstr.t } +  | 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 701162c..3328dd7 100755 --- a/editor/forms/delete_page.ml +++ b/editor/forms/delete_page.ml @@ -1,8 +1,10 @@  open Brr  open Note +type t = Jstr.t +  type Events.kind += -  | DeletePage of Jstr.t [@@unboxed] +  | DeletePage of t [@@unboxed]  let create    : Jstr.t -> Events.t @@ -23,3 +25,9 @@ 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/dune b/editor/forms/dune index 9876654..124ce01 100755 --- a/editor/forms/dune +++ b/editor/forms/dune @@ -7,6 +7,7 @@     js_lib     blog     application +   state     )   (preprocess (pps js_of_ocaml-ppx))   ) diff --git a/editor/forms/events.ml b/editor/forms/events.ml index 339e15d..f7f5711 100755 --- a/editor/forms/events.ml +++ b/editor/forms/events.ml @@ -1,5 +1,20 @@ -(** This type is designed to be extended for each form *) +(** 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 + +  val on_close: t -> State.t -> State.t + +end + +type event = Event : 'a * (module Handler with type t = 'a) -> event + diff --git a/editor/plugins/dune b/editor/plugins/dune new file mode 100755 index 0000000..046dc5a --- /dev/null +++ b/editor/plugins/dune @@ -0,0 +1,9 @@ +(library + (name plugins) + (libraries  +   brr +   prosemirror +   js_lib +   ) + (preprocess (pps js_of_ocaml-ppx)) + ) diff --git a/editor/footnotes.ml b/editor/plugins/footnotes.ml index 794171f..794171f 100755 --- a/editor/footnotes.ml +++ b/editor/plugins/footnotes.ml diff --git a/editor/link_editor.ml b/editor/plugins/link_editor.ml index 9bfdfd4..9bfdfd4 100755 --- a/editor/link_editor.ml +++ b/editor/plugins/link_editor.ml diff --git a/editor/plugins.ml b/editor/plugins/plugins.ml index 91dedeb..3a92df8 100755 --- a/editor/plugins.ml +++ b/editor/plugins/plugins.ml @@ -1,6 +1,8 @@  module Js = Js_of_ocaml.Js  module PM = Prosemirror +module Footnotes = Footnotes +  (** Commands *)  let change_level diff --git a/editor/popin.ml b/editor/plugins/popin.ml index 63dcad1..63dcad1 100755 --- a/editor/popin.ml +++ b/editor/plugins/popin.ml diff --git a/editor/tooltip.ml b/editor/plugins/tooltip.ml index 05d56d4..05d56d4 100755 --- a/editor/tooltip.ml +++ b/editor/plugins/tooltip.ml diff --git a/editor/state/dune b/editor/state/dune new file mode 100755 index 0000000..dd405a1 --- /dev/null +++ b/editor/state/dune @@ -0,0 +1,9 @@ +(library + (name state) + (libraries  +   brr +   prosemirror +   plugins +   ) + (preprocess (pps js_of_ocaml-ppx)) + ) diff --git a/editor/state/state.ml b/editor/state/state.ml new file mode 100755 index 0000000..48b4d58 --- /dev/null +++ b/editor/state/state.ml @@ -0,0 +1,70 @@ +open Brr +module PM = Prosemirror +module Js = Js_of_ocaml.Js + +module Storage = Storage + +(** This is the state for the application *) +type t = +  { editable : bool +  ; view : PM.View.editor_view Js.t +  ; last_backup: float +  ; page_id: Jstr.t option + +  ; window : Brr.El.t list +  ; pm : PM.t +  } + +(** Compare two states together. + +    The prosemirror elemens are ignored + +*) +let eq s1 s2 = +  Stdlib.(==) +    ( s1.editable +    , s1.last_backup +    , s1.page_id +    , s1.window ) + +    ( s2.editable +    , s2.last_backup +    , s2.page_id +    , s2.window ) + +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 state_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 load_page +  : Jstr.t option -> t -> Storage.content Js.t -> t +  = fun page_id state json -> +    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 } + diff --git a/editor/state/state.mli b/editor/state/state.mli new file mode 100755 index 0000000..e370015 --- /dev/null +++ b/editor/state/state.mli @@ -0,0 +1,24 @@ +module Js = Js_of_ocaml.Js + +module Storage = Storage + +type t = +  { editable : bool +  ; view : Prosemirror.View.editor_view Js.t +  ; last_backup: float +  ; page_id: Jstr.t option + +  ; window : Brr.El.t list +  ; pm : Prosemirror.t +  } + +val eq: t -> t -> bool + +val set_title +  : Storage.content Js.t -> unit + +val state_of_storage +  : Prosemirror.t -> Storage.content Js.t -> Prosemirror.Model.schema Js.t -> Prosemirror.State.editor_state Js.t + +val load_page +  : Jstr.t option -> t -> Storage.content Js.t -> t diff --git a/editor/storage.ml b/editor/state/storage.ml index f893c2d..f893c2d 100755 --- a/editor/storage.ml +++ b/editor/state/storage.ml diff --git a/editor/storage.mli b/editor/state/storage.mli index 5b7e0a0..5b7e0a0 100755 --- a/editor/storage.mli +++ b/editor/state/storage.mli | 
