open Js_of_ocaml
open Js_of_ocaml_tyxml
open Lwt
open Store

let by_id s = Dom_html.getElementById s

let by_id_coerce s f =
  Js.Opt.get
    (f (Dom_html.getElementById s))
    (fun () -> raise Not_found)

let resize ~container ~textbox () =
  Lwt.pause () >>= fun () ->
  textbox##.style##.height := Js.string "auto";
  textbox##.style##.height
  := Js.string (Printf.sprintf "%dpx" (max 18 textbox##.scrollHeight));
  (* container##.scrollTop := container##.scrollHeight; *)
  Lwt.return ()

let appendchild ~container html =
  Dom.appendChild container (Tyxml_js.To_dom.of_a html)

let _ =
  Dom_html.window##.onload
  := Dom_html.handler (fun _ ->
         Lwt.async (fun () ->
             let output = by_id "output" in
             let container = by_id "toplevel-container" in
             appendchild ~container
               Tyxml_js.Html.(
                 a
                   ~a:[ a_class [ "window" ] ]
                   [
                     div
                       ~a:[ a_class [ "status" ] ]
                       [ txt "starting..." ];
                   ]);
             let textbox : 'a Js.t =
               by_id_coerce "code" Dom_html.CoerceTo.textarea
             in
             let rootrepo = Store.test_pull () in
             rootrepo >>= fun (_upstream, t) ->
             Store.S.tree t >>= fun rootstore ->
             (try
                Store.S.Tree.get rootstore [ ".config"; "init.ml" ]
              with
             | Not_found | Invalid_argument _ ->
                 Lwt.return
                   "print_newline \"rootstore://.config/init.ml not \
                    found\";;"
             | exc ->
                 Firebug.console##log_3
                   (Js.string ".config/init.ml load exception")
                   (Js.string (Printexc.to_string exc))
                   exc;
                 Lwt.return ";;")
             >>= fun init ->
             let execute = ref (Toplevel.run ~init ~output ()) in
             let meta e =
               let b = Js.to_bool in
               b e##.ctrlKey || b e##.altKey || b e##.metaKey
             in
             let shift e = Js.to_bool e##.shiftKey in
             (* setup handlers *)
             textbox##.onkeyup :=
               Dom_html.handler (fun _ ->
                   (* Lwt.async (resize ~container ~textbox); *)
                   Js._true);
             textbox##.onchange :=
               Dom_html.handler (fun _ ->
                   (* Lwt.async (resize ~container ~textbox); *)
                   Js._true);
             textbox##.onkeydown :=
               Dom_html.handler
                 Dom_html.Keyboard_code.(
                   fun e ->
                     match of_key_code e##.keyCode with
                     | Enter when not (meta e || shift e) ->
                         Lwt.async (fun () ->
                             !execute
                               (Js.to_string textbox##.value##trim)
                               ());
                         Js._false
                     | Enter ->
                         Lwt.async (resize ~container ~textbox);
                         Js._true
                     | Tab ->
                         Indent.textarea textbox;
                         Js._false
                     | KeyL when meta e ->
                         output##.innerHTML := Js.string "";
                         Js._true
                     | KeyK when meta e ->
                         Lwt.async
                           Store.S.(
                             fun () ->
                               rootrepo >>= fun (upstream, t) ->
                               Sync.pull_exn t upstream `Set
                               >>= fun _ ->
                               Firebug.console##log
                                 (Js.string
                                    "re-pulling rootstore for init.ml\n");
                               tree t >>= fun rs ->
                               (try
                                  Store.S.Tree.get rs
                                    [ ".config"; "init.ml" ]
                                with
                               | Not_found | Invalid_argument _ ->
                                   Lwt.return
                                     "print_newline \
                                      \"rootstore://.config/init.ml \
                                      not found\";;"
                               | exc ->
                                   Firebug.console##log_3
                                     (Js.string
                                        ".config/init.ml load \
                                         exception")
                                     (Js.string
                                        (Printexc.to_string exc))
                                     exc;
                                   Lwt.return ";;")
                               >>= fun init ->
                               Lwt.return
                                 (execute :=
                                    Toplevel.run ~init ~output ()));
                         Js._false
                     (* | ArrowUp -> history_up e
                        | ArrowDown -> history_down e *)
                     | _ -> Js._true);
             Lwt.return_unit);

         Js._false)