"header" parsing

.gitignore

@@ -0,0 +1,2 @@
+*~
+_build/

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

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;

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)

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 ->

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