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

      | 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) ->
        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 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 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

      | Code_block(attrs, content, format) ->
        ignore attrs;

        (* The language format is ignored (I do not provide syntaxic
           coloration) *)
        ignore format;

        (* TODO Check if this work *)
        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
            (Jstr.v "code_block")
            (Js.null)
            (Js.some fragment)
            (Js.null) in
        Some node
      | 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
end