From 05d3ccad827f4adbdbb7e3bd031579796a508501 Mon Sep 17 00:00:00 2001
From: rand00 <oth.rand@gmail.com>
Date: Wed, 3 Aug 2022 12:29:15 +0200
Subject: [PATCH] Implemented a form on job-page for filtering platforms

---
 lib/builder_web.ml | 32 ++++++++++++++++++++++++--------
 lib/views.ml       | 33 +++++++++++++++++++++++++++------
 2 files changed, 51 insertions(+), 14 deletions(-)

diff --git a/lib/builder_web.ml b/lib/builder_web.ml
index 8f5de34..272e7a1 100644
--- a/lib/builder_web.ml
+++ b/lib/builder_web.ml
@@ -278,29 +278,45 @@ let routes ~datadir ~cachedir ~configdir =
     Views.Builds.make jobs |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
+  let remove_empty_param param_opt = 
+    Option.bind param_opt (fun p -> if p = "" then None else Some p)
+  in
+      
   let job req =
     let job_name = Dream.param req "job" in
-    let platform = Dream.query req "platform" in
+    let platform = Dream.query req "platform" |> remove_empty_param in
     (Dream.sql req (Model.job_and_readme job_name) >>= fun (job_id, readme) ->
+     Dream.sql req (Model.builds_grouped_by_output job_id None) >>= fun all_builds ->
+     let platforms =
+       all_builds
+       |> List.map (fun (build, _) -> build.Builder_db.Build.platform)
+       |> List.sort_uniq String.compare
+     in
      Dream.sql req (Model.builds_grouped_by_output job_id platform) >|= fun builds ->
-     (readme, builds))
+     (readme, builds, platforms))
     |> 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.make ~failed:false ~job_name ~platform ~readme builds
+    >>= fun (readme, builds, platforms) ->
+    Views.Job.make ~failed:false ~job_name ~platform ~platforms ~readme builds
     |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let job_with_failed req =
     let job_name = Dream.param req "job" in
-    let platform = Dream.query req "platform" in
+    let platform = Dream.query req "platform" |> remove_empty_param in
     (Dream.sql req (Model.job_and_readme job_name) >>= fun (job_id, readme) ->
+     Dream.sql req (Model.builds_grouped_by_output job_id None) >>= fun all_builds ->
+     let platforms =
+       all_builds
+       |> List.map (fun (build, _) -> build.Builder_db.Build.platform)
+       |> List.sort_uniq String.compare
+     in
      Dream.sql req (Model.builds_grouped_by_output_with_failed job_id platform) >|= fun builds ->
-     (readme, builds))
+     (readme, builds, platforms))
     |> 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.make ~failed:true ~job_name ~platform ~readme builds
+    >>= fun (readme, builds, platforms) ->
+    Views.Job.make ~failed:true ~job_name ~platform ~platforms ~readme builds
     |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
diff --git a/lib/views.ml b/lib/views.ml
index 9e5ae72..330bdd9 100644
--- a/lib/views.ml
+++ b/lib/views.ml
@@ -413,10 +413,30 @@ module Job = struct
             build.Builder_db.Build.result ]
     )
 
-  let make_builds ~failed ~job_name ~platform builds =
+  let make_builds ~failed ~job_name ~platform ~platforms builds =
+    let all_platforms =
+      H.option ~a:H.[ a_value "" ] (H.txt "All platforms")
+    in
     [
       H.h2 ~a:H.[a_id "builds"] [H.txt "Builds"];
-      H.a ~a:H.[a_href "#readme"] [H.txt "Back to readme"];
+      (* H.a ~a:H.[a_href "#readme"] [H.txt "Back to readme"]; *)
+      H.form ~a:H.[
+          a_action @@ "";
+          a_method `Get;
+        ] [
+        H.label ~a:H.[a_label_for "filter-platform"] [H.txt "Filter platform: "];
+        H.select ~a:H.[
+            a_name "platform";
+            a_id "filter-platform";
+          ]
+          (all_platforms :: (platforms |> List.map (fun platform -> 
+               H.option ~a:H.[ a_value platform ] (H.txt platform)
+             )));
+        H.input ~a:H.[
+            a_input_type `Submit;
+            a_value "Apply";
+          ] ();
+      ];
       H.ul (builds |> List.map (make_build ~job_name));
       let queries =
         platform |> Option.map (fun p -> `Platform p) |> Option.to_list
@@ -439,14 +459,15 @@ module Job = struct
           H.txt "." ]
     ]
 
-  let make_body ~failed ~job_name ~platform ~readme builds =
+  let make_body ~failed ~job_name ~platform ~platforms ~readme builds =
     make_header ~job_name ~platform ~readme
-    @ make_builds ~failed ~job_name ~platform builds
+    @ make_builds ~failed ~job_name ~platform ~platforms builds
 
-  let make ~failed ~job_name ~platform ~readme builds =
+  let make ~failed ~job_name ~platform ~readme ~platforms builds =
     let nav = `Job (job_name, platform) in
     let title = Fmt.str "Job %s %a" job_name pp_platform platform in
-    layout ~nav ~title @@ make_body ~failed ~job_name ~platform ~readme builds
+    layout ~nav ~title
+    @@ make_body ~failed ~job_name ~platform ~platforms ~readme builds
 
 
 end