New centered flex-layout for builds page with 2 columns + some refactorings around Views

lib/builder_web.ml

@@ -136,7 +136,7 @@ let add_routes datadir =
     |> if_error "Error getting job"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
     >>= fun (readme, builds) ->
-    Views.job ~failed:false job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok
+    Views.Job.make ~failed:false job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let job_with_failed req =
@@ -148,7 +148,7 @@ let add_routes datadir =
     |> if_error "Error getting job"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
     >>= fun (readme, builds) ->
-    Views.job ~failed:true job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok
+    Views.Job.make ~failed:true job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let redirect_latest req =
@@ -271,7 +271,14 @@ let add_routes datadir =
     |> if_error "Error getting job build"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
     >>= fun (build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) ->
-    Views.job_build job_name build artifacts same_input_same_output different_input_same_output same_input_different_output latest next previous
+    Views.Job.Build.make
+      ~name:job_name
+      ~build
+      ~artifacts
+      ~same_input_same_output
+      ~different_input_same_output
+      ~same_input_different_output
+      ~latest ~next ~previous
     |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 

lib/views.ml

@@ -306,7 +306,9 @@ let markdown_to_html data =
   let omd = safe_omd omd in
   Omd.to_html omd
 
-let job ~failed name platform readme builds =
+module Job = struct
+  
+  let make ~failed name platform readme builds =
     layout ~nav:(`Job (name, platform)) ~title:(Fmt.str "Job %s %a" name pp_platform platform)
       ((h1 [txtf "Job %s %a" name pp_platform platform] ::
         (match readme with
@@ -342,49 +344,35 @@ let job ~failed name platform readme builds =
            p [ txt "Including failed builds " ; a ~a:[a_href "failed/"] [txt "here"] ; txt "." ]
        ])
 
-let contains_debug_bin artifacts =
+  let contains_debug_bin artifacts =
     let check f =
       Fpath.has_ext "debug" f.Builder_db.filepath 
     in
     List.find_opt check artifacts |> CCOption.is_some
 
-let job_build
+  module Build = struct 
-    name
+
-    ({ Builder_db.Build.uuid; start; finish; result; platform; _ } as build)
+    let make_build_info
-    artifacts
+        ~name
-    same_input_same_output different_input_same_output same_input_different_output
+        ~delta 
-    latest next previous
+        ~(build:Builder_db.Build.t) (* ({ Builder_db.Build.uuid; start; finish; result; platform; _ } as build) *)
+        ~artifacts
+        ~same_input_same_output
+        ~different_input_same_output
+        ~same_input_different_output
+        ~latest ~next ~previous
       =
-  let delta = Ptime.diff finish start in
-  let analysis_section = [
-    [ h3 [txt "Analysis"] ];
-    if not @@ contains_debug_bin artifacts then [] else [
-      p [
-        let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in
-        let style = "width: 50em; height: 54.0em" 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/vizdependencies" name Uuidm.pp uuid in
-      let style = "width: 50em; height: 50.5em" in 
-      iframe ~a:[ a_src src; a_title "Opam dependencies"; a_style style ] [] ]];
-  ] |> List.flatten
-  in
-  let body =
-    h1 [txtf "Job %s" name] ::
       [
-      h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime start];
+        h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime build.start];
-      p [txtf "Built on platform %s" platform ];
+        p [txtf "Built on platform %s" build.platform ];
         p [txtf "Build took %a." Ptime.Span.pp delta ];
-      p [txtf "Execution result: %a." Builder.pp_execution_result result];
+        p [txtf "Execution result: %a." Builder.pp_execution_result build.result];
-    ] @ analysis_section @ [
         h3 [txt "Build info"];
         ul [
-        li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp uuid]
+          li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp build.uuid]
             [txt "Console output"];
           ];
-        li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp uuid]
+          li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp build.uuid]
             [txt "Build script"];
           ]
         ];
@@ -415,12 +403,12 @@ let job_build
              li [
                txtf "on %s, different input, " platform;
                a ~a:[Fmt.kstr a_href "/compare/%a/%a/"
-                 Uuidm.pp other_uuid Uuidm.pp uuid]
+                   Uuidm.pp other_uuid Uuidm.pp build.uuid]
                  [txtf "%a" pp_ptime start]
              ])
              different_input_same_output)
-    ] @
+      ]
-    (if same_input_different_output = [] then
+      @ (if same_input_different_output = [] then
           []
         else
           [ h3 [txt "Same input, different output (not reproducible!)"];
@@ -428,18 +416,20 @@ let job_build
               List.map (fun { Builder_db.Build.start ; uuid = other_uuid ; platform ; _ } ->
                 li [
                   txtf "on %s, " platform ;
-                a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp uuid]
+                  a ~a:[Fmt.kstr a_href "/compare/%a/%a/" Uuidm.pp other_uuid Uuidm.pp build.uuid]
                     [txtf "%a" pp_ptime start]
                 ])
                 same_input_different_output)
-        ]) @
+          ]
-    [ h3 [txt "Comparisons with other builds on the same platform"];
+      )
-      let opt_build (ctx, build) =
+      @ [
-        match build with
+        h3 [txt "Comparisons with other builds on the same platform"];
-        | Some b when not (Uuidm.equal uuid b.Builder_db.Build.uuid) ->
+        let opt_build (ctx, build') =
+          match build' with
+          | Some b when not (Uuidm.equal build.uuid b.Builder_db.Build.uuid) ->
             [ li [ txt ctx;
                 a ~a:[Fmt.kstr a_href "/compare/%a/%a/"
-                  Uuidm.pp b.uuid Uuidm.pp uuid]
+                    Uuidm.pp b.uuid Uuidm.pp build.uuid]
                   [txtf "%a" pp_ptime b.start]]
             ]
           | _ -> []
@@ -450,12 +440,85 @@ let job_build
                 ("Later build with different output ", next) ;
                 ("Earlier build with different output ", previous) ])
       ]
+
+    let viz_style = "
+      width: 46em;
+      height: 50em;
+      max-width: 100%;
+      max-height: 52vw;
+      min-width: 38em;
+      min-height: 41em;
+    "
+    
+    let make_viz_section ~name ~artifacts ~uuid =
+      [
+        (* [ h3 [txt "Analysis"] ]; *)
+        if not @@ contains_debug_bin artifacts then [] else [
+          p [
+            let src = Fmt.str "/job/%s/build/%a/viztreemap" name Uuidm.pp uuid in
+            iframe ~a:[ a_src src; a_title "Binary dissection"; a_style viz_style ] []
+          ]
+        ];
+        [ p [
+            let src = Fmt.str "/job/%s/build/%a/vizdependencies" name Uuidm.pp uuid in
+            iframe ~a:[ a_src src; a_title "Opam dependencies"; a_style viz_style ] [] ]];
+      ] |> List.flatten
+
+    let make
+        ~name
+        ~(build:Builder_db.Build.t)
+        ~artifacts
+        ~same_input_same_output
+        ~different_input_same_output
+        ~same_input_different_output
+        ~latest ~next ~previous
+      =
+      let delta = Ptime.diff build.finish build.start in
+      let right_column = make_viz_section ~name ~artifacts ~uuid:build.uuid in
+      let left_column =
+        make_build_info
+          ~name
+          ~delta 
+          ~build
+          ~artifacts
+          ~same_input_same_output
+          ~different_input_same_output
+          ~same_input_different_output
+          ~latest ~next ~previous
+      in
+      let style_grid = a_style "display: flex; " in
+      let style_grid_container = a_style "\
+        display: flex; 
+        align-items: center;
+        justify-content: center;
+        min-width: 83em;
+      "
+      in
+      let style_col_container = a_style "" in
+      let style_col_left = a_style "width: 45em; min-width: 43em; padding-left: 2%" in
+      let style_col_right = a_style "width: 50%" in
+      let body = [
+        div ~a:[ style_grid_container ] [
+          div ~a:[ style_col_container ] [
+            h1 [txtf "Job %s" name];
+            div ~a:[ style_grid ] [
+              (* div ~a:[ style_col_padding ] []; *)
+              div ~a:[ style_col_left ]  left_column;
+              div ~a:[ style_col_right ] right_column
+            ]
+          ]
+        ]
+      ]
       in
       layout
         ~nav:(`Build (name, build))
-    ~title:(Fmt.str "Job %s %a" name pp_ptime start)
+        ~title:(Fmt.str "Job %s %a" name pp_ptime build.start)
         body
 
+  end
+
+end
+    
 let key_values xs =
   List.concat_map (fun (k, v) -> [ txtf "%s %s" k v ; br () ]) xs