avoid deprecated functions from Fmt (strf is now str)

This commit is contained in:
Alain Armand 2021-10-18 14:44:19 +02:00 committed by Robur
parent c9f8a16896
commit fa1cf92702
4 changed files with 15 additions and 14 deletions

1
.gitignore vendored Normal file
View file

@ -0,0 +1 @@
_build

View file

@ -43,7 +43,7 @@ depends: [
"logs" "logs"
"cmdliner" "cmdliner"
"uri" "uri"
"fmt" "fmt" {>= "0.8.7"}
"omd" "omd"
] ]

View file

@ -126,7 +126,7 @@ let add_routes datadir =
>>= Model.not_found >>= Model.not_found
|> if_error "Error getting job" >>= fun build -> |> if_error "Error getting job" >>= fun build ->
Dream.redirect req Dream.redirect req
(Fmt.strf "/job/%s/build/%a/%s" job_name Uuidm.pp build path) (Fmt.str "/job/%s/build/%a/%s" job_name Uuidm.pp build path)
|> Lwt_result.ok |> Lwt_result.ok
in in
@ -144,7 +144,7 @@ let add_routes datadir =
Dream.sql req (Model.build_artifact_by_id main_binary) Dream.sql req (Model.build_artifact_by_id main_binary)
|> if_error "Error getting main binary" >>= fun main_binary -> |> if_error "Error getting main binary" >>= fun main_binary ->
Dream.redirect req Dream.redirect req
(Fmt.strf "/job/%s/build/%a/f/%a" job_name Uuidm.pp uuid (Fmt.str "/job/%s/build/%a/f/%a" job_name Uuidm.pp uuid
Fpath.pp main_binary.Builder_db.filepath) Fpath.pp main_binary.Builder_db.filepath)
|> Lwt_result.ok |> Lwt_result.ok
in in
@ -234,7 +234,7 @@ let add_routes datadir =
| true -> | true ->
Log.warn (fun m -> m "Build with same uuid exists: %a" pp_exec exec); Log.warn (fun m -> m "Build with same uuid exists: %a" pp_exec exec);
Dream.respond ~status:`Conflict Dream.respond ~status:`Conflict
(Fmt.strf "Build with same uuid exists: %a\n" Uuidm.pp uuid) (Fmt.str "Build with same uuid exists: %a\n" Uuidm.pp uuid)
|> Lwt_result.ok |> Lwt_result.ok
| false -> | false ->
let datadir = Dream.global datadir_global req in let datadir = Dream.global datadir_global req in
@ -256,7 +256,7 @@ let add_routes datadir =
Dream.sql req (Model.build_hash hash) >>= Model.not_found Dream.sql req (Model.build_hash hash) >>= Model.not_found
|> if_error "Internal server error" >>= fun (job_name, build) -> |> if_error "Internal server error" >>= fun (job_name, build) ->
Dream.redirect req Dream.redirect req
(Fmt.strf "/job/%s/build/%a/" job_name Uuidm.pp build.Builder_db.Build.uuid) (Fmt.str "/job/%s/build/%a/" job_name Uuidm.pp build.Builder_db.Build.uuid)
|> Lwt_result.ok |> Lwt_result.ok
in in
@ -313,7 +313,7 @@ let add_routes datadir =
| true -> | true ->
Log.warn (fun m -> m "Build %S with same uuid exists: %a" job Uuidm.pp uuid); Log.warn (fun m -> m "Build %S with same uuid exists: %a" job Uuidm.pp uuid);
Dream.respond ~status:`Conflict Dream.respond ~status:`Conflict
(Fmt.strf "Build with same uuid exists: %a\n" Uuidm.pp uuid) (Fmt.str "Build with same uuid exists: %a\n" Uuidm.pp uuid)
|> Lwt_result.ok |> Lwt_result.ok
| false -> | false ->
let datadir = Dream.global datadir_global req in let datadir = Dream.global datadir_global req in

View file

@ -2,8 +2,8 @@ open Tyxml.Html
let pp_ptime = Ptime.pp_human () let pp_ptime = Ptime.pp_human ()
let txtf fmt = Fmt.kstrf txt fmt let txtf fmt = Fmt.kstr txt fmt
let a_titlef fmt = Fmt.kstrf a_title fmt let a_titlef fmt = Fmt.kstr a_title fmt
let check_icon result = let check_icon result =
match result with match result with
@ -81,7 +81,7 @@ let toggleable ?(hidden=true) id description content =
let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath = _; sha256; size } = let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath = _; sha256; size } =
[ [
a ~a:[a_href (Fmt.strf "/job/%s/build/%a/f/%a" a ~a:[a_href (Fmt.str "/job/%s/build/%a/f/%a"
job_name job_name
Uuidm.pp build.Builder_db.Build.uuid Uuidm.pp build.Builder_db.Build.uuid
Fpath.pp filepath)] Fpath.pp filepath)]
@ -136,7 +136,7 @@ let builder section_job_map =
br (); br ();
txt (Option.value ~default:"" synopsis); txt (Option.value ~default:"" synopsis);
br (); br ();
a ~a:[a_href (Fmt.strf "job/%s/build/%a/" job_name Uuidm.pp a ~a:[a_href (Fmt.str "job/%s/build/%a/" job_name Uuidm.pp
latest_build.Builder_db.Build.uuid)] latest_build.Builder_db.Build.uuid)]
[txtf "%a" (Ptime.pp_human ()) latest_build.Builder_db.Build.start]; [txtf "%a" (Ptime.pp_human ()) latest_build.Builder_db.Build.start];
txt " "; txt " ";
@ -199,7 +199,7 @@ let job_build
= =
let delta = Ptime.diff finish start in let delta = Ptime.diff finish start in
let successful_build = match result with Builder.Exited 0 -> true | _ -> false in let successful_build = match result with Builder.Exited 0 -> true | _ -> false in
layout ~title:(Fmt.strf "Job %s %a" name pp_ptime start) layout ~title:(Fmt.str "Job %s %a" name pp_ptime start)
((h1 [txtf "Job %s" name] :: ((h1 [txtf "Job %s" name] ::
(match readme with (match readme with
| None -> [] | None -> []
@ -345,20 +345,20 @@ let compare_opam job_left job_right
(added_env, removed_env, changed_env) (added_env, removed_env, changed_env)
(added_pkgs, removed_pkgs, changed_pkgs) (added_pkgs, removed_pkgs, changed_pkgs)
(same, opam_diff, version_diff, left, right) = (same, opam_diff, version_diff, left, right) =
layout ~title:(Fmt.strf "Comparing opam switches between builds %a and %a" layout ~title:(Fmt.str "Comparing opam switches between builds %a and %a"
Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid) Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid)
([ ([
h1 [txt "Comparing opam switches"]; h1 [txt "Comparing opam switches"];
h2 [ h2 [
txt "Builds "; txt "Builds ";
a ~a:[a_href a ~a:[a_href
(Fmt.strf "/job/%s/build/%a/" (Fmt.str "/job/%s/build/%a/"
job_left job_left
Uuidm.pp build_left.uuid)] Uuidm.pp build_left.uuid)]
[txtf "%a" pp_ptime build_left.start]; [txtf "%a" pp_ptime build_left.start];
txt " and "; txt " and ";
a ~a:[a_href a ~a:[a_href
(Fmt.strf "/job/%s/build/%a/" (Fmt.str "/job/%s/build/%a/"
job_right job_right
Uuidm.pp build_right.uuid)] Uuidm.pp build_right.uuid)]
[txtf "%a" pp_ptime build_right.start]; [txtf "%a" pp_ptime build_right.start];