path: root/editor/actions/to_markdown.ml

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

  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 -> App.event
  = fun pm ->
    App.E
      ( pm
      , (module ToMarkdown : App.Event with type t = ToMarkdown.t ))