summaryrefslogtreecommitdiff
path: root/editor/actions
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-06-04 22:56:27 +0200
committerSébastien Dailly <sebastien@dailly.me>2022-02-07 16:43:33 +0100
commitda1d9ad1c49f31fc9031fd1bc6661dad3600e40c (patch)
treed7684f047f6101b57c631c3c80448fc7ae2aa5ca /editor/actions
parentf7dc93dab194472329d74c056c4730b41e98d650 (diff)
Added markdown output
Diffstat (limited to 'editor/actions')
-rwxr-xr-xeditor/actions/dune1
-rwxr-xr-xeditor/actions/editor_actions.ml31
-rwxr-xr-xeditor/actions/editor_actions.mli2
-rwxr-xr-xeditor/actions/of_markdown.ml236
-rwxr-xr-xeditor/actions/to_markdown.ml294
5 files changed, 552 insertions, 12 deletions
diff --git a/editor/actions/dune b/editor/actions/dune
index 4044b52..10279dd 100755
--- a/editor/actions/dune
+++ b/editor/actions/dune
@@ -3,6 +3,7 @@
(libraries
brr
brr.note
+ omd
elements
blog
forms
diff --git a/editor/actions/editor_actions.ml b/editor/actions/editor_actions.ml
index 91d2a24..518e0c7 100755
--- a/editor/actions/editor_actions.ml
+++ b/editor/actions/editor_actions.ml
@@ -17,8 +17,8 @@ type t =
}
let build
- : unit -> t
- = fun () ->
+ : Prosemirror.t -> t
+ = fun pm ->
let delete_button = El.button
~at:At.[ class' (Jstr.v "action-button") ]
@@ -56,6 +56,16 @@ let build
~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
@@ -89,6 +99,11 @@ let build
Ev.click
(fun _ -> Import.create ())
load_button)
+ and cog_event =
+ Evr.on_el
+ Ev.click
+ (fun _ -> To_markdown.create pm)
+ cog_button
in
@@ -128,14 +143,7 @@ let build
; export_button
; load_button
; 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-cog") ]
- ]
+ ; cog_button
; El.hr ()
; ul ] in
@@ -145,7 +153,8 @@ let build
; redirect_event
; add_event
; export_event
- ; import_event ] in
+ ; import_event
+ ; cog_event ] in
{ ev = result_event
; childs
diff --git a/editor/actions/editor_actions.mli b/editor/actions/editor_actions.mli
index 0e9997b..a0a3c3b 100755
--- a/editor/actions/editor_actions.mli
+++ b/editor/actions/editor_actions.mli
@@ -2,7 +2,7 @@ type t
(** Create the elements to be declared inside the panel *)
val build
- : unit -> t
+ : Prosemirror.t -> t
(** Get the events triggered by the actions buttons *)
val get_event
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
+
diff --git a/editor/actions/to_markdown.ml b/editor/actions/to_markdown.ml
new file mode 100755
index 0000000..c1ac774
--- /dev/null
+++ b/editor/actions/to_markdown.ml
@@ -0,0 +1,294 @@
+module Js = Js_of_ocaml.Js
+module PM = Prosemirror
+
+type buffer = Jstr.t Js.js_array Js.t
+type f = (buffer -> PM.Model.node Js.t -> unit)
+
+let render_mark_type = object%js
+
+ method code
+ = fun (mark:PM.Model.mark Js.t) (buffer: buffer) ->
+ ignore mark;
+ (* There may be a bug here, if the code itself contains `` .
+
+ The encoder should search inside the node if the patern is present,
+ and adjust the number of backticks accordingly
+
+ https://spec.commonmark.org/0.29/#code-span *)
+ ignore @@ buffer##push (Jstr.v "``");
+ fun (buffer:buffer) ->
+ ignore @@ buffer##push (Jstr.v "``")
+
+ method strong
+ = fun (mark:PM.Model.mark Js.t) (buffer: buffer) ->
+ ignore mark;
+ ignore @@ buffer##push (Jstr.v "**");
+ fun (buffer:buffer) ->
+ ignore @@ buffer##push (Jstr.v "**")
+
+ method em
+ = fun (mark:PM.Model.mark Js.t) (buffer: buffer) ->
+ ignore mark;
+ 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) ->
+ ignore @@ buffer##push (Jstr.v "[");
+ 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 ")");
+
+end
+
+type render_state =
+ { level : int
+ ; 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 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 ])
+ | 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) ->
+ ignore state;
+ ignore node;
+ 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 state;
+ (* Execute each mark as an environment like
+ \begin{environement}
+ …
+ \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)
+ (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
+ 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) ->
+
+ 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) ->
+ 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) ->
+
+ 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) ->
+ 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) ->
+ 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) ->
+ 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 " ") ))
+ );
+ 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) ->
+ 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
+
+
+
+module ToMarkdown = struct
+
+ type t = PM.t
+
+ let update
+ : 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 -> State.event
+ = fun pm ->
+ State.E
+ ( pm
+ , (module ToMarkdown : State.Event with type t = ToMarkdown.t ))