diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5276a98 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*~ +_build/ \ No newline at end of file diff --git a/dune b/dune index daa6fc9..c1c9d2a 100644 --- a/dune +++ b/dune @@ -35,7 +35,9 @@ ocp-indent.lib higlo js_of_ocaml-lwt.graphics - js_of_ocaml-ppx) + js_of_ocaml-ppx + uucp + httpaf) (flags (:standard -rectypes -warn-error -A)) (link_flags diff --git a/index.html b/index.html index d4a3053..e7f099d 100644 --- a/index.html +++ b/index.html @@ -33,7 +33,7 @@ padding: 0px; } - #toplevel-container #output { + #toplevel-container .statusv { background-color:transparent; color: #ccc; border: none; @@ -42,7 +42,7 @@ margin-bottom: 0px; } - #toplevel-container textarea { + #toplevel-container #output { width:90%; line-height:18px; font-size: 12px; diff --git a/oplevel.ml b/oplevel.ml index 1c5e86b..4ca19d0 100644 --- a/oplevel.ml +++ b/oplevel.ml @@ -27,7 +27,6 @@ let setup_storeview ~container ~textbox ~(storeview : Store.t Lwt.t) : Lwt.async (fun _ -> storeview >>= fun storeview -> Firebug.console##log "setup_storeview"; - Store.S.Tree.list storeview [] >>= fun all -> ignore (List.fold_left @@ -58,11 +57,81 @@ let setup_storeview ~container ~textbox ~(storeview : Store.t Lwt.t) : "" 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 _ -> - Toplevel.run - (setup_storeview ~storeview:(Store.test_pull ())) - (); + 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 (); Js._false) diff --git a/toplevel.ml b/toplevel.ml index d5c1e37..430c057 100644 --- a/toplevel.ml +++ b/toplevel.ml @@ -23,7 +23,6 @@ open Js_of_ocaml_lwt open Js_of_ocaml_tyxml open Js_of_ocaml_toplevel open Lwt -open Store let compiler_name = "OCaml" let by_id s = Dom_html.getElementById s @@ -378,11 +377,10 @@ module History = struct textbox##.value := Js.string !data.(!idx)) end -let run setup_storeview () = +let run ~output () = Firebug.console##log "run"; 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 @@ -390,9 +388,7 @@ let run setup_storeview () = let sharp_ppf = Format.formatter_of_out_channel sharp_chan in let caml_chan = open_out "/dev/null1" in let caml_ppf = Format.formatter_of_out_channel caml_chan in - Firebug.console##log "run(Store.test_pull)"; - let execute () = - let content = Js.to_string textbox##.value##trim in + let execute ?(pp_code = sharp_ppf) content () = let content' = let len = String.length content in if @@ -407,8 +403,8 @@ let run setup_storeview () = current_position := output##.childNodes##.length; textbox##.value := Js.string ""; History.push content; - JsooTop.execute true ~pp_code:sharp_ppf ~highlight_location - caml_ppf content'; + JsooTop.execute true ~pp_code ~highlight_location caml_ppf + content'; resize ~container ~textbox () >>= fun () -> container##.scrollTop := container##.scrollHeight; textbox##focus; @@ -456,7 +452,8 @@ let run setup_storeview () = Dom_html.handler (fun e -> match e##.keyCode with | 13 when not (meta e || shift e) -> - Lwt.async execute; + Lwt.async (fun () -> + execute (Js.to_string textbox##.value##trim) ()); Js._false | 13 -> Lwt.async (resize ~container ~textbox); @@ -508,7 +505,6 @@ let run setup_storeview () = setup_share_button ~output; (* setup_examples ~container ~textbox; *) setup_pseudo_fs ~load_cmis_from_server:false; - setup_storeview ~container ~textbox; setup_toplevel (); setup_js_preview (); setup_printers (); @@ -518,7 +514,8 @@ let run setup_storeview () = try let code = List.assoc "code" (parse_hash ()) in textbox##.value := Js.string (B64.decode code); - Lwt.async execute + Lwt.async (fun () -> + execute (Js.to_string textbox##.value##trim) ()) with | Not_found -> () | exc -> diff --git a/toplevel.mli b/toplevel.mli index f3eefe1..8e2ddb6 100644 --- a/toplevel.mli +++ b/toplevel.mli @@ -1,11 +1,4 @@ open Js_of_ocaml open Store -val run : - (container: - (* storeview:S.tree Lwt.t ->*) - Js_of_ocaml.Dom_html.element Js_of_ocaml.Js.t -> - textbox:Js_of_ocaml.Dom_html.textAreaElement Js_of_ocaml.Js.t -> - unit) -> - unit -> - unit +val run : output:Dom_html.element Js.t -> unit -> unit