"header" parsing

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)