diff options
Diffstat (limited to 'editor/actions/of_markdown.ml')
| -rwxr-xr-x | editor/actions/of_markdown.ml | 297 |
1 files changed, 151 insertions, 146 deletions
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 |