cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Re-indent fibers-let bits

Browse source
This commit is contained in:
Christopher Baines 2025-07-04 10:38:37 +01:00
parent a5e9e2f6a5
commit 28d762b568
1 changed files with 130 additions and 130 deletions
Download patch file Download diff file Expand all files Collapse all files

260
guix-data-service/web/compare/controller.scm
View file

@ -236,19 +236,19 @@
query-parameters) query-parameters)
(if (any-invalid-query-parameters? query-parameters) (if (any-invalid-query-parameters? query-parameters)
(fibers-let ((base-job (fibers-let ((base-job
(match (assq-ref query-parameters 'base_commit) (match (assq-ref query-parameters 'base_commit)
(($ <invalid-query-parameter> value) (($ <invalid-query-parameter> value)
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(and (string? value) (and (string? value)
(select-job-for-commit conn value)))) (select-job-for-commit conn value))))
(_ #f))) (_ #f)))
(target-job (target-job
(match (assq-ref query-parameters 'target_commit) (match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value) (($ <invalid-query-parameter> value)
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(and (string? value) (and (string? value)
(select-job-for-commit conn value)))) (select-job-for-commit conn value))))
(_ #f)))) (_ #f))))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
@ -282,17 +282,17 @@
#f #f
#f))))) #f)))))
(fibers-let ((base-revision-id (fibers-let ((base-revision-id
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(commit->revision-id (commit->revision-id
conn conn
(assq-ref query-parameters 'base_commit)))) (assq-ref query-parameters 'base_commit))))
(target-revision-id (target-revision-id
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(commit->revision-id (commit->revision-id
conn conn
(assq-ref query-parameters 'target_commit)))) (assq-ref query-parameters 'target_commit))))
(locale (locale
(assq-ref query-parameters 'locale))) (assq-ref query-parameters 'locale)))
(let-values (let-values
(((base-packages-vhash target-packages-vhash) (((base-packages-vhash target-packages-vhash)
(package-data->package-data-vhashes (package-data->package-data-vhashes
@ -493,17 +493,17 @@
(target-datetime (assq-ref query-parameters 'target_datetime)) (target-datetime (assq-ref query-parameters 'target_datetime))
(locale (assq-ref query-parameters 'locale))) (locale (assq-ref query-parameters 'locale)))
(fibers-let ((base-revision-details (fibers-let ((base-revision-details
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-guix-revision-for-branch-and-datetime (select-guix-revision-for-branch-and-datetime
conn conn
base-branch base-branch
base-datetime))) base-datetime)))
(target-revision-details (target-revision-details
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-guix-revision-for-branch-and-datetime (select-guix-revision-for-branch-and-datetime
conn conn
target-branch target-branch
target-datetime)))) target-datetime))))
(let ((lint-warnings-locale-options (let ((lint-warnings-locale-options
(map (map
(match-lambda (match-lambda
@ -668,23 +668,23 @@
mime-types) mime-types)
((application/json) ((application/json)
(fibers-let ((base-job (fibers-let ((base-job
(and=> (match (assq-ref query-parameters 'base_commit) (and=> (match (assq-ref query-parameters 'base_commit)
(($ <invalid-query-parameter> value) (($ <invalid-query-parameter> value)
(and (string? value) value)) (and (string? value) value))
((? string? value) value) ((? string? value) value)
(_ #f)) (_ #f))
(lambda (commit) (lambda (commit)
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-job-for-commit conn commit))))) (select-job-for-commit conn commit)))))
(target-job (target-job
(and=> (match (assq-ref query-parameters 'target_commit) (and=> (match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value) (($ <invalid-query-parameter> value)
(and (string? value) value)) (and (string? value) value))
((? string? value) value) ((? string? value) value)
(_ #f)) (_ #f))
(lambda (commit) (lambda (commit)
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-job-for-commit conn commit)))))) (select-job-for-commit conn commit))))))
(render-json (render-json
`((error . "invalid query") `((error . "invalid query")
(query_parameters (query_parameters
@ -707,14 +707,14 @@
(target_job . ,target-job))))) (target_job . ,target-job)))))
(else (else
(fibers-let ((systems (fibers-let ((systems
(call-with-resource-from-pool (connection-pool) (call-with-resource-from-pool (connection-pool)
list-systems)) list-systems))
(targets (targets
(call-with-resource-from-pool (connection-pool) (call-with-resource-from-pool (connection-pool)
valid-targets)) valid-targets))
(build-server-urls (build-server-urls
(call-with-resource-from-pool (connection-pool) (call-with-resource-from-pool (connection-pool)
select-build-server-urls-by-id))) select-build-server-urls-by-id)))
(render-html (render-html
#:sxml (compare/package-derivations #:sxml (compare/package-derivations
query-parameters query-parameters
@ -933,17 +933,17 @@
'((error . "invalid query")))) '((error . "invalid query"))))
(else (else
(fibers-let ((base-job (fibers-let ((base-job
(match (assq-ref query-parameters 'base_commit) (match (assq-ref query-parameters 'base_commit)
(($ <invalid-query-parameter> value) (($ <invalid-query-parameter> value)
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-job-for-commit conn value))) (select-job-for-commit conn value)))
(_ #f))) (_ #f)))
(target-job (target-job
(match (assq-ref query-parameters 'target_commit) (match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value) (($ <invalid-query-parameter> value)
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-job-for-commit conn value))) (select-job-for-commit conn value)))
(_ #f)))) (_ #f))))
(render-html (render-html
#:sxml (compare-invalid-parameters #:sxml (compare-invalid-parameters
query-parameters query-parameters
@ -953,15 +953,15 @@
(let ((base-commit (assq-ref query-parameters 'base_commit)) (let ((base-commit (assq-ref query-parameters 'base_commit))
(target-commit (assq-ref query-parameters 'target_commit))) (target-commit (assq-ref query-parameters 'target_commit)))
(fibers-let ((base-revision-id (fibers-let ((base-revision-id
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(commit->revision-id (commit->revision-id
conn conn
base-commit))) base-commit)))
(target-revision-id (target-revision-id
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(commit->revision-id (commit->revision-id
conn conn
target-commit)))) target-commit))))
(let-values (let-values
(((base-packages-vhash target-packages-vhash) (((base-packages-vhash target-packages-vhash)
(package-data->package-data-vhashes (package-data->package-data-vhashes
@ -1002,11 +1002,11 @@
'((error . "invalid query")))) '((error . "invalid query"))))
(else (else
(fibers-let ((systems (fibers-let ((systems
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
list-systems)) list-systems))
(build-server-urls (build-server-urls
(call-with-resource-from-pool (connection-pool) (call-with-resource-from-pool (connection-pool)
select-build-server-urls-by-id))) select-build-server-urls-by-id)))
(render-html (render-html
#:sxml (compare/system-test-derivations #:sxml (compare/system-test-derivations
query-parameters query-parameters
@ -1021,24 +1021,24 @@
(target-commit (assq-ref query-parameters 'target_commit)) (target-commit (assq-ref query-parameters 'target_commit))
(system (assq-ref query-parameters 'system))) (system (assq-ref query-parameters 'system)))
(fibers-let ((data (fibers-let ((data
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(system-test-derivations-differences-data (system-test-derivations-differences-data
conn conn
(commit->revision-id conn base-commit) (commit->revision-id conn base-commit)
(commit->revision-id conn target-commit) (commit->revision-id conn target-commit)
system))) system)))
(build-server-urls (build-server-urls
(call-with-resource-from-pool (connection-pool) (call-with-resource-from-pool (connection-pool)
select-build-server-urls-by-id)) select-build-server-urls-by-id))
(base-git-repositories (base-git-repositories
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(git-repositories-containing-commit conn base-commit))) (git-repositories-containing-commit conn base-commit)))
(target-git-repositories (target-git-repositories
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(git-repositories-containing-commit conn target-commit))) (git-repositories-containing-commit conn target-commit)))
(systems (systems
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
list-systems))) list-systems)))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
@ -1072,11 +1072,11 @@
'((error . "invalid query")))) '((error . "invalid query"))))
(else (else
(fibers-let ((systems (fibers-let ((systems
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
list-systems)) list-systems))
(build-server-urls (build-server-urls
(call-with-resource-from-pool (connection-pool) (call-with-resource-from-pool (connection-pool)
select-build-server-urls-by-id))) select-build-server-urls-by-id)))
(render-html (render-html
#:sxml (compare/system-test-derivations #:sxml (compare/system-test-derivations
query-parameters query-parameters
@ -1104,28 +1104,28 @@
target-branch target-branch
target-datetime)))) target-datetime))))
(fibers-let ((data (fibers-let ((data
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(system-test-derivations-differences-data (system-test-derivations-differences-data
conn conn
(first base-revision-details) (first base-revision-details)
(first target-revision-details) (first target-revision-details)
system))) system)))
(build-server-urls (build-server-urls
(call-with-resource-from-pool (connection-pool) (call-with-resource-from-pool (connection-pool)
select-build-server-urls-by-id)) select-build-server-urls-by-id))
(base-git-repositories (base-git-repositories
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(git-repositories-containing-commit (git-repositories-containing-commit
conn conn
(second base-revision-details)))) (second base-revision-details))))
(target-git-repositories (target-git-repositories
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(git-repositories-containing-commit (git-repositories-containing-commit
conn conn
(second target-revision-details)))) (second target-revision-details))))
(systems (systems
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
list-systems))) list-systems)))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)