console/oplevel
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

init.ml

Browse Source
This commit is contained in:
cqc
2024-02-19 16:41:11 -06:00
parent 2e6991f3dc
commit f46dc86c6a
6 changed files with 116 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
dune
View File

@ -37,7 +37,7 @@
js_of_ocaml-lwt.graphics js_of_ocaml-lwt.graphics
js_of_ocaml-ppx js_of_ocaml-ppx
uucp uucp
httpaf) httpaf)
(flags (flags
(:standard -rectypes -warn-error -A)) (:standard -rectypes -warn-error -A))
(link_flags (link_flags

4
notes.org
View File

@ -1,3 +1,7 @@
* run with
dune build ./oplevel.bc.js; dune exec ./cors_proxy.exe
* Test run with git where it was authorizied * Test run with git where it was authorizied
Listening on localhost:8080 and proxying requests via https://gitea.departmentofinter.net. Listening on localhost:8080 and proxying requests via https://gitea.departmentofinter.net.

95
oplevel.ml
View File

@ -10,17 +10,30 @@ let by_id_coerce s f =
(f (Dom_html.getElementById s)) (f (Dom_html.getElementById s))
(fun () -> raise Not_found) (fun () -> raise Not_found)
let do_by_id s f = let resize ~container ~textbox () =
try f (Dom_html.getElementById s) with Not_found -> () 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 _ = let _ =
Dom_html.window##.onload Dom_html.window##.onload
:= Dom_html.handler (fun _ -> := Dom_html.handler (fun _ ->
Lwt.async (fun () -> Lwt.async (fun () ->
let output = by_id "output" in let output = by_id "output" in
let rootstore = Store.test_pull () in let container = by_id "toplevel-container" in
rootstore >>= fun rs ->
(try Store.S.Tree.get rs [ ".config"; "init.ml" ] with 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 _ -> | Not_found | Invalid_argument _ ->
Lwt.return Lwt.return
"print_newline \"rootstore://.config/init.ml not \ "print_newline \"rootstore://.config/init.ml not \
@ -32,7 +45,77 @@ let _ =
exc; exc;
Lwt.return ";;") Lwt.return ";;")
>>= fun init -> >>= 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); Lwt.return_unit);
Js._false) Js._false)

4
store.ml
View File

@ -355,7 +355,7 @@ let test_populate () : t Lwt.t =
>>= add [ "hello"; "daddy" ] "ily" >>= add [ "hello"; "daddy" ] "ily"
>>= add [ "beep"; "beep" ] "motherfucker" >>= add [ "beep"; "beep" ] "motherfucker"
let test_pull () : t Lwt.t = let test_pull () : (Irmin.remote * Sync.db) Lwt.t =
(* test_populate ()*) (* test_populate ()*)
Firebug.console##log (Js.string "Nav.test_pull()\n"); Firebug.console##log (Js.string "Nav.test_pull()\n");
S.Repo.v (Config.init "") >>= fun repo -> 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"); Firebug.console##log (Js.string "Nav.test_pull(5)\n");
Sync.pull_exn t upstream `Set >>= fun _ -> Sync.pull_exn t upstream `Set >>= fun _ ->
Firebug.console##log (Js.string "Nav.test_pull(6)\n"); 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 *) (* irmin/src/irmin/sync.ml: calls S.Remote.Backend.fetch *)

78
toplevel.ml
View File

@ -377,7 +377,8 @@ module History = struct
textbox##.value := Js.string !data.(!idx)) textbox##.value := Js.string !data.(!idx))
end end
let run ~init ~output () = let run ~init ~output () :
?pp_code:Format.formatter -> string -> unit -> unit Lwt.t =
Firebug.console##log "run"; Firebug.console##log "run";
let container = by_id "toplevel-container" in let container = by_id "toplevel-container" in
@ -410,66 +411,6 @@ let run ~init ~output () =
textbox##focus; textbox##focus;
Lwt.return_unit Lwt.return_unit
in 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 := (Lwt.async_exception_hook :=
fun exc -> fun exc ->
Format.eprintf "exc during Lwt.async: %s@." Format.eprintf "exc during Lwt.async: %s@."
@ -522,14 +463,15 @@ let run ~init ~output () =
(Js.string ".config/init.ml exception") (Js.string ".config/init.ml exception")
(Js.string (Printexc.to_string exc)) (Js.string (Printexc.to_string exc))
exc); exc);
try (try
let code = List.assoc "code" (parse_hash ()) in let code = List.assoc "code" (parse_hash ()) in
textbox##.value := Js.string (B64.decode code); textbox##.value := Js.string (B64.decode code);
Lwt.async (fun () -> Lwt.async (fun () ->
execute (Js.to_string textbox##.value##trim) ()) execute (Js.to_string textbox##.value##trim) ())
with with
| Not_found -> () | Not_found -> ()
| exc -> | exc ->
Firebug.console##log_3 (Js.string "exception") Firebug.console##log_3 (Js.string "exception")
(Js.string (Printexc.to_string exc)) (Js.string (Printexc.to_string exc))
exc exc);
execute

11
toplevel.mli
View File

@ -1,4 +1,13 @@
open Js_of_ocaml open Js_of_ocaml
open Store 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