open StdLabels
open Js_of_ocaml
open Brr


module PM = Prosemirror

(** https://prosemirror.net/examples/tooltip/ *)

(** Set the element position just above the selection  *)
let set_position
  : PM.View.editor_view Js.t -> El.t -> unit
  = fun view el ->
    El.set_inline_style El.Style.display (Jstr.v "") el;
    let start = view##coordsAtPos (view##.state##.selection##.from) Js.null
    and end' = view##coordsAtPos (view##.state##.selection##._to) Js.null in
    let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in

    let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in
    let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in
    let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in

    let left = (start##.left +. end'##.left) /. 2. in

    El.set_inline_style (Jstr.v "left")
      Jstr.( (of_float ( left -. box_left )) + (v "px") )
      el;
    El.set_inline_style (Jstr.v "bottom")
      Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") )
      el

let tooltip
  : PM.View.editor_view Js.t -> < .. > Js.t
  = fun view ->

    (* Create the element which will be displayed over the editor *)
    let tooltip = El.div []
        ~at:At.([class' (Jstr.v "tooltip")]) in
    El.set_inline_style El.Style.display (Jstr.v "none") tooltip;

    let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
    let () = El.append_children parent [tooltip] in

    let update
      : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
      = fun view state_opt ->

        Js.Opt.iter state_opt
          (fun previous_state ->
             if ((view##.state##.doc##eq previous_state##.doc) = Js._true)
             && ((previous_state##.selection##eq view##.state##.selection) = Js._true)
             then
               ()
             else (
               if (view##.state##.selection##.empty) = Js._true then
                 (* Hide the tooltip if the selection is empty *)
                 El.set_inline_style El.Style.display (Jstr.v "none") tooltip
               else (
                 (* otherwise, reposition it and update its content *)
                 set_position view tooltip;
                 El.set_prop
                   (El.Prop.jstr (Jstr.v "textContent"))
                   (Jstr.of_int
                      (view##.state##.selection##._to -  view##.state##.selection##.from))
                   tooltip)))
    and destroy () = El.remove tooltip in

    object%js
      val update = Js.wrap_callback update
      val destroy= Js.wrap_callback destroy
    end

let tooltip_plugin
  : PM.t -> PM.State.plugin Js.t
  = fun t ->
    let state = Jv.get (Jv.Id.to_jv t) "state" in

    let params = object%js
      val view = (fun view -> tooltip view)
    end in

    Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
    |> Jv.Id.of_jv


let boldtip
  : PM.View.editor_view Js.t -> < .. > Js.t
  = fun view ->
    (* Create the element which will be displayed over the editor *)
    let tooltip = El.div []
        ~at:At.([class' (Jstr.v "tooltip")]) in
    El.set_inline_style El.Style.display (Jstr.v "none") tooltip;

    let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
    let () = El.append_children parent [tooltip] in

    let update
      : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
      = fun view _state_opt ->
        let state = view##.state in
        let is_bold = Option.bind (PM.O.get state##.schema##.marks "strong")
            (fun mark_type ->
               let is_strong =
                 Js.Opt.bind state##.storedMarks
                   (fun t -> mark_type##isInSet t) in
               Js.Opt.case is_strong
                 (fun () -> None)
                 (fun _ -> Some (Jstr.v "gras"))) in
        let is_em = Option.bind (PM.O.get state##.schema##.marks "em")
            (fun mark_type ->
               let is_strong =
                 Js.Opt.bind state##.storedMarks
                   (fun t -> mark_type##isInSet t) in
               Js.Opt.case is_strong
                 (fun () -> None)
                 (fun _ -> Some (Jstr.(v "emphase")))) in

        let marks = List.filter_map [is_bold; is_em] ~f:(fun x -> x) in
        match marks with
        | [] -> El.set_inline_style El.Style.display (Jstr.v "none") tooltip
        | _ ->
          (* The mark is present, add in the content *)
          set_position view tooltip;
          El.set_prop
            (El.Prop.jstr (Jstr.v "textContent"))
            (Jstr.concat marks ~sep:(Jstr.v ", "))
            tooltip

    and destroy () = El.remove tooltip in

    object%js
      val update = Js.wrap_callback update
      val destroy= Js.wrap_callback destroy
    end

let bold_plugin
  : PM.t -> PM.State.plugin Js.t
  = fun t ->
    let state = Jv.get (Jv.Id.to_jv t) "state" in

    let params = object%js
      val view = (fun view -> boldtip view)
    end in

    Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
    |> Jv.Id.of_jv