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