fix init.ml
This commit is contained in:
111
.config/init.ml
111
.config/init.ml
@ -20,114 +20,3 @@ let resize ~container ~textbox () =
|
||||
:= 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 _ =
|
||||
Lwt.async (fun () ->
|
||||
let container = by_id "toplevel-container" in
|
||||
let textbox : 'a Js.t =
|
||||
by_id_coerce "userinput" Dom_html.CoerceTo.textarea
|
||||
in
|
||||
let rootstore = Store.test_pull () in
|
||||
rootstore >>= fun rs ->
|
||||
let workspace_store =
|
||||
Store.S.Tree.find_tree rs [ ".config"; "workspace" ]
|
||||
>>= function
|
||||
| Some t -> Lwt.return t
|
||||
| None -> Lwt.return (Store.S.Tree.empty ())
|
||||
in
|
||||
setup_storeview ~storeview:rootstore ~container ~textbox;
|
||||
Lwt.return
|
||||
(Lwt.async (fun () ->
|
||||
setup_workspace ~container workspace_store)))
|
||||
|
||||
Reference in New Issue
Block a user