Several changes related to treemap rendering:

* Rendering treemap in build-page as iframe, as the svg needs static CSS classes to work; and static CSS doesn't compose
  * Added 'include_static_css' param to Views.layout (useful for later)
  * Added Builder_web.dream_svg helper if we want to serve a svg directly

lib/builder_web.ml

@@ -84,6 +84,11 @@ let get_uuid s =
        | None -> Error ("Bad uuid", `Bad_Request)
      else Error ("Bad uuid", `Bad_Request))
 
+let dream_svg ?status ?code ?headers body =
+  Dream.response ?status ?code ?headers body
+  |> Dream.with_header "Content-Type" "image/svg+xml"
+  |> Lwt.return
+
 let add_routes datadir =
   let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in
 
@@ -193,7 +198,7 @@ let add_routes datadir =
       ~log:(fun _ -> Log.warn (fun m -> m "Error reading ELF file %a"
                                   Fpath.pp path))
     >>= fun infos ->
-    let svg =
+    let svg_html =
       infos
       |> Info.import
       |> Info.diff_size
@@ -202,8 +207,11 @@ let add_routes datadir =
       |> Treemap.of_tree
       |> Treemap.doc
       |> Fmt.to_to_string (Tyxml.Html.pp ())
+      (* |> Treemap.svg
+       * |> Fmt.to_to_string (Tyxml.Svg.pp ()) *)
     in
-    Lwt_result.ok (Dream.html svg)
+    (* Lwt_result.ok (dream_svg svg) *)
+    Lwt_result.ok (Dream.html svg_html)
   in
 
   let job_build req =

lib/views.ml

@@ -32,7 +32,7 @@ type nav = [
 let pp_platform = Fmt.(option ~none:(any "") (append (any "on ") string))
 let pp_platform_query = Fmt.(option ~none:(any "") (append (any "?platform=") string))
 
-let layout ?nav:(nav_=`Default) ~title:title_ body_ =
+let layout ?include_static_css ?nav:(nav_=`Default) ~title:title_ body_ =
   let breadcrumb =
     let to_nav kvs =
       nav [ ul (List.map (fun (desc, href) ->
@@ -61,10 +61,12 @@ let layout ?nav:(nav_=`Default) ~title:title_ body_ =
         Fmt.str "/compare/%a/%a/" Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid;
       ]
   in
-  html
-    (head (title (txt title_))
-       [style ~a:[a_mime_type "text/css"]
-          [
+  let static_css =
+    let include_static_css = match include_static_css with
+      | None -> []
+      | Some l -> l
+    in
+    include_static_css @ [
       txt "body {\
            margin: 40px auto;\
            line-height: 1.6;\
@@ -109,7 +111,11 @@ let layout ?nav:(nav_=`Default) ~title:title_ body_ =
       txt ":checked + .toggleable {\
            display: block;\
            }";
-          ]])
+    ]
+  in
+  html
+    (head (title (txt title_))
+       [style ~a:[a_mime_type "text/css"] static_css])
 
     (body [
         breadcrumb;
@@ -343,15 +349,22 @@ let job_build
     latest next previous
   =
   let delta = Ptime.diff finish start in
-  layout ~nav:(`Build (name, build)) ~title:(Fmt.str "Job %s %a" name pp_ptime start)
-    (h1 [txtf "Job %s" name] ::
+  let body =
+    h1 [txtf "Job %s" name] ::
     [
       h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime start];
       p [txtf "Built on platform %s" platform ];
       p [txtf "Build took %a." Ptime.Span.pp delta ];
       p [txtf "Execution result: %a." Builder.pp_execution_result result];
-      p [a ~a:[Fmt.kstr a_href "/job/%s/build/%a/treemap" name Uuidm.pp uuid]
-           [txt "Treemap"]];
+      h3 [txt "Analysis"];
+      p [
+        let src = Fmt.str "/job/%s/build/%a/treemap" name Uuidm.pp uuid in
+        let style = "width: 35vw; height: 35.5vw" in (*treemap tries to be square*)
+        iframe ~a:[ a_src src; a_title "Binary dissection"; a_style style ] [] ];
+      (* p [
+       *   let src = Fmt.str "/job/%s/build/%a/treemap" name Uuidm.pp uuid in
+       *   img ~src ~alt:"Binary dissection" ()
+       * ]; *)
       h3 [txt "Build info"];
       ul [
         li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp uuid]
@@ -422,7 +435,13 @@ let job_build
             [ ("Latest build ", latest) ;
               ("Later build with different output ", next) ;
               ("Earlier build with different output ", previous) ])
-    ])
+    ]
+  in
+  layout
+    ~nav:(`Build (name, build))
+    ~title:(Fmt.str "Job %s %a" name pp_ptime start)
+    ~include_static_css:[Unsafe.data Modulectomy.Treemap.Doc.css]
+    body
 
 let key_values xs =
   List.concat_map (fun (k, v) -> [ txtf "%s %s" k v ; br () ]) xs