diff --git a/.config/init.ml b/.config/init.ml index 6d7f789..9367470 100644 --- a/.config/init.ml +++ b/.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)))