aboutsummaryrefslogtreecommitdiff
path: root/editor/actions/to_markdown.ml
diff options
context:
space:
mode:
Diffstat (limited to 'editor/actions/to_markdown.ml')
-rwxr-xr-xeditor/actions/to_markdown.ml294
1 files changed, 294 insertions, 0 deletions
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 ))
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-01 12:30:52 +0000