diff --git a/guix-data-service/model/package-metadata.scm b/guix-data-service/model/package-metadata.scm index 032e706..c906fa4 100644 --- a/guix-data-service/model/package-metadata.scm +++ b/guix-data-service/model/package-metadata.scm @@ -34,7 +34,10 @@ inferior-packages->package-metadata-ids inferior-packages->translated-package-descriptions-and-synopsis - package-description-and-synopsis-locale-options-guix-revision)) + package-description-and-synopsis-locale-options-guix-revision + + synopsis-counts-by-locale + description-counts-by-locale)) (define locales '("cs_CZ.utf8" @@ -434,3 +437,59 @@ WHERE packages.id IN ( ON package_derivations.id = guix_revision_package_derivations.package_derivation_id WHERE guix_revision_package_derivations.revision_id = $1" (list revision-id))) + +(define (synopsis-counts-by-locale conn revision-id) + (define synopsis-counts + " +SELECT package_synopsis.locale, COUNT(package_synopsis.synopsis) AS translated_synopsis +FROM package_synopsis_sets +INNER JOIN package_synopsis + ON package_synopsis.id = ANY (package_synopsis_sets.synopsis_ids) +WHERE package_synopsis_sets.id IN ( + SELECT package_metadata.package_synopsis_set_id + FROM packages + INNER JOIN package_derivations + ON packages.id = package_derivations.package_id + INNER JOIN guix_revision_package_derivations + ON package_derivations.id = guix_revision_package_derivations.package_derivation_id + INNER JOIN guix_revisions + ON guix_revision_package_derivations.revision_id = guix_revisions.id + INNER JOIN package_metadata + ON package_metadata.id = packages.package_metadata_id + WHERE guix_revisions.id = $1) +GROUP BY package_synopsis.locale; +") + (map + (match-lambda + ((locale synopsis-counts) + `(,locale . ,(string->number synopsis-counts)))) + (exec-query conn synopsis-counts + (list revision-id)))) + +(define (description-counts-by-locale conn revision-id) + (define description-counts + " +SELECT package_descriptions.locale, COUNT(package_descriptions.description) AS translated_description +FROM package_description_sets +INNER JOIN package_descriptions + ON package_descriptions.id = ANY (package_description_sets.description_ids) + WHERE package_description_sets.id IN ( + SELECT package_metadata.package_description_set_id + FROM packages + INNER JOIN package_derivations + ON packages.id = package_derivations.package_id + INNER JOIN guix_revision_package_derivations + ON package_derivations.id = guix_revision_package_derivations.package_derivation_id + INNER JOIN guix_revisions + ON guix_revision_package_derivations.revision_id = guix_revisions.id + INNER JOIN package_metadata + ON package_metadata.id = packages.package_metadata_id + WHERE guix_revisions.id = $1) +GROUP BY package_descriptions.locale; +") + (map + (match-lambda + ((locale description-counts) + `(,locale . ,(string->number description-counts)))) + (exec-query conn description-counts + (list revision-id)))) diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm index 5b6d1bf..5ef3451 100644 --- a/guix-data-service/web/revision/controller.scm +++ b/guix-data-service/web/revision/controller.scm @@ -147,6 +147,15 @@ (render-unknown-revision mime-types conn commit-hash))) + (('GET "revision" commit-hash "packages-translation-availability") + (if (guix-commit-exists? conn commit-hash) + (render-revision-packages-translation-availability mime-types + conn + commit-hash + #:path-base path) + (render-unknown-revision mime-types + conn + commit-hash))) (('GET "revision" commit-hash "package" name) (if (guix-commit-exists? conn commit-hash) (render-revision-package mime-types @@ -648,6 +657,41 @@ #:header-link header-link) #:extra-headers http-headers-for-unchanging-content)))))) +(define* (render-revision-packages-translation-availability mime-types + conn + commit-hash + #:key + path-base + (header-link + (string-append + "/revision/" commit-hash)) + (header-text + `("Revision " (samp ,commit-hash)))) + (let ((package-synopsis-counts + (synopsis-counts-by-locale conn + (commit->revision-id conn + commit-hash))) + (package-description-counts + (description-counts-by-locale conn + (commit->revision-id conn + commit-hash)))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + `((package-synopsis-counts . ,package-synopsis-counts) + (package-description-counts . ,package-description-counts)))) + (else + (render-html + #:sxml + (view-revision-packages-translation-availability commit-hash + package-synopsis-counts + package-description-counts + #:path-base path-base + #:header-link header-link + #:header-text header-text)))))) + (define* (render-revision-package mime-types conn commit-hash diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm index c49624d..60c6466 100644 --- a/guix-data-service/web/revision/html.scm +++ b/guix-data-service/web/revision/html.scm @@ -34,6 +34,7 @@ view-revision-package-and-version view-revision view-revision-packages + view-revision-packages-translation-availability view-revision-package-derivations view-revision-package-derivation-outputs view-revision-system-tests @@ -717,6 +718,114 @@ "Next page"))) '()))))) +(define* (view-revision-packages-translation-availability commit-hash + package-synopsis-counts + package-description-counts + #:key + path-base header-link + header-text) + (define total-package-synopsis + (assoc-ref package-synopsis-counts "en_US.utf8")) + + (define total-package-descriptions + (assoc-ref package-description-counts "en_US.utf8")) + + (assoc-remove! package-synopsis-counts "en_US.utf8") + (assoc-remove! package-description-counts "en_US.utf8") + + (define synopsis-percentages + (map + (match-lambda + ((locale . count) + (exact->inexact + (* 100 (/ (or count + 0) + total-package-synopsis))))) + package-synopsis-counts)) + + (define description-percentages + (map + (match-lambda + ((locale . count) + (exact->inexact + (* 100 (/ (or count + 0) + total-package-descriptions))))) + package-description-counts)) + + (layout + #:body + `(,(header) + (div + (@ (class "container")) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (h3 (a (@ (style "white-space: nowrap;") + (href ,header-link)) + ,@header-text))) + (div + (@ (class "col-sm-12")) + (a (@ (class "btn btn-default btn-lg pull-right") + (href ,(string-append path-base ".json"))) + "View JSON"))) + (div (@ (class "row")) + (div (@ (class "col-sm-6")) + (table (@ (class "table")) + (thead + (tr + (th (@ (scope "col")) "Locale") + (th (@ (scope "col")) "Translated Package Synopsis"))) + (tbody + ,@(map + (lambda (synopsis-locale synopsis-percentage) + `(tr + (th (@ (scope "row")) ,synopsis-locale) + (td + ,(simple-format #f "~~~A%" (inexact->exact + (round synopsis-percentage))) + (div (@ (class "progress")) + (div (@ (class "progress-bar") + (role "progressbar") + (aria-valuenow ,synopsis-percentage) + (aria-valuemin "0") + (aria-valuemax "100") + (style ,(string-append + "width: " + (number->string + synopsis-percentage) + "%;")))))))) + (map car package-synopsis-counts) + synopsis-percentages)))) + (div (@ (class "col-sm-6")) + (table (@ (class "table")) + (thead + (tr + (th (@ (scope "col")) "Locale") + (th (@ (scope "col")) "Translated Package Descriptions"))) + (tbody + ,@(map + (lambda (description-locale description-percentage) + `(tr + (th (@ (scope "row")) ,description-locale) + (td + ,(simple-format #f "~~~A%" (inexact->exact + (round description-percentage))) + (div (@ (class "progress")) + (div (@ (class "progress-bar") + (role "progressbar") + (aria-valuenow ,description-percentage) + (aria-valuemin "0") + (aria-valuemax "100") + (style ,(string-append + "width: " + (number->string + description-percentage) + "%;")))))))) + (map car package-description-counts) + description-percentages))))))))) + (define* (view-revision-system-tests commit-hash system-tests git-repositories