diff options
Diffstat (limited to 'editor/actions/of_markdown.ml')
| -rwxr-xr-x | editor/actions/of_markdown.ml | 236 |
1 files changed, 236 insertions, 0 deletions
diff --git a/editor/actions/of_markdown.ml b/editor/actions/of_markdown.ml new file mode 100755 index 0000000..580c6c4 --- /dev/null +++ b/editor/actions/of_markdown.ml @@ -0,0 +1,236 @@ +open StdLabels +module Js = Js_of_ocaml.Js +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 m = schema##mark_fromType mark_type attributes in + 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 + -> 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) -> + 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 + + (* 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) + (new%js Js.array_empty) + + | 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 + parse_inline_content view pm marks content + + | Omd.Emph (attrs, content) -> + ignore attrs; + let marks = add_attribute + "em" + view##.state##.schema + marks + Js.null in + parse_inline_content view pm marks content + + | Omd.Text (attrs, text) -> + ignore attrs; + (* Convert the marks as js array *) + let js_marks = Js.array @@ Array.of_list marks in + Js.array + [| view##.state##.schema##text + (Jstr.of_string text) + (Js.some js_marks) + |] + + | Omd.Code (attrs, content) -> + ignore attrs; + 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) -> + 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 + parse_inline_content view pm marks link_attrs.label + + | _ -> + (* TODO Handle Break *) + 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) -> + 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 + (Jstr.v "paragraph") + (Js.null) + (Js.some fragment) + (Js.null) in + Some node + + | 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 + 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 + (Jstr.v "heading") + (Js.some attributes) + (Js.some fragment) + (Js.null) in + Some node + + | Omd.List (attrs, type_, spacing, elements) -> + ignore attrs; + ignore spacing; + + let type_list = match type_ with + | Omd.Ordered _ -> "ordered_list" + | Omd.Bullet _ -> "bullet_list" in + + (* The whole list node is declared as ordered or bullet depending of + the type given by the markdown. + + Each element insiide 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 fragment = PM.Model.Fragment.from_array pm nodes_array in + let node = view##.state##.schema##node + (Jstr.v type_list) + (Js.null) + (Js.some fragment) + (Js.null) in + Some node + + | Omd.Thematic_break attrs -> + ignore attrs; + let node = view##.state##.schema##node + (Jstr.v "horizontal_rule") + (Js.null) + (Js.null) + (Js.null) in + Some node + + | Omd.Blockquote(attrs, elements) -> + ignore attrs; + let nodes = + List.filter_map elements + ~f:(fun e -> parse_block view pm e) + |> Array.of_list + |> Js.array in + let fragment = PM.Model.Fragment.from_array pm nodes in + let node = view##.state##.schema##node + (Jstr.v "blockquote") + (Js.null) + (Js.some fragment) + (Js.null) in + Some node + + | _ -> + Brr.Console.(log [Jstr.v "Other block"]); + None + + let parse + : Prosemirror.View.editor_view Js.t -> PM.t -> Omd.doc -> unit + = 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 ]) + + let update + : t -> State.t -> State.t + = fun (pm, doc) state -> + let () = parse state.State.view pm doc in + state +end + |