module Js = Js_of_ocaml.Js
module PM = Prosemirror
module Footnotes = Footnotes

(** Commands *)

let change_level :
    PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.Commands.t
    =
 fun pm res incr pred state dispatch ->
  let parent = res##.parent in
  let attributes = parent##.attrs in

  let current_level =
    if Jv.is_none attributes##.level then 0 else attributes##.level
  in
  let t, props =
    match pred current_level with
    | false ->
        ( PM.O.get state##.schema##.nodes "heading"
        , Js.some
            (object%js
               val level = current_level + incr
            end ) )
    | true ->
        (PM.O.get state##.schema##.nodes "paragraph", Js.null)
  in
  match t with
  | None ->
      Js._false
  | Some t ->
      PM.Commands.set_block_type pm t props state dispatch


(** Increase the title level by one when pressing # at the begining of a line *)
let handle_sharp pm state dispatch =
  let res = PM.State.selection_to state##.selection in
  match Js.Opt.to_option res##.nodeBefore with
  | Some _ ->
      Js._false
  | None ->
    (* Line start *)
    ( match Jstr.to_string res##.parent##._type##.name with
    | "heading" ->
        change_level pm res 1 (fun x -> x > 5) state dispatch
    | "paragraph" ->
      ( match PM.O.get state##.schema##.nodes "heading" with
      | None ->
          Js._false
      | Some t ->
          let props =
            Js.some
              (object%js
                 val level = 1
              end )
          in
          PM.Commands.set_block_type pm t props state dispatch )
    | _ ->
        Js._false )


let handle_backspace pm state dispatch =
  let res = PM.State.selection_to state##.selection in
  match Js.Opt.to_option res##.nodeBefore with
  | Some _ ->
      Js._false
  | None ->
    (* Line start *)
    ( match Jstr.to_string res##.parent##._type##.name with
    | "heading" ->
        change_level pm res (-1) (fun x -> x <= 1) state dispatch
    | _ ->
        Js._false )


(** Activate the given mark at position. 

    [toggle_mark regex pm] will create a rule with the given regex, and
    then apply the mark *)
let toggle_mark :
    Js.regExp Js.t -> PM.t -> string -> PM.InputRule.input_rule Js.t =
 fun regExp pm mark_type_name ->
  PM.InputRule.create
    pm
    regExp
    ~fn:
      ( Js.wrap_callback
      @@ fun (state : PM.State.editor_state Js.t) _ ~from ~to_ ->
      match PM.O.get state##.schema##.marks mark_type_name with
      | None ->
          Js.null
      | Some mark_type ->
          let m = state##.schema##mark_fromType mark_type Js.null in

          (* Delete the markup code *)
          let tr = state##.tr##delete ~from ~to_ in

          (* Check if the mark is active at the position *)
          let present =
            Js.Opt.bind
              (PM.State.cursor tr##.selection)
              (fun resolved ->
                Js.Opt.map
                  (mark_type##isInSet (resolved##marks ()))
                  (fun _ -> resolved) )
          in
          Js.Opt.case
            present
            (fun () ->
              let tr = tr##addStoredMark m in
              Js.some @@ tr )
            (fun _resolved ->
              let tr = tr##removeStoredMark_mark m in
              Js.some tr ) )


(** Transform the selection into URL *)
let into_url : Js.regExp Js.t -> PM.t -> PM.InputRule.input_rule Js.t =
 fun regExp pm ->
  PM.InputRule.create
    pm
    regExp
    ~fn:
      ( Js.wrap_callback
      @@ fun (state : PM.State.editor_state Js.t) content ~from ~to_ ->
      let matched_text = Js.array_get content 1 |> Js.Optdef.to_option
      and mark = PM.O.get state##.schema##.marks "link" in

      match (matched_text, mark) with
      | Some url, Some mark_type ->
          let attrs = PM.O.init [| ("href", url) |] in
          (* Create the mark containing the URL *)
          let m = state##.schema##mark_fromType mark_type (Js.some attrs) in
          (* Apply the mark as a transaction *)
          let tr =
            state
            ##. tr
            ## (addMark ~from ~to_ m)
            ## (insertText (Jstr.v " ") ~from:Js.null ~to_:Js.null)
          in
          Js.some tr
      | _ ->
          Js.null )


let input_rule pm =
  let bold = toggle_mark (new%js Js.regExp (Js.string "\\*\\*$")) pm "strong"
  and em = toggle_mark (new%js Js.regExp (Js.string "__$")) pm "em"
  and url = into_url (new%js Js.regExp (Js.string "(\\w+://\\S+)\\s$")) pm in

  PM.InputRule.to_plugin pm (Js.array [| bold; url; em |])


let default pm schema =
  (* Load the history plugin *)
  let _ = PM.History.(history pm (history_prop ())) in

  let props = PM.Example.options schema in
  props##.menuBar := Js.some Js._true ;
  props##.floatingMenu := Js.some Js._true ;
  props##.menuContent := (Footnotes.build_menu pm schema)##.fullMenu ;
  let setup = PM.Example.example_setup pm props in

  let keymaps =
    PM.Keymap.keymap
      pm
      [| ("Backspace", handle_backspace pm); ("#", handle_sharp pm) |]
  in

  (* Add the custom keymaps in the list *)
  let _ = setup##unshift keymaps in
  let _ = setup##push (input_rule pm) in
  let _ = setup##push (Tooltip.bold_plugin pm) in
  let _ = setup##push (Link_editor.plugin pm) in

  Js.some setup