diff options
Diffstat (limited to 'editor/actions')
| -rwxr-xr-x | editor/actions/add_page.ml | 53 | ||||
| -rwxr-xr-x | editor/actions/delete_page.ml | 37 | ||||
| -rwxr-xr-x | editor/actions/editor_actions.ml | 359 | ||||
| -rwxr-xr-x | editor/actions/editor_actions.mli | 9 | ||||
| -rwxr-xr-x | editor/actions/export.ml | 50 | ||||
| -rwxr-xr-x | editor/actions/import.ml | 56 | ||||
| -rwxr-xr-x | editor/actions/load_page.ml | 9 | ||||
| -rwxr-xr-x | editor/actions/of_markdown.ml | 297 | ||||
| -rwxr-xr-x | editor/actions/to_markdown.ml | 404 |
9 files changed, 601 insertions, 673 deletions
diff --git a/editor/actions/add_page.ml b/editor/actions/add_page.ml index dff2c2f..58e991b 100755 --- a/editor/actions/add_page.ml +++ b/editor/actions/add_page.ml @@ -2,42 +2,31 @@ module Js = Js_of_ocaml.Js module App = Editor_app module M = struct - type t = Forms.Add_page.t - let key_of_title - : Jstr.t -> Jstr.t - = fun title -> - title + let key_of_title : Jstr.t -> Jstr.t = fun title -> title - let process - : t -> State.t -> State.t - = fun {title} state -> - let page_id = key_of_title title in - State.new_page ~title (Some page_id) state + let process : t -> State.t -> State.t = + fun { title } state -> + let page_id = key_of_title title in + State.new_page ~title (Some page_id) state end - (** Create a new element *) -let create - : unit -> App.event Note.event - = fun () -> - let title = Jstr.v "Nouvelle page" in - let form = Forms.Add_page.create () in +let create : unit -> App.event Note.event = + fun () -> + let title = Jstr.v "Nouvelle page" in + let form = Forms.Add_page.create () in - let valid_on = Note.S.map - (fun Forms.Add_page.{title} -> not @@ Jstr.equal Jstr.empty title) - (fst form) - in - let ev = Elements.Popup.create - ~title - ~form - ~valid_on - () - in - Note.E.map - (fun v -> App.dispatch (module M) v) - (* Option.on_some trigger the event only when the pop up is validated. - Closing the popup doesn't do anything. - *) - (Note.E.Option.on_some ev) + let valid_on = + Note.S.map + (fun Forms.Add_page.{ title } -> not @@ Jstr.equal Jstr.empty title) + (fst form) + in + let ev = Elements.Popup.create ~title ~form ~valid_on () in + Note.E.map + (fun v -> App.dispatch (module M) v) + (* Option.on_some trigger the event only when the pop up is validated. + Closing the popup doesn't do anything. + *) + (Note.E.Option.on_some ev) diff --git a/editor/actions/delete_page.ml b/editor/actions/delete_page.ml index 2b75b2e..4730eee 100755 --- a/editor/actions/delete_page.ml +++ b/editor/actions/delete_page.ml @@ -1,31 +1,22 @@ module App = Editor_app -module M = struct +module M = struct type t = unit - let process - : t -> State.t -> State.t - = fun () state -> - match state.page_id with - | None -> state - | Some page_id -> + let process : t -> State.t -> State.t = + fun () state -> + match state.page_id with + | None -> state + | Some page_id -> State.Storage.delete (fun () -> Some page_id); State.load_page None state - end -let create - : unit -> App.event Note.event - = fun () -> - let title = Jstr.v "Confirmation" - and message = - Jstr.v "La page sera définitivement supprimée" - in - let ev = Elements.Popup.create - ~title - ~form:(Forms.Validation.create message) - () - in - Note.E.map - (fun v -> App.dispatch (module M) v) - (Note.E.Option.on_some ev) +let create : unit -> App.event Note.event = + fun () -> + let title = Jstr.v "Confirmation" + and message = Jstr.v "La page sera définitivement supprimée" in + let ev = + Elements.Popup.create ~title ~form:(Forms.Validation.create message) () + in + Note.E.map (fun v -> App.dispatch (module M) v) (Note.E.Option.on_some ev) diff --git a/editor/actions/editor_actions.ml b/editor/actions/editor_actions.ml index eadf1e7..68ce766 100755 --- a/editor/actions/editor_actions.ml +++ b/editor/actions/editor_actions.ml @@ -2,7 +2,6 @@ open StdLabels open Brr open Brr_note module App = Editor_app - module Js = Js_of_ocaml.Js (** This is the attribute attached to each link and containing the node id @@ -17,190 +16,188 @@ type t = ; delete_button : El.t } -let build - : Prosemirror.t -> t - = fun pm -> - - 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") ] ] - - and export_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") ] ] - - and load_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-upload") ] ] - - and cog_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") ] - ] - - in - - (* We are waiting for event inside another event ( form validation inside - popup creation. - - Note.E.join is used here in order to get only te popup validation. *) - let delete_event = - Note.E.join ( - Evr.on_el - Ev.click - (fun _ -> Delete_page.create ()) - delete_button) - - (* Event on popup creation *) - and add_event = - Note.E.join ( - Evr.on_el +let build : Prosemirror.t -> t = + fun pm -> + 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") + ] + ] + and export_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") + ] + ] + and load_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-upload") + ] + ] + and cog_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") + ] + ] + in + + (* We are waiting for event inside another event ( form validation inside + popup creation. + + Note.E.join is used here in order to get only te popup validation. *) + let delete_event = + Note.E.join + (Evr.on_el Ev.click (fun _ -> Delete_page.create ()) delete_button) + (* Event on popup creation *) + and add_event = + Note.E.join (Evr.on_el Ev.click (fun _ -> Add_page.create ()) add_button) + and export_event = + Evr.on_el Ev.click (fun _ -> Export.create ()) export_button + and import_event = + Note.E.join (Evr.on_el Ev.click (fun _ -> Import.create ()) load_button) + and cog_event = + Evr.on_el Ev.click (fun _ -> To_markdown.create pm) cog_button + in + + let ul = El.ul [] 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 + + We use the bubble property in order to listen only the [ul] element and + not the each entry in the list. This way, there is no recursive loop + between the redirect_handler and the dynamic generation of elements + inside the [ul] node. *) + let redirect_event = + Note.E.select + [ Evr.on_el Ev.click - (fun _ -> Add_page.create ()) - add_button) - - and export_event = - Evr.on_el - Ev.click - (fun _ -> Export.create ()) - export_button - - and import_event = - Note.E.join ( - Evr.on_el + (fun _ -> App.dispatch (module Load_page.M) None) + home_button + ; Evr.on_el Ev.click - (fun _ -> Import.create ()) - load_button) - and cog_event = - Evr.on_el - Ev.click - (fun _ -> To_markdown.create pm) - cog_button - in - - - let ul = El.ul [] 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 - - We use the bubble property in order to listen only the [ul] element and - not the each entry in the list. This way, there is no recursive loop - between the redirect_handler and the dynamic generation of elements - inside the [ul] node. *) - let redirect_event = - Note.E.select - [ Evr.on_el - Ev.click - (fun _ -> App.dispatch (module Load_page.M) None) - home_button - ; Evr.on_el - Ev.click - (fun ev -> - let el = Jv.Id.of_jv @@ Jv.Id.to_jv @@ Ev.target ev in - let name = El.at note_id_attribute el in - App.dispatch (module Load_page.M) name) - ul ] in - - let childs = - [ home_button - ; add_button - ; export_button - ; load_button - ; delete_button - ; cog_button - ; El.hr () - ; ul ] in - - let result_event = - Note.E.select - [ delete_event - ; redirect_event - ; add_event - ; export_event - ; import_event - ; cog_event ] in - - { ev = result_event - ; childs - ; ul + (fun ev -> + let el = Jv.Id.of_jv @@ Jv.Id.to_jv @@ Ev.target ev in + let name = El.at note_id_attribute el in + App.dispatch (module Load_page.M) name ) + ul + ] + in + + let childs = + [ home_button + ; add_button + ; export_button + ; load_button ; delete_button - ; completed = false } + ; cog_button + ; El.hr () + ; ul + ] + in + + let result_event = + Note.E.select + [ delete_event + ; redirect_event + ; add_event + ; export_event + ; import_event + ; cog_event + ] + in + + { ev = result_event; childs; ul; delete_button; completed = false } + -let get_event - : t -> App.event Note.event - = fun {ev; _} -> ev +let get_event : t -> App.event Note.event = fun { ev; _ } -> ev (** Collect all the notes in the cache and return them into links. *) let get_notes _ = - List.map - (State.Storage.get_ids ()) - ~f:(fun id -> - let name_opt = (State.Storage.load (Some id))##.title in - let name = Js.Opt.get name_opt (fun () -> id) in - El.li - [ El.a - ~at:[ At.href (Jstr.v "#") - ; At.v note_id_attribute id - ] - [ El.txt name ] ]) - -let complete - : t -> State.t Note.signal -> El.t list - = fun t change -> - - (* As we register some events, we have to prevent many execution of this - function *) - let () = - if t.completed then - raise (Failure "The action panel is already registered") in - t.completed <- true; - - Elr.def_children - t.ul - (Note.S.map get_notes change); - - Elr.def_at - (Jstr.v "disabled") - (Note.S.map - (fun state -> - match state.State.page_id with - | None -> Some Jstr.empty - | Some _ -> None) - change) - t.delete_button; - - t.childs + List.map (State.Storage.get_ids ()) ~f:(fun id -> + let name_opt = (State.Storage.load (Some id))##.title in + let name = Js.Opt.get name_opt (fun () -> id) in + El.li + [ El.a + ~at:[ At.href (Jstr.v "#"); At.v note_id_attribute id ] + [ El.txt name ] + ] ) + + +let complete : t -> State.t Note.signal -> El.t list = + fun t change -> + (* As we register some events, we have to prevent many execution of this + function *) + let () = + if t.completed then raise (Failure "The action panel is already registered") + in + t.completed <- true; + + Elr.def_children t.ul (Note.S.map get_notes change); + + Elr.def_at + (Jstr.v "disabled") + (Note.S.map + (fun state -> + match state.State.page_id with + | None -> Some Jstr.empty + | Some _ -> None ) + change ) + t.delete_button; + + t.childs diff --git a/editor/actions/editor_actions.mli b/editor/actions/editor_actions.mli index b1ac054..6f3421a 100755 --- a/editor/actions/editor_actions.mli +++ b/editor/actions/editor_actions.mli @@ -1,16 +1,13 @@ type t +val build : Prosemirror.t -> t (** Create the elements to be declared inside the panel *) -val build - : Prosemirror.t -> t +val get_event : t -> Editor_app.event Note.event (** Get the events triggered by the actions buttons *) -val get_event - : t -> Editor_app.event Note.event +val complete : t -> State.t Note.signal -> Brr.El.t list (** Finalize the creation, register the handler to state update, and return the dom elements. Raise an error if already completed. *) -val complete - : t -> State.t Note.signal -> Brr.El.t list diff --git a/editor/actions/export.ml b/editor/actions/export.ml index 27c6a26..3c70bd3 100755 --- a/editor/actions/export.ml +++ b/editor/actions/export.ml @@ -2,35 +2,31 @@ module Js = Js_of_ocaml.Js module App = Editor_app module M = struct - type t = unit - let process - : t -> State.t -> State.t - = fun _ state -> - - (* Save this as a json element. The text may contains UTF-16 characters, - which will raise an error in the btoa function. - - As an easy solution, we convert them into UTF-8 through the native - OCaml representation of string. - *) - let json = State.Storage.to_json () - |> Jstr.to_string (* Encode into UTF-8 *) - |> Obj.magic (* Then type the element again as a string. *) - in - Elements.Transfert.send - ~mime_type:(Jstr.v "application/json") - ~filename:(Jstr.v "export.json") - json; - - (* The function does not actually update the state, and return it - unchanged *) - state - + let process : t -> State.t -> State.t = + fun _ state -> + (* Save this as a json element. The text may contains UTF-16 characters, + which will raise an error in the btoa function. + + As an easy solution, we convert them into UTF-8 through the native + OCaml representation of string. + *) + let json = + State.Storage.to_json () + |> Jstr.to_string (* Encode into UTF-8 *) + |> Obj.magic + (* Then type the element again as a string. *) + in + Elements.Transfert.send + ~mime_type:(Jstr.v "application/json") + ~filename:(Jstr.v "export.json") + json; + + (* The function does not actually update the state, and return it + unchanged *) + state end (** Create a new element *) -let create - : unit -> App.event - = fun () -> App.dispatch (module M) () +let create : unit -> App.event = fun () -> App.dispatch (module M) () diff --git a/editor/actions/import.ml b/editor/actions/import.ml index b87960b..9539bd3 100755 --- a/editor/actions/import.ml +++ b/editor/actions/import.ml @@ -1,58 +1,52 @@ module Js = Js_of_ocaml.Js module App = Editor_app -let uncheck_import = - fun ~previous ~update -> +let uncheck_import ~previous ~update = let _ = previous and _ = update in true -let check_import = - fun ~previous ~update -> - Js.Opt.case previous##.date + +let check_import ~previous ~update = + Js.Opt.case + previous##.date (fun () -> true) (fun previous_date -> - Js.Opt.case update##.date - (fun () -> true) - (fun update_date -> - update_date >= previous_date )) + Js.Opt.case + update##.date + (fun () -> true) + (fun update_date -> update_date >= previous_date) ) -module M = struct +module M = struct type t = Forms.Selector.t - let process - : t -> State.t -> State.t - = fun t state -> - match t.Forms.Selector.file with - | None -> state - | Some file -> + let process : t -> State.t -> State.t = + fun t state -> + match t.Forms.Selector.file with + | None -> state + | Some file -> let content = file.Elements.Input.content in let check = - if t.Forms.Selector.preserve_newest then - check_import - else - uncheck_import + if t.Forms.Selector.preserve_newest + then check_import + else uncheck_import in - match - State.Storage.of_json - ~check - content with + ( match State.Storage.of_json ~check content with | Error _ -> state - | Ok _obj -> - State.load_page state.State.page_id state + | Ok _obj -> State.load_page state.State.page_id state ) end let create () = let title = Jstr.v "Importer des notes" in let form = Forms.Selector.create () in - let ev = Elements.Popup.create + let ev = + Elements.Popup.create ~title ~form - ~valid_on:(Note.S.map (fun form -> form.Forms.Selector.file != None) (fst form)) + ~valid_on: + (Note.S.map (fun form -> form.Forms.Selector.file != None) (fst form)) () in - Note.E.map - (fun v -> App.dispatch (module M) v) - (Note.E.Option.on_some ev) + Note.E.map (fun v -> App.dispatch (module M) v) (Note.E.Option.on_some ev) diff --git a/editor/actions/load_page.ml b/editor/actions/load_page.ml index e85f8b5..0d02f71 100755 --- a/editor/actions/load_page.ml +++ b/editor/actions/load_page.ml @@ -1,10 +1,7 @@ +(** Load the page with the given ID in the editor *) module M = struct - type t = Jstr.t option - let process - : t -> State.t -> State.t - = fun page_id state -> - State.load_page page_id state - + let process : t -> State.t -> State.t = + fun page_id state -> State.load_page page_id state end diff --git a/editor/actions/of_markdown.ml b/editor/actions/of_markdown.ml index 951feed..ec18ce1 100755 --- a/editor/actions/of_markdown.ml +++ b/editor/actions/of_markdown.ml @@ -5,68 +5,67 @@ module PM = Prosemirror type node_t = PM.Model.node Js.t module FromMarkdown = struct - type t = PM.t * Omd.doc (** Add the given mark in the mark list. The attributes, if any, are added to the mark properties. *) - let add_attribute - : string -> PM.Model.schema Js.t -> PM.Model.mark Js.t list -> Jv.prop PM.O.t Js.opt -> PM.Model.mark Js.t list - = fun name schema marks attributes -> - match PM.O.get schema##.marks name with - | None -> marks - | Some mark_type -> + let add_attribute : + string + -> PM.Model.schema Js.t + -> PM.Model.mark Js.t list + -> Jv.prop PM.O.t Js.opt + -> PM.Model.mark Js.t list = + fun name schema marks attributes -> + match PM.O.get schema##.marks name with + | None -> marks + | Some mark_type -> let m = schema##mark_fromType mark_type attributes in - m::marks + m :: marks + (** The function [parse_inline] will tranform all the inline markup to a Prosemirror node. This apply to element like bold, links and so one. *) - let rec parse_inline_content - : Prosemirror.View.editor_view Js.t + let rec parse_inline_content : + Prosemirror.View.editor_view Js.t -> PM.t -> PM.Model.mark Js.t list -> Omd.attributes Omd.inline - -> node_t Js.js_array Js.t - = fun view pm marks -> function - | Omd.Concat (attrs, els) -> + -> node_t Js.js_array Js.t = + fun view pm marks -> function + | Omd.Concat (attrs, els) -> ignore attrs; let nodes = List.to_seq els |> Seq.map (fun e -> parse_inline_content view pm marks e) |> Array.of_seq - |> Js.array in + |> Js.array + in (* Flatten each array returned *) nodes##reduce_init - (Js.wrap_callback - @@ fun (init: node_t Js.js_array Js.t) (elems: node_t Js.js_array Js.t) _ _ -> - init##concat elems) + ( Js.wrap_callback + @@ fun (init : node_t Js.js_array Js.t) + (elems : node_t Js.js_array Js.t) + _ + _ -> + init##concat elems ) (new%js Js.array_empty) - - | Omd.Strong (attrs, content) -> + | Omd.Strong (attrs, content) -> (* Strong (or Emph) elements just add the coresponding mark and process the content further *) ignore attrs; - let marks = add_attribute - "strong" - view##.state##.schema - marks - Js.null in + let marks = + add_attribute "strong" view##.state##.schema marks Js.null + in parse_inline_content view pm marks content - - | Omd.Emph (attrs, content) -> + | Omd.Emph (attrs, content) -> ignore attrs; - let marks = add_attribute - "em" - view##.state##.schema - marks - Js.null in + let marks = add_attribute "em" view##.state##.schema marks Js.null in parse_inline_content view pm marks content - - | Omd.Text (attrs, text) -> + | Omd.Text (attrs, text) -> ignore attrs; (* Convert the marks as js array *) let js_marks = Js.array @@ Array.of_list marks in @@ -75,81 +74,80 @@ module FromMarkdown = struct (Jstr.of_string text) (Js.some js_marks) |] - - | Omd.Code (attrs, content) -> + | Omd.Code (attrs, content) -> ignore attrs; - let marks = add_attribute - "code" - view##.state##.schema - marks - Js.null in + let marks = add_attribute "code" view##.state##.schema marks Js.null in let js_marks = Js.array @@ Array.of_list marks in Js.array [| view##.state##.schema##text (Jstr.of_string content) (Js.some js_marks) |] - - | Omd.Link (attrs, link_attrs) -> + | Omd.Link (attrs, link_attrs) -> ignore attrs; - let attrs' = PM.O.init - [| "href", link_attrs.destination - (* TODO Handle title *) - |] in - let marks = add_attribute - "link" - view##.state##.schema - marks - (Js.some attrs') in + let attrs' = + PM.O.init + [| ("href", link_attrs.destination) (* TODO Handle title *) |] + in + let marks = + add_attribute "link" view##.state##.schema marks (Js.some attrs') + in parse_inline_content view pm marks link_attrs.label - - | Hard_break (_) - | Soft_break (_) - (* TODO Handle Break *) - | Image (_, _) - | Html (_, _) -> - Brr.Console.(log [Jstr.v "Other"]); + | Hard_break _ | Soft_break _ (* TODO Handle Break *) + |Image (_, _) + |Html (_, _) -> + Brr.Console.(log [ Jstr.v "Other" ]); new%js Js.array_empty - let rec parse_block - : Prosemirror.View.editor_view Js.t -> PM.t -> Omd.attributes Omd.block -> node_t option - = fun view pm -> function - | Omd.Paragraph (attrs, elements) -> + let rec parse_block : + Prosemirror.View.editor_view Js.t + -> PM.t + -> Omd.attributes Omd.block + -> node_t option = + fun view pm -> function + | Omd.Paragraph (attrs, elements) -> ignore attrs; let marks = [] in (* Transform each node inside the markdown document and add them into the paragraph node *) let nodes = parse_inline_content view pm marks elements in let fragment = PM.Model.Fragment.from_array pm nodes in - let node = view##.state##.schema##node + let node = + view##.state##.schema##node (Jstr.v "paragraph") - (Js.null) + Js.null (Js.some fragment) - (Js.null) in + Js.null + in Some node - - | Omd.Heading (attrs, level, elements) -> + | Omd.Heading (attrs, level, elements) -> ignore attrs; let marks = [] in (* Heading is like a paragraph, but with an attribute (the level) *) - let attributes = object%js val level = level end + let attributes = + object%js + val level = level + end and nodes = parse_inline_content view pm marks elements in let fragment = PM.Model.Fragment.from_array pm nodes in - let node = view##.state##.schema##node + let node = + view##.state##.schema##node (Jstr.v "heading") (Js.some attributes) (Js.some fragment) - (Js.null) in + Js.null + in Some node - - | Omd.List (attrs, type_, spacing, elements) -> + | Omd.List (attrs, type_, spacing, elements) -> ignore attrs; ignore spacing; - let type_list = match type_ with + let type_list = + match type_ with | Omd.Ordered _ -> "ordered_list" - | Omd.Bullet _ -> "bullet_list" in + | Omd.Bullet _ -> "bullet_list" + in (* The whole list node is declared as ordered or bullet depending of the type given by the markdown. @@ -157,56 +155,58 @@ module FromMarkdown = struct Each element inside the list is transformed as a list_item. The list_item node can itself contains other blocks (recursively) *) - let nodes = List.map elements - ~f:(fun list_entry -> - let nodes = (List.filter_map list_entry - ~f:(fun e -> parse_block view pm e)) - |> Array.of_list - |> Js.array in - let fragment = PM.Model.Fragment.from_array pm nodes in - view##.state##.schema##node - (Jstr.v "list_item") - (Js.null) - (Js.some fragment) - (Js.null) - ) in - let nodes_array= nodes - |> Array.of_list - |> Js.array in + let nodes = + List.map elements ~f:(fun list_entry -> + let nodes = + List.filter_map list_entry ~f:(fun e -> parse_block view pm e) + |> Array.of_list + |> Js.array + in + let fragment = PM.Model.Fragment.from_array pm nodes in + view##.state##.schema##node + (Jstr.v "list_item") + Js.null + (Js.some fragment) + Js.null ) + in + let nodes_array = nodes |> Array.of_list |> Js.array in let fragment = PM.Model.Fragment.from_array pm nodes_array in - let node = view##.state##.schema##node + let node = + view##.state##.schema##node (Jstr.v type_list) - (Js.null) + Js.null (Js.some fragment) - (Js.null) in + Js.null + in Some node - - | Omd.Thematic_break attrs -> + | Omd.Thematic_break attrs -> ignore attrs; - let node = view##.state##.schema##node + let node = + view##.state##.schema##node (Jstr.v "horizontal_rule") - (Js.null) - (Js.null) - (Js.null) in + Js.null + Js.null + Js.null + in Some node - - | Omd.Blockquote(attrs, elements) -> + | Omd.Blockquote (attrs, elements) -> ignore attrs; let nodes = - List.filter_map elements - ~f:(fun e -> parse_block view pm e) + List.filter_map elements ~f:(fun e -> parse_block view pm e) |> Array.of_list - |> Js.array in + |> Js.array + in let fragment = PM.Model.Fragment.from_array pm nodes in - let node = view##.state##.schema##node + let node = + view##.state##.schema##node (Jstr.v "blockquote") - (Js.null) + Js.null (Js.some fragment) - (Js.null) in + Js.null + in Some node - - | Code_block(attrs, content, format) -> + | Code_block (attrs, content, format) -> ignore attrs; (* The language format is ignored (I do not provide syntaxic @@ -214,48 +214,53 @@ module FromMarkdown = struct ignore format; (* TODO Check if this work *) - let nodes = Js.array - [| view##.state##.schema##text - (Jstr.of_string content) - (Js.null) - |] in + let nodes = + Js.array + [| view##.state##.schema##text (Jstr.of_string content) Js.null |] + in let fragment = PM.Model.Fragment.from_array pm nodes in - let node = view##.state##.schema##node + let node = + view##.state##.schema##node (Jstr.v "code_block") - (Js.null) + Js.null (Js.some fragment) - (Js.null) in + Js.null + in Some node - | Html_block(_, _) - | Definition_list(_, _) - -> - Brr.Console.(log [Jstr.v "Other block"]); + | Html_block (_, _) | Definition_list (_, _) -> + Brr.Console.(log [ Jstr.v "Other block" ]); None - let parse - : Prosemirror.View.editor_view Js.t -> PM.t -> Omd.doc -> Prosemirror.Model.node Js.t - = fun view pm doc -> - Brr.Console.( log [ doc ]); - (* Transform each node inside the markdown document and add them into the - root node *) - let nodes = - doc - |> List.filter_map ~f:(fun b -> parse_block view pm b) - |> Array.of_list - |> Js.array - in - let fragment = PM.Model.Fragment.from_array pm nodes in - let document = view##.state##.schema##node - (Jstr.v "doc") - (Js.null) - (Js.some fragment) - (Js.null) in - Brr.Console.(log [ document ]); - document - let update - : t -> State.t -> State.t - = fun (pm, doc) state -> - let _ = parse state.State.view pm doc in - state + let parse : + Prosemirror.View.editor_view Js.t + -> PM.t + -> Omd.doc + -> Prosemirror.Model.node Js.t = + fun view pm doc -> + Brr.Console.(log [ doc ]); + (* Transform each node inside the markdown document and add them into the + root node *) + let nodes = + doc + |> List.filter_map ~f:(fun b -> parse_block view pm b) + |> Array.of_list + |> Js.array + in + let fragment = PM.Model.Fragment.from_array pm nodes in + let document = + view##.state##.schema##node + (Jstr.v "doc") + Js.null + (Js.some fragment) + Js.null + in + Brr.Console.(log [ document ]); + document + + + let update : t -> State.t -> State.t = + fun (pm, doc) state -> + let _ = parse state.State.view pm doc in + state end diff --git a/editor/actions/to_markdown.ml b/editor/actions/to_markdown.ml index 1920219..3f0934a 100755 --- a/editor/actions/to_markdown.ml +++ b/editor/actions/to_markdown.ml @@ -2,14 +2,13 @@ module Js = Js_of_ocaml.Js module PM = Prosemirror module App = Editor_app - type buffer = Jstr.t Js.js_array Js.t -type f = (buffer -> PM.Model.node Js.t -> unit) -let render_mark_type = object%js +type f = buffer -> PM.Model.node Js.t -> unit - method code - = fun (mark:PM.Model.mark Js.t) (buffer: buffer) -> +let render_mark_type = + object%js + method code (mark : PM.Model.mark Js.t) (buffer : buffer) = ignore mark; (* There may be a bug here, if the code itself contains `` . @@ -18,82 +17,68 @@ let render_mark_type = object%js https://spec.commonmark.org/0.29/#code-span *) ignore @@ buffer##push (Jstr.v "``"); - fun (buffer:buffer) -> - ignore @@ buffer##push (Jstr.v "``") + fun (buffer : buffer) -> ignore @@ buffer##push (Jstr.v "``") - method strong - = fun (mark:PM.Model.mark Js.t) (buffer: buffer) -> + method strong (mark : PM.Model.mark Js.t) (buffer : buffer) = ignore mark; ignore @@ buffer##push (Jstr.v "**"); - fun (buffer:buffer) -> - ignore @@ buffer##push (Jstr.v "**") + fun (buffer : buffer) -> ignore @@ buffer##push (Jstr.v "**") - method em - = fun (mark:PM.Model.mark Js.t) (buffer: buffer) -> + method em (mark : PM.Model.mark Js.t) (buffer : buffer) = ignore mark; ignore @@ buffer##push (Jstr.v "*"); - fun (buffer:buffer) -> - ignore @@ buffer##push (Jstr.v "*") + fun (buffer : buffer) -> ignore @@ buffer##push (Jstr.v "*") - (** + (** https://spec.commonmark.org/0.29/#links *) - method link - = fun (mark:PM.Model.mark Js.t) (buffer: buffer) -> + method link (mark : PM.Model.mark Js.t) (buffer : buffer) = ignore @@ buffer##push (Jstr.v "["); - fun (buffer:buffer) -> + fun (buffer : buffer) -> ignore @@ buffer##push (Jstr.v "]("); - let href_opt = PM.O.get (mark##.attrs) "href" in - Option.iter - (fun href -> ignore @@ buffer##push (href)) - href_opt; - ignore @@ buffer##push (Jstr.v ")"); + let href_opt = PM.O.get mark##.attrs "href" in + Option.iter (fun href -> ignore @@ buffer##push href) href_opt; + ignore @@ buffer##push (Jstr.v ")") + end -end type render_state = { level : int - ; apply_indent : bool } + ; apply_indent : bool + } (* Check if a property exists in the object with the name of node type, and if so, call the appropriate method. *) -let process_node obj (state:render_state) buffer node = +let process_node obj (state : render_state) buffer node = let name = node##._type##.name in match Jv.find' (Jv.Id.to_jv obj) name with - | None -> - Brr.Console.(log - [ Jstr.v "Unknow type" - ; name - ; node ]) + | None -> Brr.Console.(log [ Jstr.v "Unknow type"; name; node ]) | Some _ -> - - Jv.call' - (Jv.Id.to_jv obj) - name - [| Jv.Id.to_jv state - ; Jv.Id.to_jv buffer - ; Jv.Id.to_jv node - |] - -let render_node_type = object%js (_this) - - (* https://spec.commonmark.org/0.29/#thematic-breaks *) - method horizontal_rule_ - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> + Jv.call' + (Jv.Id.to_jv obj) + name + [| Jv.Id.to_jv state; Jv.Id.to_jv buffer; Jv.Id.to_jv node |] + + +(** Create a js object with a function for each node type. Each function may + call [process_node] recursively for each nested nodes *) +let render_node_type = + object%js (_this) + (* https://spec.commonmark.org/0.29/#thematic-breaks *) + method horizontal_rule_ + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = ignore state; ignore node; - if state.level <> 0 then ( + if state.level <> 0 + then ( ignore @@ buffer##push (Jstr.v "\n"); - ignore @@ buffer##push (Jstr.(repeat state.level (v " ") )); - ignore @@ buffer##push (Jstr.v "---\n"); - ) else ( - ignore @@ buffer##push (Jstr.v "\n---\n") - ) - - method text - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> + ignore @@ buffer##push Jstr.(repeat state.level (v " ")); + ignore @@ buffer##push (Jstr.v "---\n") ) + else ignore @@ buffer##push (Jstr.v "\n---\n") + method text + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = ignore state; (* Execute each mark as an environment like \begin{environement} @@ -101,194 +86,171 @@ let render_node_type = object%js (_this) \end{environment} this way, nested marks are working correctly - *) - let post_render = node##.marks##reduce_init - (Js.wrap_callback @@ fun (acc:(buffer -> unit) Js.js_array Js.t) (mark: PM.Model.mark Js.t) (_:int) _ -> - let name = mark##._type##.name in - match Jv.find' (Jv.Id.to_jv render_mark_type) name with - | None -> - Brr.Console.( - log [ Jstr.v "Unknown mark type" - ; name]); - acc - | Some _ -> - (* Add the element as first (lifo) *) - ignore @@ acc##unshift - (Jv.call' - (Jv.Id.to_jv render_mark_type) - name - [| Jv.Id.to_jv mark - ; Jv.Id.to_jv buffer - |]); - acc) + let post_render = + node##.marks##reduce_init + ( Js.wrap_callback + @@ fun (acc : (buffer -> unit) Js.js_array Js.t) + (mark : PM.Model.mark Js.t) + (_ : int) + _ -> + let name = mark##._type##.name in + match Jv.find' (Jv.Id.to_jv render_mark_type) name with + | None -> + Brr.Console.(log [ Jstr.v "Unknown mark type"; name ]); + acc + | Some _ -> + (* Add the element as first (lifo) *) + ignore + @@ acc##unshift + (Jv.call' + (Jv.Id.to_jv render_mark_type) + name + [| Jv.Id.to_jv mark; Jv.Id.to_jv buffer |] ); + acc ) (new%js Js.array_empty) in let () = - if node##.isText == Js._true then - Js.Opt.iter - node##.text - (fun content -> ignore @@ buffer##push content) in + if node##.isText == Js._true + then + Js.Opt.iter node##.text (fun content -> + ignore @@ buffer##push content ) + in post_render##forEach - (Js.wrap_callback @@ fun (call:(buffer -> unit)) (_:int) _ -> call buffer) - - method heading - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> + ( Js.wrap_callback + @@ fun (call : buffer -> unit) (_ : int) _ -> call buffer ) - let h_level:int = node##.attrs##.level in - ignore @@ buffer##push (Jstr.(repeat h_level (v "#") )); + method heading + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = + let h_level : int = node##.attrs##.level in + ignore @@ buffer##push Jstr.(repeat h_level (v "#")); ignore @@ buffer##push (Jstr.v " "); node##.content##forEach - ( Js.wrap_meth_callback @@ fun _ node ~offset ~index -> - let _ = offset - and _ = index in - process_node _this state buffer node); - ignore @@ buffer##push (Jstr.(v "\n\n" )) - - method paragraph - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> + ( Js.wrap_meth_callback + @@ fun _ node ~offset ~index -> + let _ = offset + and _ = index in + process_node _this state buffer node ); + ignore @@ buffer##push Jstr.(v "\n\n") + + method paragraph + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = node##.content##forEach - ( Js.wrap_meth_callback @@ fun _ node ~offset ~index -> - ignore offset; - ignore index; - if state.apply_indent then ( - ignore @@ buffer##push (Jstr.(repeat state.level (v " ") )) - ); - process_node _this state buffer node); - ignore @@ buffer##push (Jstr.(v "\n" )) - - method list_item_ - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> - + ( Js.wrap_meth_callback + @@ fun _ node ~offset ~index -> + ignore offset; + ignore index; + if state.apply_indent + then ignore @@ buffer##push Jstr.(repeat state.level (v " ")); + process_node _this state buffer node ); + ignore @@ buffer##push Jstr.(v "\n") + + method list_item_ + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = node##.content##forEach - ( Js.wrap_meth_callback @@ fun _ node ~offset ~index -> - ignore offset; - (* The first element in the list should be correctly indented, but if - there is many elements inside the list (paragraph) we have to - apply the indentation again. - *) - let new_state = { state with apply_indent = index <> 0 } in - process_node _this new_state buffer node); - - method bullet_list_ - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> + ( Js.wrap_meth_callback + @@ fun _ node ~offset ~index -> + ignore offset; + (* The first element in the list should be correctly indented, but if + there is many elements inside the list (paragraph) we have to + apply the indentation again. + *) + let new_state = { state with apply_indent = index <> 0 } in + process_node _this new_state buffer node ) + + method bullet_list_ + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = node##.content##forEach - ( Js.wrap_meth_callback @@ fun _ node ~offset ~index -> - ignore offset; - if state.level <> 0 && (index <> 0 || state.apply_indent) then ( - ignore @@ buffer##push (Jstr.(repeat state.level (v " ") )) - ); - ignore @@ buffer##push (Jstr.v "- "); - let new_state = - { level = state.level + 2 - ; apply_indent = false - } in - process_node _this new_state buffer node); - if (state.level == 0) then - ignore @@ buffer##push (Jstr.(v "\n" )) - - method ordered_list_ - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> + ( Js.wrap_meth_callback + @@ fun _ node ~offset ~index -> + ignore offset; + if state.level <> 0 && (index <> 0 || state.apply_indent) + then ignore @@ buffer##push Jstr.(repeat state.level (v " ")); + ignore @@ buffer##push (Jstr.v "- "); + let new_state = { level = state.level + 2; apply_indent = false } in + process_node _this new_state buffer node ); + if state.level == 0 then ignore @@ buffer##push Jstr.(v "\n") + + method ordered_list_ + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = node##.content##forEach - ( Js.wrap_meth_callback @@ fun _ node ~offset ~index -> - ignore offset; - if state.level <> 0 && (index <> 0 || state.apply_indent) then ( - ignore @@ buffer##push (Jstr.(repeat state.level (v " ") )) - ); - let num = Jstr.of_int (1 + index) in - let prefix = Jstr.( num + (v ". ")) in - ignore @@ buffer##push prefix; - let new_state = - { level = state.level + (Jstr.length prefix) - ; apply_indent = false - } in - process_node _this new_state buffer node); - if (state.level == 0) then - ignore @@ buffer##push (Jstr.(v "\n" )) - - (* https://spec.commonmark.org/0.29/#fenced-code-blocks *) - method code_block_ - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> + ( Js.wrap_meth_callback + @@ fun _ node ~offset ~index -> + ignore offset; + if state.level <> 0 && (index <> 0 || state.apply_indent) + then ignore @@ buffer##push Jstr.(repeat state.level (v " ")); + let num = Jstr.of_int (1 + index) in + let prefix = Jstr.(num + v ". ") in + ignore @@ buffer##push prefix; + let new_state = + { level = state.level + Jstr.length prefix; apply_indent = false } + in + process_node _this new_state buffer node ); + if state.level == 0 then ignore @@ buffer##push Jstr.(v "\n") + + (* https://spec.commonmark.org/0.29/#fenced-code-blocks *) + method code_block_ + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = ignore @@ buffer##push (Jstr.v "```\n"); node##.content##forEach - ( Js.wrap_meth_callback @@ fun _ node ~offset ~index -> - ignore index; - ignore offset; - let new_state = - { state with - apply_indent = true - } in - process_node _this new_state buffer node); - if state.apply_indent then ( - ignore @@ buffer##push (Jstr.(repeat state.level (v " ") )) - ); + ( Js.wrap_meth_callback + @@ fun _ node ~offset ~index -> + ignore index; + ignore offset; + let new_state = { state with apply_indent = true } in + process_node _this new_state buffer node ); + if state.apply_indent + then ignore @@ buffer##push Jstr.(repeat state.level (v " ")); ignore @@ buffer##push (Jstr.v "\n```\n") - (** https://spec.commonmark.org/0.29/#block-quotes *) - method blockquote - = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) -> + (** https://spec.commonmark.org/0.29/#block-quotes *) + method blockquote + (state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) = node##.content##forEach - ( Js.wrap_meth_callback @@ fun _ node ~offset ~index -> - ignore index; - ignore offset; - ignore @@ buffer##push (Jstr.v "> "); - let new_state = - { level = state.level + 2 - ; apply_indent = false - } in - process_node _this new_state buffer node); - ignore @@ buffer##push (Jstr.v "\n"); -end - + ( Js.wrap_meth_callback + @@ fun _ node ~offset ~index -> + ignore index; + ignore offset; + ignore @@ buffer##push (Jstr.v "> "); + let new_state = { level = state.level + 2; apply_indent = false } in + process_node _this new_state buffer node ); + ignore @@ buffer##push (Jstr.v "\n") + end module ToMarkdown = struct - type t = PM.t - let process - : t -> State.t -> State.t - = fun pm state -> - - let view = state.State.view in - let root_node = view##.state##.doc in - let buffer = new%js Js.array_empty in - - Brr.Console.(log [Obj.magic root_node]); - - let () = root_node##forEach - (Js.wrap_meth_callback @@ fun _ node ~offset ~index -> - let _ = offset - and _ = index in - - let init = - { level = 0 - ; apply_indent = false } in - - - process_node render_node_type init buffer node - ) in - - (* Concatenate the array into a single string *) - let js_markdown = buffer##join (Js.string "") in - let markdown = Js.to_string js_markdown in - Brr.Console.(log [js_markdown]); - let doc = Omd.of_string markdown in - let new_doc = Of_markdown.FromMarkdown.parse view pm doc in - - Brr.Console.(log - [ Jstr.v "Are the same ?" - ; (Obj.magic @@ Js_of_ocaml.Js.bool (root_node = new_doc)) - ]); - - (* The function does not actually update the state, and return it - unchanged *) - state - + let process : t -> State.t -> State.t = + fun pm state -> + let view = state.State.view in + let root_node = view##.state##.doc in + let buffer = new%js Js.array_empty in + Brr.Console.(log [ Obj.magic root_node ]); + let () = + root_node##forEach + ( Js.wrap_meth_callback + @@ fun _ node ~offset ~index -> + let _ = offset + and _ = index in + let init = { level = 0; apply_indent = false } in + process_node render_node_type init buffer node ) + in + (* Concatenate the array into a single string *) + let js_markdown = buffer##join (Js.string "") in + let markdown = Js.to_string js_markdown in + Brr.Console.(log [ js_markdown ]); + let doc = Omd.of_string markdown in + let new_doc = Of_markdown.FromMarkdown.parse view pm doc in + Brr.Console.( + log + [ Jstr.v "Are the same ?" + ; Obj.magic @@ Js_of_ocaml.Js.bool (root_node = new_doc) + ]); + (* The function does not actually update the state, and return it + unchanged *) + state end (** Create a new element *) -let create - : PM.t -> App.event - = fun pm -> - App.dispatch (module ToMarkdown) pm +let create : PM.t -> App.event = fun pm -> App.dispatch (module ToMarkdown) pm |