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