open Js_of_ocaml
open Brr
module PM = Prosemirror

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

    (* There are some problems to update the view when the content is empty.
       It looks like the comparaison does not comprae the level argument.
       In order to prevent any error, juste return in such situation.
    *)
    let empty_content = parent##.content##eq (PM.Model.empty_fragment pm)
    and level = attributes##.level in
    if (pred level || empty_content) then false
    else
      (* Look the position for the previous element *)
      let resolved = (res##.doc)##resolve (res##.pos -1) in
      let selection = PM.State.node_selection pm resolved in

      let props = object%js
        val level = level + incr
      end in

      let element = parent##copy (PM.Model.empty_fragment pm) in
      element##.attrs := props;
      element##.content := parent##.content;

      (* Create a new transaction for replacing the selection *)
      let tr = state##.tr in
      let tr = tr##replaceRangeWith
          selection##.from
          selection##._to
          element in

      (* Return at the initial position *)
      let position = PM.State.create_text_selection
          pm
          tr##.doc
          res##.pos in
      let tr = tr##setSelection position in
      dispatch (tr##scrollIntoView ());
      true

let handle_backspace pm state dispatch =

  (* Get the currrent node *)
  let res = PM.State.selection_to (state##.selection) in

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


(** Increase the title level by one when pressing # at the begining of a line *)
let handle_sharp pm state dispatch =
  (* Get the currrent node *)
  let res = PM.State.selection_to (state##.selection) in

  match Js.Opt.to_option res##.nodeBefore with
  | Some _ -> false
  | None -> (* Line start *)
    let parent = res##.parent in
    begin match Jstr.to_string parent##._type##.name with
      | "heading" -> change_level pm res state (+1) dispatch (fun x -> x > 5)
      | _ -> false
    end


let default_plugins pm schema =

  let props = PM.Example.options schema in
  props##.menuBar := Js.some false;
  props##.floatingMenu := Js.some false;
  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

  Js.some setup

let create_new_state pm mySchema content =
  let module PM = Prosemirror in

  let doc = PM.Model.(
      DOMParser.parse
        (DOMParser.from_schema pm mySchema)
        (Jv.Id.of_jv content)) in

  let props = PM.State.creation_prop () in
  props##.doc := Js.some doc;
  props##.plugins := default_plugins pm mySchema;

  PM.State.create
    pm
    props

let storage_key = (Jstr.v "editor")
let prosemirror id content =
  begin match (Jv.is_none id), (Jv.is_none content) with
    | false, false ->

      let module PM = Prosemirror in
      let pm = PM.v () in

      let specs = PM.Model.schema_spec
          (PM.SchemaList.add_list_nodes
             pm
             ((PM.SchemaBasic.schema pm)##.spec##.nodes)
             (Jstr.v "paragraph block*")
             (Some (Jstr.v "block")))
          (Some (PM.SchemaBasic.schema pm)##.spec##.marks)
          None in

      let mySchema = PM.Model.schema pm specs in


      (* Create the initial state *)
      let storage = Brr_io.Storage.local G.window in
      let opt_data = Brr_io.Storage.get_item storage storage_key in
      let state = match opt_data with
        | None -> create_new_state pm mySchema content
        | Some contents ->
          (* Try to load from the storage *)
          begin match Json.decode contents with
            | Error _ -> create_new_state pm mySchema content
            | Ok json ->
              Console.(log [Jstr.v "Loading json"]);

              let history = PM.History.(history pm (history_prop ()) ) in
              let _ = history in

              let obj = PM.State.configuration_prop () in
              obj##.plugins := default_plugins pm mySchema;
              obj##.schema := Js.some mySchema;
              PM.State.fromJSON pm obj json
          end
      in

      let props = PM.View.direct_editor_props () in
      props##.state := state;


      let view = PM.View.editor_view
          pm
          (Jv.Id.of_jv id)
          props in


      view##setProps props;

      (* Attach an event on focus out *)
      let _out_event = Brr_note.Evr.on_el
          (Ev.focusout)
          (fun _ ->
             let contents = view##.state##toJSON () in

             let storage = Brr_io.Storage.local G.window in
             Brr_io.Storage.set_item
               storage
               storage_key
               (Json.encode @@ contents)
             |> Console.log_if_error ~use:()



          )
          (Jv.Id.of_jv id) in
      ()

    | _, _-> Console.(error [str "No element with id '%s' '%s' found"; id ; content])

  end

let () =

  let open Jv in
  let editor = obj
      [| "attach_prosemirror", (repr prosemirror)
      |] in

  set global "editor" editor