From 8b49884816c51593e6cd87b661a16f25b7f3e94a Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 15 Dec 2024 19:08:28 +0000 Subject: Use knots A library of extracted Guile Fibers patterns and utilities. --- guix-data-service/web/compare/controller.scm | 38 +++++++++++++++------------- 1 file changed, 20 insertions(+), 18 deletions(-) (limited to 'guix-data-service/web/compare') diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index e1fab78..dbb4975 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -24,6 +24,8 @@ #:use-module (texinfo) #:use-module (texinfo html) #:use-module (texinfo plain-text) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service web sxml) @@ -229,7 +231,7 @@ (define (render-compare mime-types query-parameters) (if (any-invalid-query-parameters? query-parameters) - (letpar& ((base-job + (fibers-let ((base-job (match (assq-ref query-parameters 'base_commit) (($ value) (with-resource-from-pool (connection-pool) conn @@ -275,7 +277,7 @@ #f #f #f))))) - (letpar& ((base-revision-id + (fibers-let ((base-revision-id (with-resource-from-pool (connection-pool) conn (commit->revision-id conn @@ -303,7 +305,7 @@ (version-changes (package-data-version-changes base-packages-vhash target-packages-vhash))) - (letpar& ((lint-warnings-data + (fibers-let ((lint-warnings-data (with-resource-from-pool (connection-pool) conn (group-list-by-first-n-fields 2 @@ -396,7 +398,7 @@ lint-warnings-data)))) #:extra-headers http-headers-for-unchanging-content)) (else - (letpar& ((lint-warnings-locale-options + (fibers-let ((lint-warnings-locale-options (map (match-lambda ((locale) @@ -449,7 +451,7 @@ (target-branch (assq-ref query-parameters 'target_branch)) (target-datetime (assq-ref query-parameters 'target_datetime)) (locale (assq-ref query-parameters 'locale))) - (letpar& ((base-revision-details + (fibers-let ((base-revision-details (with-resource-from-pool (connection-pool) conn (select-guix-revision-for-branch-and-datetime conn @@ -624,7 +626,7 @@ '(application/json text/html) mime-types) ((application/json) - (letpar& ((base-job + (fibers-let ((base-job (and=> (match (assq-ref query-parameters 'base_commit) (($ value) (and (string? value) value)) @@ -663,7 +665,7 @@ (base_job . ,base-job) (target_job . ,target-job))))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -695,7 +697,7 @@ (limit-results (assq-ref query-parameters 'limit_results))) (let ((data (concatenate! - (par-map& + (fibers-map (lambda (system) (with-resource-from-pool (connection-pool) conn (package-derivation-differences-data @@ -734,7 +736,7 @@ . ,derivation-changes)) #:stream? #t)) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -788,7 +790,7 @@ string->symbol)) (after-name (assq-ref query-parameters 'after_name)) (limit-results (assq-ref query-parameters 'limit_results))) - (letpar& + (fibers-let ((base-revision-details (with-resource-from-pool (connection-pool) conn (select-guix-revision-for-branch-and-datetime conn @@ -800,7 +802,7 @@ target-branch target-datetime)))) (let ((data - (par-map& + (fibers-map (lambda (system) (with-resource-from-pool (connection-pool) conn (package-derivation-differences-data @@ -875,7 +877,7 @@ (render-json '((error . "invalid query")))) (else - (letpar& ((base-job + (fibers-let ((base-job (match (assq-ref query-parameters 'base_commit) (($ value) (with-resource-from-pool (connection-pool) conn @@ -895,7 +897,7 @@ (let ((base-commit (assq-ref query-parameters 'base_commit)) (target-commit (assq-ref query-parameters 'target_commit))) - (letpar& ((base-revision-id + (fibers-let ((base-revision-id (with-resource-from-pool (connection-pool) conn (commit->revision-id conn @@ -944,7 +946,7 @@ (render-json '((error . "invalid query")))) (else - (letpar& ((systems + (fibers-let ((systems (with-resource-from-pool (connection-pool) conn list-systems)) (build-server-urls @@ -963,7 +965,7 @@ (let ((base-commit (assq-ref query-parameters 'base_commit)) (target-commit (assq-ref query-parameters 'target_commit)) (system (assq-ref query-parameters 'system))) - (letpar& ((data + (fibers-let ((data (with-resource-from-pool (connection-pool) conn (system-test-derivations-differences-data conn @@ -1014,7 +1016,7 @@ (render-json '((error . "invalid query")))) (else - (letpar& ((systems + (fibers-let ((systems (with-resource-from-pool (connection-pool) conn list-systems)) (build-server-urls @@ -1035,7 +1037,7 @@ (target-branch (assq-ref query-parameters 'target_branch)) (target-datetime (assq-ref query-parameters 'target_datetime)) (system (assq-ref query-parameters 'system))) - (letpar& + (fibers-let ((base-revision-details (with-resource-from-pool (connection-pool) conn (select-guix-revision-for-branch-and-datetime conn @@ -1046,7 +1048,7 @@ (select-guix-revision-for-branch-and-datetime conn target-branch target-datetime)))) - (letpar& ((data + (fibers-let ((data (with-resource-from-pool (connection-pool) conn (system-test-derivations-differences-data conn -- cgit v1.2.3