diff --git a/oplevel.ml b/oplevel.ml index 4ca19d0..0b79529 100644 --- a/oplevel.ml +++ b/oplevel.ml @@ -13,125 +13,26 @@ let by_id_coerce s f = 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 setup_storeview ~container ~textbox ~(storeview : Store.t Lwt.t) : - unit = - let storeview_container = by_id "toplevel-storeview" in - Lwt.async (fun _ -> - storeview >>= fun storeview -> - Firebug.console##log "setup_storeview"; - Store.S.Tree.list storeview [] >>= fun all -> - ignore - (List.fold_left - (fun acc tok -> - match tok with - | step, _tree -> - let a = - Tyxml_js.Html.( - a - ~a: - [ - a_class [ "list-group-item" ]; - a_onclick (fun _ -> - textbox##.value := - (Js.string acc)##trim; - Lwt.async (fun () -> - resize ~container ~textbox () - >>= fun () -> - textbox##focus; - Lwt.return_unit); - true); - ] - [ txt step ]) - in - Dom.appendChild storeview_container - (Tyxml_js.To_dom.of_a a); - "") - "" all); - Lwt.return_unit) - -(* TODO replace with Angstrom like httpaf *) -let headers_of_string_list (sl : string list) : Httpaf.Headers.t = - Httpaf.Headers.of_list - (List.filter_map - (fun s -> - Firebug.console##log (F.str "headerparse: %s" s); - Option.map - (fun i -> - ( String.trim (String.sub s 0 i), - String.trim - (String.sub s (i + 1) (String.length s - i - 1)) )) - (String.index_opt s ':')) - sl) - -let setup_workspace ~container cstore : unit Lwt.t = - let render ~container cstore : unit Lwt.t = - let module Headers = Httpaf.Headers in - Store.S.Tree.list cstore [] >>= fun csl -> - container##.innerHTML := Js.string ""; - Lwt_list.iter_s - (fun (step, tree) -> - Firebug.console##log (F.str ".config/workspace/%s" step); - Store.S.Tree.get tree [] >>= fun contents -> - let headers = - headers_of_string_list (String.split_on_char '\n' contents) - in - Firebug.console##log - (F.str "Headers:\n%a" Headers.pp_hum headers); - let uri = - Uri.of_string - (Option.fold ~none:"" - ~some:(fun s -> s) - (Headers.get headers "path")) - in - Dom.appendChild container - (Tyxml_js.To_dom.of_a - Tyxml_js.Html.( - a - ~a:[ a_class [ "window" ] ] - [ - div - ~a:[ a_class [ "status" ] ] - [ - txt - (F.str "Name: %s; Path: %a" step Uri.pp_hum - uri); - ]; - div - ~a:[ a_class [ "output" ] ] - [ txt (F.str "%s" contents) ]; - ])); - Lwt.return_unit) - csl - in - cstore >>= render ~container - let _ = Dom_html.window##.onload := Dom_html.handler (fun _ -> - let container = by_id "toplevel-container" in - let output = by_id "output" in - let textbox : 'a Js.t = - by_id_coerce "userinput" Dom_html.CoerceTo.textarea - in - let storeview = Store.test_pull () in - let workspace_store = - storeview >>= fun sv -> - Store.S.Tree.find_tree sv [ ".config"; "workspace" ] - >>= function - | Some t -> Lwt.return t - | None -> Lwt.return (Store.S.Tree.empty ()) - in Lwt.async (fun () -> - setup_workspace ~container workspace_store); - setup_storeview ~storeview ~container ~textbox; - Toplevel.run ~output (); + 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 + | 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 -> + Toplevel.run ~init ~output (); + Lwt.return_unit); Js._false) diff --git a/toplevel.ml b/toplevel.ml index 430c057..c998433 100644 --- a/toplevel.ml +++ b/toplevel.ml @@ -377,7 +377,7 @@ module History = struct textbox##.value := Js.string !data.(!idx)) end -let run ~output () = +let run ~init ~output () = Firebug.console##log "run"; let container = by_id "toplevel-container" in @@ -511,6 +511,17 @@ let run ~output () = History.setup (); textbox##.value := Js.string ""; (* Run initial code if any *) + (try + textbox##.value := Js.string init; + Lwt.async (fun () -> + execute (Js.to_string textbox##.value##trim) ()) + with + | Not_found -> () + | exc -> + Firebug.console##log_3 + (Js.string ".config/init.ml exception") + (Js.string (Printexc.to_string exc)) + exc); try let code = List.assoc "code" (parse_hash ()) in textbox##.value := Js.string (B64.decode code); diff --git a/toplevel.mli b/toplevel.mli index 8e2ddb6..26bf137 100644 --- a/toplevel.mli +++ b/toplevel.mli @@ -1,4 +1,4 @@ open Js_of_ocaml open Store -val run : output:Dom_html.element Js.t -> unit -> unit +val run : init:string -> output:Dom_html.element Js.t -> unit -> unit