Implemented a form on job-page for filtering platforms

This commit is contained in:
rand00 2022-08-03 12:29:15 +02:00
parent 637afde869
commit 05d3ccad82
2 changed files with 51 additions and 14 deletions

View file

@ -278,29 +278,45 @@ let routes ~datadir ~cachedir ~configdir =
Views.Builds.make jobs |> string_of_html |> Dream.html |> Lwt_result.ok Views.Builds.make jobs |> string_of_html |> Dream.html |> Lwt_result.ok
in 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 req =
let job_name = Dream.param req "job" in 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.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 -> Dream.sql req (Model.builds_grouped_by_output job_id platform) >|= fun builds ->
(readme, builds)) (readme, builds, platforms))
|> if_error "Error getting job" |> if_error "Error getting job"
~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e)) ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
>>= fun (readme, builds) -> >>= fun (readme, builds, platforms) ->
Views.Job.make ~failed:false ~job_name ~platform ~readme builds Views.Job.make ~failed:false ~job_name ~platform ~platforms ~readme builds
|> string_of_html |> Dream.html |> Lwt_result.ok |> string_of_html |> Dream.html |> Lwt_result.ok
in in
let job_with_failed req = let job_with_failed req =
let job_name = Dream.param req "job" in 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.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 -> 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" |> if_error "Error getting job"
~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e)) ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
>>= fun (readme, builds) -> >>= fun (readme, builds, platforms) ->
Views.Job.make ~failed:true ~job_name ~platform ~readme builds Views.Job.make ~failed:true ~job_name ~platform ~platforms ~readme builds
|> string_of_html |> Dream.html |> Lwt_result.ok |> string_of_html |> Dream.html |> Lwt_result.ok
in in

View file

@ -413,10 +413,30 @@ module Job = struct
build.Builder_db.Build.result ] 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.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)); H.ul (builds |> List.map (make_build ~job_name));
let queries = let queries =
platform |> Option.map (fun p -> `Platform p) |> Option.to_list platform |> Option.map (fun p -> `Platform p) |> Option.to_list
@ -439,14 +459,15 @@ module Job = struct
H.txt "." ] 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_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 nav = `Job (job_name, platform) in
let title = Fmt.str "Job %s %a" job_name pp_platform 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 end