init.ml
This commit is contained in:
cqc
@ -1,3 +1,7 @@
|
||||
* run with
|
||||
dune build ./oplevel.bc.js; dune exec ./cors_proxy.exe
|
||||
|
||||
|
||||
* Test run with git where it was authorizied
|
||||
|
||||
Listening on localhost:8080 and proxying requests via https://gitea.departmentofinter.net.
|
||||
|
||||
95
oplevel.ml
95
oplevel.ml
@ -10,17 +10,30 @@ let by_id_coerce s f =
|
||||
(f (Dom_html.getElementById s))
|
||||
(fun () -> raise Not_found)
|
||||
|
||||
let do_by_id s f =
|
||||
try f (Dom_html.getElementById s) with 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 _ =
|
||||
Dom_html.window##.onload
|
||||
:= Dom_html.handler (fun _ ->
|
||||
Lwt.async (fun () ->
|
||||
let output = by_id "output" in
|
||||
let rootstore = Store.test_pull () in
|
||||
rootstore >>= fun rs ->
|
||||
(try Store.S.Tree.get rs [ ".config"; "init.ml" ] with
|
||||
let container = by_id "toplevel-container" in
|
||||
|
||||
let textbox : 'a Js.t =
|
||||
by_id_coerce "userinput" 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 \
|
||||
@ -32,7 +45,77 @@ let _ =
|
||||
exc;
|
||||
Lwt.return ";;")
|
||||
>>= fun init ->
|
||||
Toplevel.run ~init ~output ();
|
||||
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 "Nav.test_pull(6)\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)
|
||||
|
||||
4
store.ml
4
store.ml
@ -355,7 +355,7 @@ let test_populate () : t Lwt.t =
|
||||
>>= add [ "hello"; "daddy" ] "ily"
|
||||
>>= add [ "beep"; "beep" ] "motherfucker"
|
||||
|
||||
let test_pull () : t Lwt.t =
|
||||
let test_pull () : (Irmin.remote * Sync.db) Lwt.t =
|
||||
(* test_populate ()*)
|
||||
Firebug.console##log (Js.string "Nav.test_pull()\n");
|
||||
S.Repo.v (Config.init "") >>= fun repo ->
|
||||
@ -378,5 +378,5 @@ let test_pull () : t Lwt.t =
|
||||
Firebug.console##log (Js.string "Nav.test_pull(5)\n");
|
||||
Sync.pull_exn t upstream `Set >>= fun _ ->
|
||||
Firebug.console##log (Js.string "Nav.test_pull(6)\n");
|
||||
S.tree t
|
||||
Lwt.return (upstream, t)
|
||||
(* irmin/src/irmin/sync.ml: calls S.Remote.Backend.fetch *)
|
||||
|
||||
68
toplevel.ml
68
toplevel.ml
@ -377,7 +377,8 @@ module History = struct
|
||||
textbox##.value := Js.string !data.(!idx))
|
||||
end
|
||||
|
||||
let run ~init ~output () =
|
||||
let run ~init ~output () :
|
||||
?pp_code:Format.formatter -> string -> unit -> unit Lwt.t =
|
||||
Firebug.console##log "run";
|
||||
|
||||
let container = by_id "toplevel-container" in
|
||||
@ -410,66 +411,6 @@ let run ~init ~output () =
|
||||
textbox##focus;
|
||||
Lwt.return_unit
|
||||
in
|
||||
let history_down _e =
|
||||
let txt = Js.to_string textbox##.value in
|
||||
let pos = textbox##.selectionStart in
|
||||
try
|
||||
if String.length txt = pos then raise Not_found;
|
||||
let _ = String.index_from txt pos '\n' in
|
||||
Js._true
|
||||
with Not_found ->
|
||||
History.current txt;
|
||||
History.next textbox;
|
||||
Js._false
|
||||
in
|
||||
let history_up _e =
|
||||
let txt = Js.to_string textbox##.value in
|
||||
let pos = textbox##.selectionStart - 1 in
|
||||
try
|
||||
if pos < 0 then raise Not_found;
|
||||
let _ = String.rindex_from txt pos '\n' in
|
||||
Js._true
|
||||
with Not_found ->
|
||||
History.current txt;
|
||||
History.previous textbox;
|
||||
Js._false
|
||||
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 (fun e ->
|
||||
match e##.keyCode with
|
||||
| 13 when not (meta e || shift e) ->
|
||||
Lwt.async (fun () ->
|
||||
execute (Js.to_string textbox##.value##trim) ());
|
||||
Js._false
|
||||
| 13 ->
|
||||
Lwt.async (resize ~container ~textbox);
|
||||
Js._true
|
||||
| 09 ->
|
||||
Indent.textarea textbox;
|
||||
Js._false
|
||||
| 76 when meta e ->
|
||||
output##.innerHTML := Js.string "";
|
||||
Js._true
|
||||
| 75 when meta e ->
|
||||
setup_toplevel ();
|
||||
Js._false
|
||||
| 38 -> history_up e
|
||||
| 40 -> history_down e
|
||||
| _ -> Js._true);
|
||||
(Lwt.async_exception_hook :=
|
||||
fun exc ->
|
||||
Format.eprintf "exc during Lwt.async: %s@."
|
||||
@ -522,7 +463,7 @@ let run ~init ~output () =
|
||||
(Js.string ".config/init.ml exception")
|
||||
(Js.string (Printexc.to_string exc))
|
||||
exc);
|
||||
try
|
||||
(try
|
||||
let code = List.assoc "code" (parse_hash ()) in
|
||||
textbox##.value := Js.string (B64.decode code);
|
||||
Lwt.async (fun () ->
|
||||
@ -532,4 +473,5 @@ let run ~init ~output () =
|
||||
| exc ->
|
||||
Firebug.console##log_3 (Js.string "exception")
|
||||
(Js.string (Printexc.to_string exc))
|
||||
exc
|
||||
exc);
|
||||
execute
|
||||
|
||||
11
toplevel.mli
11
toplevel.mli
@ -1,4 +1,13 @@
|
||||
open Js_of_ocaml
|
||||
open Store
|
||||
|
||||
val run : init:string -> output:Dom_html.element Js.t -> unit -> unit
|
||||
val run :
|
||||
init:string ->
|
||||
output:Dom_html.element Js.t ->
|
||||
unit ->
|
||||
?pp_code:Format.formatter ->
|
||||
string ->
|
||||
unit ->
|
||||
unit Lwt.t
|
||||
|
||||
val setup_toplevel : unit -> unit
|
||||
|
||||
Reference in New Issue
Block a user