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 (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 (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 (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 (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 |]


(** Create a js object with a function for each node type. Each function may
    call [process_node] recursively for each nested nodes *)
let render_node_type =
  object%js (_this)
    (* https://spec.commonmark.org/0.29/#thematic-breaks *)
    method horizontal_rule_
        (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
        (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
        (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
        (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_
        (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_
        (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_
        (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_
        (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
        (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 process : 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.dispatch (module ToMarkdown) pm