open Brr
open Js_of_ocaml
module PM = Prosemirror

let footNoteSpec = object%js

  val mutable group = Jstr.v "inline"
  val mutable content = Jstr.v "inline*" (* The star is very important ! *)
  val mutable inline = Js._true
  val mutable draggable = Js._true
  (*  This makes the view treat the node as a leaf, even though it
      technically has content *)
  val mutable atom = Js._true

  val toDOM
    : (PM.Model.node Js.t -> PM.Model.domOutputSpec Js.t) Js.callback
    = Js.wrap_callback (fun _ ->
        let open PM.Model.Dom_output_spec in
        v "footnote"
          [ hole ])

  val parseDOM
    : PM.Model.parse_rule Js.t Js.js_array Js.t Js.opt
    = Js.some @@ Js.array
      [|PM.Model.ParseRule.tag (Jstr.v "footnote")|]

end

let footnote_schema pm defaultSchema =

  let nodes = defaultSchema##.spec##.nodes
  and marks = defaultSchema##.spec##.marks in

  let specs = PM.Model.schema_spec
      (nodes##addToEnd (Jstr.v "footnote") (Js.Unsafe.coerce footNoteSpec))
      (Some marks)
      None in

  PM.Model.schema pm
    specs

let build_menu pm schema =
  let menu = PM.Example.buildMenuItems pm schema in

  let itemSpec = PM.Menu.menuItemSpec () in
  itemSpec##.title := Js.some @@ Jstr.v "Insert footnote";
  itemSpec##.label := Js.some @@ Jstr.v "Footnote";
  itemSpec##.select := Js.wrap_meth_callback (fun _ (state:PM.State.editor_state Js.t) ->
      match PM.O.get schema##.nodes "footnote" with
      | None ->  Js._false
      | Some footnote_node ->
        let res = Js.Opt.test @@ PM.Transform.insertPoint
            pm
            state##.doc
            ~pos:state##.selection##.from
            footnote_node
        in
        Js.bool res);

  itemSpec##.run :=
    Js.wrap_meth_callback (fun _this state dispatch _ _ ->
        match PM.O.get schema##.nodes "footnote" with
        | None -> ()
        | Some footnote_node ->

          let from' = PM.State.selection_from state##.selection
          and to' = PM.State.selection_to state##.selection in

          let content =
            if state##.selection##.empty != Js._true
            && from'##sameParent to' = Js._true
            && from'##.parent##.inlineContent = Js._true then (
              from'##.parent##.content##cut
                (from'##.parentOffset)
                (Js.some @@ to'##.parentOffset)
            ) else (
              PM.Model.empty_fragment pm
            ) in
          let new_node = footnote_node##create_withFragmentContent
              Js.null
              (Js.some content)
              Js.null
          in
          dispatch @@
          state##.tr##replaceSelectionWith
            new_node
            Js.null
      );

  let item = PM.Menu.menu_item pm itemSpec in
  let _ = menu##.insertMenu##.content##push item in
  menu

let fromOutside
  : bool PM.State.meta_data Js.t
  = PM.State.create_str_meta_data (Jstr.v "fromOutside")

let footnote_view
  : PM.t -> PM.Model.node Js.t -> PM.View.editor_view Js.t -> (unit -> int) -> < .. > Js.t
  = fun pm init_node outerView get_pos ->

    (* These are used when the footnote is selected *)
    let innerView
      : PM.View.editor_view Js.t Js.opt ref
      = ref Js.null in

    let dispatchInner
      : PM.View.editor_view Js.t -> PM.State.transaction Js.t -> unit
      = fun view tr ->
        let res = view##.state##applyTransaction tr in
        view##updateState res##.state;

        let meta = Js.Optdef.get (tr##getMeta fromOutside) (fun () -> false) in
        if (not meta) then (
          let outerTr = outerView##.state##.tr
          and offsetMap = PM.Transform.offset pm ((get_pos()) + 1) in
          res##.transactions##forEach
            (Js.wrap_callback @@
             fun (elem:PM.State.transaction Js.t) _ _ ->
             elem##.steps##forEach
               (Js.wrap_callback @@ fun (step:PM.Transform.step Js.t) _ _ ->
                let _ = outerTr##step (step##map offsetMap) in
                ()
               ));
          if (outerTr##.docChanged = Js._true) then (
            outerView##dispatch outerTr)
        );
    in
    object%js (_self)

      val mutable node: PM.Model.node Js.t = init_node

      (* The node's representation in the editor (empty, for now) *)
      val dom = El.v (Jstr.v "footnote") []

      method _open =
        (* Append a tooltip to the outer node *)
        let tooltip = El.div []
            ~at:At.([class' (Jstr.v "popin")]) in
        El.append_children _self##.dom
          [ tooltip ];

        let dispatch_fn
          : PM.State.transaction Js.t -> unit
          = fun tr -> outerView##dispatch tr in

        let state_properties = Js.Unsafe.coerce (object%js
            val doc = Js.some _self##.node;
            val plugins = Js.some @@ Js.array @@ [|
                PM.Keymap.keymap pm
                  [| ( "Mod-z"
                     , (fun _ _ -> PM.History.undo pm outerView##.state (Js.some dispatch_fn)))
                   ; ( "Mod-y"
                     , (fun _ _ -> PM.History.redo pm outerView##.state (Js.some dispatch_fn)))
                  |]
              |];
          end) in

        let view_properties = PM.View.direct_editor_props () in
        view_properties##.state := PM.State.create pm state_properties;
        (* This is the magic part *)
        view_properties##.dispatchTransaction :=
          (Js.wrap_meth_callback dispatchInner);
        view_properties##.handleDOMEvents := PM.O.init
            [| ( "mousedown"
               , Js.wrap_callback (fun _ _ ->
                     (* Kludge to prevent issues due to the fact that the
                        whole footnote is node-selected (and thus DOM-selected)
                        when the parent editor is focused. *)
                     if (outerView##hasFocus () = Js._true) then (
                       Js.Opt.iter !innerView (fun view -> view##focus ())
                     );
                     Js._false ))|];

        innerView := Js.some
            (PM.View.editor_view pm
               tooltip
               view_properties);

      method close =
        Js.Opt.iter (!innerView)
          (fun view ->
             view##destroy;
             innerView := Js.null;
             El.set_prop
               (El.Prop.jstr (Jstr.v "textContent"))
               (Jstr.empty)
               _self##.dom
          )

      method update
        : PM.Model.node Js.t -> bool Js.t
        = fun node ->
          if (node##sameMarkup _self##.node = Js._false) then (
            Js._false
          ) else (
            _self##.node := node;
            Js.Opt.iter !innerView (fun view ->
                let state = view##.state in
                Js.Opt.iter (node##.content##findDiffStart state##.doc##.content) (fun start ->
                    let res_opt = (node##.content##findDiffEnd state##.doc##.content) in
                    Js.Opt.iter res_opt (fun end_diff ->
                        let overlap = start - (min end_diff##.a end_diff##.b) in
                        let endA, endB =
                          if overlap > 0 then
                            ( end_diff##.a + overlap
                            , end_diff##.b + overlap )
                          else
                            ( end_diff##.a
                            , end_diff##.b )
                        in
                        let tr =
                          state##.tr
                          ##(replace
                               ~from:start
                               ~to_:endB
                               (Js.some @@ node##slice ~from:start ~to_:(Js.some endA)))
                          ##(setMeta fromOutside true) in
                        view##dispatch tr)));
            Js._true
          )

      method destroy =
        Js.Opt.iter !innerView (fun _ -> _self##close)

      method stopEvent e =
        Js.Opt.case !innerView
          (fun () -> Js._false)
          (fun view ->
             let dom = view##.dom in
             Jv.call (Jv.Id.to_jv dom) "contains" [| e##.target|]
             |> Jv.Id.of_jv)

      method ignoreMutation =
        Js._true

      method selectNode =
        El.set_class (Jstr.v "ProseMirror-selectednode") true _self##.dom;
        if not (Js.Opt.test !innerView) then (
          _self##_open
        )

      method deselectNode =
        El.set_class (Jstr.v "ProseMirror-selectednode") false _self##.dom;
        if (Js.Opt.test !innerView) then
          _self##close

    end