From 8d23a029c57be92a7aed0f18d9fcf1c931c1038e Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 7 Feb 2022 16:40:45 +0100 Subject: Reformat --- editor/actions/to_markdown.ml | 404 +++++++++++++++++++----------------------- 1 file changed, 183 insertions(+), 221 deletions(-) (limited to 'editor/actions/to_markdown.ml') 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 -- cgit v1.2.3