diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 2 | ||||
| -rw-r--r-- | guix-data-service/model/package.scm | 12 | ||||
| -rw-r--r-- | guix-data-service/utils.scm | 16 | ||||
| -rw-r--r-- | guix-data-service/web/revision/controller.scm | 19 | ||||
| -rw-r--r-- | guix-data-service/web/revision/html.scm | 7 |
5 files changed, 35 insertions, 21 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 5c2744c..d821157 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -1485,7 +1485,7 @@ (match-lambda ((system . target) (let loop ((wal-bytes (stat:size (stat "/var/guix/db/db.sqlite-wal")))) - (when (> wal-bytes 200000000) + (when (> wal-bytes (* 2048 (expt 2 20))) (simple-format #t "debug: guix-daemon WAL is large (~A), waiting\n" wal-bytes) diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm index 7ec2b09..8d62ef3 100644 --- a/guix-data-service/model/package.scm +++ b/guix-data-service/model/package.scm @@ -65,7 +65,9 @@ JOIN (VALUES " (define query (string-append " WITH data AS ( - SELECT packages.name, packages.version, translated_package_synopsis.synopsis, + SELECT packages.name, packages.version, + packages.replacement_package_id IS NOT NULL, + translated_package_synopsis.synopsis, translated_package_synopsis.locale, translated_package_descriptions.description, translated_package_descriptions.locale, package_metadata.home_page, locations.file, locations.line, locations.column_number, @@ -165,7 +167,9 @@ WITH revision_packages AS ( SELECT DISTINCT ON (packages.name, packages.version, packages.replacement_package_id) packages.name, - packages.version, package_synopsis.synopsis, + packages.version, + packages.replacement_package_id IS NOT NULL AS has_replacement, + package_synopsis.synopsis, package_synopsis.locale AS synopsis_locale, package_descriptions.description, package_descriptions.locale AS description_locale, @@ -203,7 +207,7 @@ WITH revision_packages AS ( ELSE 0 END DESC ) -SELECT name, version, synopsis, synopsis_locale, +SELECT name, version, has_replacement, synopsis, synopsis_locale, description, description_locale, home_page, file, line, column_number, licenses FROM search_results @@ -538,7 +542,7 @@ ORDER BY first_datetime DESC, package_version DESC") (define (any-package-synopsis-or-descriptions-translations? packages locale) (any (match-lambda - ((name version synopsis synopsis-locale description description-locale _ _ _ _ _) + ((name version has-replacement? synopsis synopsis-locale description description-locale _ _ _ _ _) (or (string=? synopsis-locale locale) (string=? description-locale locale)))) packages)) diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm index d01fb5c..a9e8f39 100644 --- a/guix-data-service/utils.scm +++ b/guix-data-service/utils.scm @@ -244,13 +244,15 @@ (waiters . ,(length waiters)) (checkout-failure-count . ,checkout-failure-count)))) - (perform-operation - (choice-operation - (wrap-operation - (put-operation reply stats) - (const #t)) - (wrap-operation (sleep-operation 0.2) - (const #f))))) + (spawn-fiber + (lambda () + (perform-operation + (choice-operation + (wrap-operation + (put-operation reply stats) + (const #t)) + (wrap-operation (sleep-operation 1) + (const #f))))))) (loop resources available diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm index d4b741f..114e9f4 100644 --- a/guix-data-service/web/revision/controller.scm +++ b/guix-data-service/web/revision/controller.scm @@ -175,12 +175,14 @@ (let ((parsed-query-parameters (parse-query-parameters request - `((locale ,identity #:default "en_US.UTF-8"))))) + `((locale ,identity #:default "en_US.UTF-8") + (has_replacement ,parse-checkbox-value + #:default #f))))) (render-revision-package-version mime-types - commit-hash - name - version - parsed-query-parameters)) + commit-hash + name + version + parsed-query-parameters)) (render-unprocessed-revision mime-types commit-hash))) (('GET "revision" commit-hash "package-derivations") @@ -762,7 +764,7 @@ (packages . ,(list->vector (map (match-lambda - ((name version synopsis synopsis-locale description description-locale home-page + ((name version has-replacement? synopsis synopsis-locale description description-locale home-page location-file location-line location-column-number licenses) `((name . ,name) @@ -918,6 +920,8 @@ (define locale (assq-ref query-parameters 'locale)) + (define has-replacement? (assq-ref query-parameters 'has_replacement)) + (letpar& ((metadata (with-resource-from-pool (connection-pool) conn (select-package-metadata-by-revision-name-and-version @@ -925,7 +929,8 @@ commit-hash name version - locale))) + locale + #:replacement? has-replacement?))) (derivations (with-resource-from-pool (connection-pool) conn (map diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm index 6081c69..0b9d4f5 100644 --- a/guix-data-service/web/revision/html.scm +++ b/guix-data-service/web/revision/html.scm @@ -658,7 +658,7 @@ ,@(let ((fields (assq-ref query-parameters 'field))) (map (match-lambda - ((name version synopsis synopsis-locale description description-locale home-page + ((name version has-replacement? synopsis synopsis-locale description description-locale home-page location-file location-line location-column-number licenses) `(tr @@ -725,7 +725,10 @@ (a (@ (href ,(string-append (string-drop-right path-base 1) "/" name "/" version - "?locale=" (assoc-ref query-parameters 'locale)))) + "?locale=" (assoc-ref query-parameters 'locale) + (if (string=? has-replacement? "t") + "&has_replacement=on" + "")))) "More information"))))) packages)))))) ,@(if show-next-page? |