data-service/guix-data-service/comparison.scm

1284 lines
51 KiB
Scheme

;;; Guix Data Service -- Information about Guix over time
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (guix-data-service comparison)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (squee)
#:use-module (json)
#:use-module (guix-data-service database)
#:use-module (guix-data-service model utils)
#:use-module (guix-data-service model derivation)
#:export (derivation-differences-data
package-differences-data
package-data->package-data-vhashes
package-data-vhashes->new-packages
package-data-vhashes->removed-packages
package-data-version-changes
package-derivation-differences-data
package-derivation-data->package-derivation-data-vhashes
package-derivation-data->names-and-versions
package-derivation-data-vhash->derivations
package-derivation-data-vhash->derivations-and-build-status
package-derivation-data-changes
lint-warning-differences-data
system-test-derivations-differences-data
channel-news-differences-data))
(define (derivation-differences-data conn
base-derivation-file-name
target-derivation-file-name)
(define base-derivation
(select-derivation-by-file-name conn base-derivation-file-name))
(define target-derivation
(select-derivation-by-file-name conn target-derivation-file-name))
(define group-by-last-element
(lambda (vals)
(let ((groups (last vals)))
(cons (if (eq? (length groups) 2)
'common
(first groups))
(drop-right vals 1)))))
(define (fetch-value alist key)
(assq-ref (find (lambda (env-var)
(if (string=? key (assq-ref env-var 'key))
(assq-ref env-var 'value)
#f))
alist)
'value))
`((outputs
. ,(group-to-alist/vector
group-by-last-element
(derivation-outputs-differences-data conn
(first base-derivation)
(first target-derivation))))
(inputs
. ,(group-to-alist/vector
group-by-last-element
(derivation-inputs-differences-data conn
(first base-derivation)
(first target-derivation))))
(sources
. ,(group-to-alist/vector
group-by-last-element
(derivation-sources-differences-data conn
(first base-derivation)
(first target-derivation))))
,@(match base-derivation
((_ _ base-builder base-args base-env-vars base-system)
(match target-derivation
((_ _ target-builder target-args target-env-vars target-system)
`((system
. ,(if (string=? base-system target-system)
`((common . ,base-system))
`((base . ,base-system)
(target . ,target-system))))
(builder
. ,(if (string=? base-builder target-builder)
`((common . ,base-builder))
`((base . ,base-builder)
(target . ,target-builder))))
(arguments
. ,(if (eq? base-args target-args)
`((common . ,(list->vector base-args)))
`((base . ,(list->vector base-args))
(target . ,(list->vector target-args)))))
(environment-variables
. ,(map (lambda (key)
(let ((base-value (fetch-value base-env-vars key))
(target-value (fetch-value target-env-vars key)))
(if (and base-value target-value)
`(,key
. ,(if (string=? base-value target-value)
`((common . ,base-value))
`((base . ,base-value)
(target . ,target-value))))
(if base-value
`(,key . ((base . ,base-value)))
`(,key . ((target . ,target-value)))))))
(delete-duplicates
(map (lambda (env-var)
(assq-ref env-var 'key))
(append base-env-vars
target-env-vars))
string=?))))))))))
(define (derivation-outputs-differences-data conn
base-derivation-id
target-derivation-id)
(define query
(string-append
"
SELECT derivation_outputs.name,
derivation_output_details.path,
derivation_output_details.hash_algorithm,
derivation_output_details.hash,
derivation_output_details.recursive,
ARRAY_AGG(derivation_outputs.derivation_id) AS derivation_ids
FROM derivation_outputs
INNER JOIN derivation_output_details
ON derivation_output_details_id = derivation_output_details.id
WHERE derivation_outputs.derivation_id IN ("
(simple-format #f "~A,~A"
base-derivation-id
target-derivation-id) "
)
GROUP BY 1, 2, 3, 4, 5"))
(map (match-lambda
((output-name path hash-algorithm hash recursive
derivation_ids)
(let ((parsed-derivation-ids
(map string->number
(parse-postgresql-array-string derivation_ids))))
`((output-name . ,output-name)
(path . ,path)
,@(if (string? hash-algorithm)
`((hash-algorithm . ,hash-algorithm))
`((hash-algorithm . null)))
,@(if (string? hash)
`((hash . ,hash))
`((hash . null)))
(recursive . ,(string=? recursive "t"))
,(append (if (memq base-derivation-id
parsed-derivation-ids)
'(base)
'())
(if (memq target-derivation-id
parsed-derivation-ids)
'(target)
'()))))))
(exec-query conn query)))
(define (derivation-inputs-differences-data conn
base-derivation-id
target-derivation-id)
(define query
(string-append
"
SELECT derivations.file_name,
derivation_outputs.name,
relevant_derivation_inputs.derivation_ids
FROM derivation_outputs
INNER JOIN (
SELECT derivation_output_id,
ARRAY_AGG(derivation_id) AS derivation_ids
FROM derivation_inputs
WHERE derivation_id IN (" (simple-format #f "~A,~A"
base-derivation-id
target-derivation-id)
") GROUP BY derivation_output_id
) AS relevant_derivation_inputs
ON derivation_outputs.id = relevant_derivation_inputs.derivation_output_id
INNER JOIN derivations ON derivation_outputs.derivation_id = derivations.id
"))
(map (match-lambda
((derivation_file_name derivation_output_name
derivation_ids)
(let ((parsed-derivation-ids
(map string->number
(parse-postgresql-array-string derivation_ids))))
`((derivation_file_name . ,derivation_file_name)
(derivation_output_name . ,derivation_output_name)
,(append (if (memq base-derivation-id
parsed-derivation-ids)
'(base)
'())
(if (memq target-derivation-id
parsed-derivation-ids)
'(target)
'()))))))
(exec-query conn query)))
(define (derivation-sources-differences-data conn
base-derivation-id
target-derivation-id)
(define query
(string-append
"
SELECT derivation_source_files.store_path, ARRAY_AGG(derivation_sources.derivation_id)
FROM derivation_source_files
INNER JOIN derivation_sources
ON derivation_source_files.id = derivation_sources.derivation_source_file_id
WHERE derivation_sources.derivation_id IN (" (simple-format #f "~A,~A"
base-derivation-id
target-derivation-id)
")
GROUP BY derivation_source_files.store_path"))
(map (match-lambda
((store_path derivation_ids)
(let ((parsed-derivation-ids
(map string->number
(parse-postgresql-array-string derivation_ids))))
`((store_path . ,store_path)
,(append (if (memq base-derivation-id
parsed-derivation-ids)
'(base)
'())
(if (memq target-derivation-id
parsed-derivation-ids)
'(target)
'()))))))
(exec-query conn query)))
(define* (package-derivation-differences-data conn
base_guix_revision_id
target_guix_revision_id
#:key
(systems #f)
(targets #f)
(include-builds? #t)
(exclude-unchanged-outputs? #t)
;; Build changes are (symbols):
;; broken, fixed, still-failing,
;; still-working, unknown
(build-change 'unknown)
limit-results
after-name)
(define extra-constraints
(string-append
(if systems
(string-append
" AND systems.system IN ("
(string-join (map
(lambda (s)
(string-append "'" s "'"))
systems)
", ")
")")
"")
(if targets
(string-append
" AND package_derivations.target IN ("
(string-join (map
(lambda (s)
(string-append "'" s "'"))
targets)
", ")
")")
"")))
(define query
(string-append "
WITH base_packages AS (
SELECT packages.*, derivations.id AS derivation_id, derivations.file_name,
systems.system, package_derivations.target,
derivations_by_output_details_set.derivation_output_details_set_id
FROM packages
INNER JOIN package_derivations
ON packages.id = package_derivations.package_id
INNER JOIN systems
ON package_derivations.system_id = systems.id
INNER JOIN derivations
ON package_derivations.derivation_id = derivations.id
INNER JOIN derivations_by_output_details_set
ON derivations.id = derivations_by_output_details_set.derivation_id
WHERE package_derivations.id IN (
SELECT guix_revision_package_derivations.package_derivation_id
FROM guix_revision_package_derivations
WHERE revision_id = $1
)" extra-constraints "
), target_packages AS (
SELECT packages.*, derivations.id AS derivation_id, derivations.file_name,
systems.system, package_derivations.target,
derivations_by_output_details_set.derivation_output_details_set_id
FROM packages
INNER JOIN package_derivations
ON packages.id = package_derivations.package_id
INNER JOIN systems
ON package_derivations.system_id = systems.id
INNER JOIN derivations
ON package_derivations.derivation_id = derivations.id
INNER JOIN derivations_by_output_details_set
ON derivations.id = derivations_by_output_details_set.derivation_id
WHERE package_derivations.id IN (
SELECT guix_revision_package_derivations.package_derivation_id
FROM guix_revision_package_derivations
WHERE revision_id = $2
)" extra-constraints "
)
SELECT base_packages.name, base_packages.version,
base_packages.package_metadata_id, base_packages.file_name,
base_packages.system, base_packages.target,"
(if include-builds?
"
(
SELECT JSON_AGG(
json_build_object(
'build_server_id', builds.build_server_id,
'build_server_build_id', builds.build_server_build_id,
'status', latest_build_status.status,
'timestamp', latest_build_status.timestamp,
'build_for_equivalent_derivation',
builds.derivation_file_name != base_packages.file_name,
'potentially_blocked', EXISTS (
SELECT 1
FROM blocked_builds
WHERE blocked_derivation_output_details_set_id
= base_packages.derivation_output_details_set_id
)
)
ORDER BY latest_build_status.timestamp
)
FROM builds
INNER JOIN latest_build_status
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
base_packages.derivation_output_details_set_id
) AS base_builds,"
"")
"
target_packages.name, target_packages.version,
target_packages.package_metadata_id, target_packages.file_name,
target_packages.system, target_packages.target"
(if include-builds?
",
(
SELECT JSON_AGG(
json_build_object(
'build_server_id', builds.build_server_id,
'build_server_build_id', builds.build_server_build_id,
'status', latest_build_status.status,
'timestamp', latest_build_status.timestamp,
'build_for_equivalent_derivation',
builds.derivation_file_name != target_packages.file_name,
'potentially_blocked', EXISTS (
SELECT 1
FROM blocked_builds
WHERE blocked_derivation_output_details_set_id
= target_packages.derivation_output_details_set_id
)
)
ORDER BY latest_build_status.timestamp
)
FROM builds
INNER JOIN latest_build_status
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
target_packages.derivation_output_details_set_id
) AS target_builds"
"")
"
FROM base_packages
FULL OUTER JOIN target_packages
ON base_packages.name = target_packages.name
AND base_packages.version = target_packages.version
AND base_packages.system = target_packages.system
AND base_packages.target = target_packages.target
AND (
(
base_packages.replacement_package_id IS NULL AND
target_packages.replacement_package_id IS NULL
) OR (
base_packages.replacement_package_id IS NOT NULL AND
target_packages.replacement_package_id IS NOT NULL
)
)
WHERE
(
base_packages.id IS NULL OR
target_packages.id IS NULL OR
base_packages.file_name != target_packages.file_name
)"
(if after-name
"
AND coalesce(base_packages.name, target_packages.name) > $3"
"")
(if exclude-unchanged-outputs?
"
AND
(
(
base_packages.derivation_output_details_set_id IS NULL OR
target_packages.derivation_output_details_set_id IS NULL
) OR (
base_packages.derivation_output_details_set_id <>
target_packages.derivation_output_details_set_id
)
)
"
"")
(cond
((eq? build-change #f) "")
((eq? build-change 'unknown)
"
AND (
(
base_packages.id IS NULL OR
target_packages.id IS NULL
)
OR
(
NOT EXISTS (
SELECT 1
FROM builds
INNER JOIN latest_build_status
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
base_packages.derivation_output_details_set_id
AND (
latest_build_status.status = 'succeeded'
OR
latest_build_status.status = 'failed'
)
)
AND NOT EXISTS (
SELECT 1
FROM builds
INNER JOIN latest_build_status
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
target_packages.derivation_output_details_set_id
AND (
latest_build_status.status = 'succeeded'
OR
latest_build_status.status = 'failed'
)
)
)
)")
(else
(let ((exists-build-with-status
(lambda (base-or-target status)
(simple-format
#f
"EXISTS (
SELECT 1
FROM builds
INNER JOIN latest_build_status
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
~A_packages.derivation_output_details_set_id
AND latest_build_status.status = '~A'
)
"
base-or-target
status)))
(not-exists-build-with-status
(lambda (base-or-target status)
(simple-format
#f
"NOT EXISTS (
SELECT 1
FROM builds
INNER JOIN latest_build_status
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
~A_packages.derivation_output_details_set_id
AND latest_build_status.status = '~A'
)
"
base-or-target
status)))
(criteria
(lambda args
(string-append
"\n AND "
(string-join
args
" \nAND\n ")))))
(string-append
"
AND base_packages.id IS NOT NULL
AND target_packages.id IS NOT NULL"
(cond
((eq? build-change 'broken)
(criteria
(exists-build-with-status "base" "succeeded")
(exists-build-with-status "target" "failed")
(not-exists-build-with-status "target" "succeeded")))
((eq? build-change 'fixed)
(criteria
(exists-build-with-status "base" "failed")
(not-exists-build-with-status "base" "succeeded")
(exists-build-with-status "target" "succeeded")))
((eq? build-change 'still-failing)
(criteria
(not-exists-build-with-status "base" "succeeded")
(exists-build-with-status "base" "failed")
(not-exists-build-with-status "target" "succeeded")
(exists-build-with-status "target" "failed")))
((eq? build-change 'still-working)
(criteria
(exists-build-with-status "base" "succeeded")
(exists-build-with-status "target" "succeeded")))
(else
(error "unknown build-change-value")))))))
"
ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.version, target_packages.version"
(if limit-results
(simple-format
#f
"
LIMIT ~A"
(number->string limit-results))
"")))
(exec-query conn query `(,base_guix_revision_id
,target_guix_revision_id
,@(if after-name
(list after-name)
'()))))
(define* (package-differences-data conn
base_guix_revision_id
target_guix_revision_id)
(define query
(string-append "
WITH base_packages AS (
SELECT *
FROM packages
WHERE id IN (
SELECT package_id
FROM package_derivations
INNER JOIN guix_revision_package_derivations
ON package_derivations.id =
guix_revision_package_derivations.package_derivation_id
WHERE guix_revision_package_derivations.revision_id = $1
)
), target_packages AS (
SELECT *
FROM packages
WHERE id IN (
SELECT package_id
FROM package_derivations
INNER JOIN guix_revision_package_derivations
ON package_derivations.id =
guix_revision_package_derivations.package_derivation_id
WHERE guix_revision_package_derivations.revision_id = $2
)
)
SELECT base_packages.name, base_packages.version,
base_packages.package_metadata_id,
target_packages.name, target_packages.version,
target_packages.package_metadata_id
FROM base_packages
FULL OUTER JOIN target_packages
ON base_packages.name = target_packages.name
AND base_packages.version = target_packages.version
AND (
(
base_packages.replacement_package_id IS NULL AND
target_packages.replacement_package_id IS NULL
) OR (
base_packages.replacement_package_id IS NOT NULL AND
target_packages.replacement_package_id IS NOT NULL
)
)
WHERE
base_packages.id IS NULL OR
target_packages.id IS NULL OR
base_packages.id != target_packages.id
ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.version, target_packages.version"))
(exec-query conn query (list base_guix_revision_id target_guix_revision_id)))
(define (package-data->package-data-vhashes package-data)
(define (add-data-to-vhash data vhash)
(let ((key (first data)))
(if (or (eq? #f key)
(string-null? key))
vhash
(vhash-cons key
(drop data 1)
vhash))))
(apply values
(fold (lambda (row result)
(let-values (((base-row-part target-row-part) (split-at row 3)))
(match result
((base-package-data target-package-data)
(list (add-data-to-vhash base-row-part base-package-data)
(add-data-to-vhash target-row-part target-package-data))))))
(list vlist-null vlist-null)
package-data)))
(define (package-derivation-data->package-derivation-data-vhashes package-data)
(define (add-data-to-vhash data vhash)
(let ((key (first data)))
(if (or (eq? key #f)
(string-null? key))
vhash
(vhash-cons key
(drop data 1)
vhash))))
(apply values
(fold (lambda (row result)
(let-values (((base-row-part target-row-part) (split-at row 7)))
(match result
((base-package-data target-package-data)
(list (add-data-to-vhash base-row-part base-package-data)
(add-data-to-vhash target-row-part target-package-data))))))
(list vlist-null vlist-null)
package-data)))
(define (package-derivation-data->names-and-versions package-data)
(reverse
(pair-fold
(lambda (pair result)
(match pair
(((name . version))
(cons (cons name version)
result))
(((name1 . version1) (name2 . version2) rest ...)
(if (and (string=? name1 name2)
(string=? version1 version2))
result
(cons (cons name1 version1)
result)))))
'()
(map (match-lambda
((base-name base-version _ _ _ _ _ target-name target-version _ _ _ _ _)
(if (or (and (string? base-name) (string-null? base-name))
(eq? base-name #f))
(cons target-name target-version)
(cons base-name base-version))))
package-data))))
(define (package-derivation-data-vhash->derivations conn packages-vhash)
(define (vhash->derivation-ids vhash)
(vhash-fold (lambda (key value result)
(cons (third value)
result))
'()
vhash))
(let* ((derivation-ids
(vhash->derivation-ids packages-vhash))
(derivation-data
(select-derivations-by-id conn derivation-ids)))
derivation-data))
(define (package-derivation-data-vhash->derivations-and-build-status
conn
package-derivation-data-vhash
systems
targets
build-statuses)
(define (vhash->derivation-file-names vhash)
(vhash-fold (lambda (key value result)
(cons (third value)
result))
'()
vhash))
(let* ((derivation-file-names
(vhash->derivation-file-names package-derivation-data-vhash)))
(if (null? derivation-file-names)
'()
(select-derivations-and-build-status
conn
#:file-names derivation-file-names
#:systems (if (null? systems) #f systems)
#:targets (if (null? targets) #f targets)
#:build-statuses (if (null? build-statuses) #f build-statuses)))))
(define (package-data-vhash->package-name-and-version-hash-table vhash)
(vhash-fold (lambda (name details result)
(let ((key (cons name (first details))))
(hash-set! result
key
(cons (cdr details)
(or (hash-ref result key)
'())))
result))
(make-hash-table)
vhash))
(define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash)
(hash-map->list
(match-lambda*
(((name . version) metadata ...)
`((name . ,name)
(version . ,version))))
(package-data-vhash->package-name-and-version-hash-table
(vlist-filter (match-lambda
((name . details)
(not (vhash-assoc name base-packages-vhash))))
target-packages-vhash))))
(define (package-data-vhashes->removed-packages base-packages-vhash target-packages-vhash)
(hash-map->list
(match-lambda*
(((name . version) metadata ...)
`((name . ,name)
(version . ,version))))
(package-data-vhash->package-name-and-version-hash-table
(vlist-filter (match-lambda
((name . details)
(not (vhash-assoc name target-packages-vhash))))
base-packages-vhash))))
(define (package-data-vhash->package-versions-hash-table package-data-vhash)
(vhash-fold (lambda (name details result)
(let ((version (first details))
(known-versions (or (hash-ref result name)
'())))
(hash-set! result
name
(cons version known-versions))
result))
(make-hash-table)
package-data-vhash))
(define (package-data-version-changes base-packages-vhash target-packages-vhash)
(let ((base-versions
(package-data-vhash->package-versions-hash-table
base-packages-vhash))
(target-versions
(package-data-vhash->package-versions-hash-table
target-packages-vhash)))
(hash-fold (lambda (name target-versions result)
(let ((base-versions (hash-ref base-versions name)))
(if base-versions
(let ((base-version-numbers base-versions)
(target-version-numbers target-versions))
(if (equal? base-version-numbers target-version-numbers)
result
(cons
`(,name . ((base . ,(list->vector base-version-numbers))
(target . ,(list->vector target-version-numbers))))
result)))
result)))
'()
target-versions)))
(define (package-derivation-data-changes names-and-versions
base-packages-vhash
target-packages-vhash)
(define base-package-details-by-name-and-version
(package-data-vhash->package-name-and-version-hash-table base-packages-vhash))
(define target-package-details-by-name-and-version
(package-data-vhash->package-name-and-version-hash-table target-packages-vhash))
(define (derivation-system-and-target-list->alist lst)
(if (null? lst)
'()
`(,(match (first lst)
((derivation-file-name system target builds)
`((system . ,system)
(target . ,target)
(derivation-file-name . ,derivation-file-name)
(builds . ,(if (or (and (string? builds)
(string-null? builds))
(eq? #f builds))
#()
(json-string->scm builds))))))
,@(derivation-system-and-target-list->alist (cdr lst)))))
(list->vector
(filter-map
(lambda (name-and-version)
(let ((base-packages-entry
(hash-ref base-package-details-by-name-and-version
name-and-version))
(target-packages-entry
(hash-ref target-package-details-by-name-and-version
name-and-version)))
(cond
((and base-packages-entry target-packages-entry)
(let ((base-derivations (map cdr base-packages-entry))
(target-derivations (map cdr target-packages-entry)))
(if (equal? base-derivations target-derivations)
#f
`((name . ,(car name-and-version))
(version . ,(cdr name-and-version))
(base . ,(list->vector
(derivation-system-and-target-list->alist
base-derivations)))
(target . ,(list->vector
(derivation-system-and-target-list->alist
target-derivations)))))))
(base-packages-entry
(let ((base-derivations (map cdr base-packages-entry)))
`((name . ,(car name-and-version))
(version . ,(cdr name-and-version))
(base . ,(list->vector
(derivation-system-and-target-list->alist
base-derivations)))
(target . ,(list->vector '())))))
(else
(let ((target-derivations (map cdr target-packages-entry)))
`((name . ,(car name-and-version))
(version . ,(cdr name-and-version))
(base . ,(list->vector '()))
(target . ,(list->vector
(derivation-system-and-target-list->alist
target-derivations)))))))))
names-and-versions)))
(define* (lint-warning-differences-data conn
base-guix-revision-id
target-guix-revision-id
locale)
(define query
(string-append "
WITH base_lint_warnings AS (
SELECT DISTINCT ON (lint_warnings.id) lint_warnings.id,
packages.name, packages.version,
lint_checkers.name AS lint_checker_name,
translated_lint_checker_descriptions.description AS lint_checker_description,
lint_checkers.network_dependent AS lint_checker_network_dependent,
locations.file, locations.line, locations.column_number,
lint_warning_messages.message,
lint_warning_messages.locale AS lint_warning_messages_locale,
translated_lint_checker_descriptions.locale AS lint_checker_descriptions_locale
FROM lint_warnings
INNER JOIN packages
ON lint_warnings.package_id = packages.id
INNER JOIN lint_checkers
ON lint_warnings.lint_checker_id = lint_checkers.id
INNER JOIN (
SELECT DISTINCT ON(lint_checkers.id) lint_checkers.id AS lint_checker_id,
lint_checker_descriptions.description,
lint_checker_descriptions.locale
FROM lint_checkers
INNER JOIN lint_checker_description_sets
ON lint_checker_description_sets.id = lint_checkers.lint_checker_description_set_id
INNER JOIN lint_checker_descriptions
ON lint_checker_descriptions.id = ANY (lint_checker_description_sets.description_ids)
INNER JOIN guix_revision_lint_checkers
ON lint_checkers.id = guix_revision_lint_checkers.lint_checker_id
AND guix_revision_lint_checkers.guix_revision_id = $1
ORDER BY lint_checkers.id,
CASE
WHEN lint_checker_descriptions.locale = $3 THEN 2
WHEN lint_checker_descriptions.locale = 'en_US.UTF-8' THEN 1
ELSE 0
END DESC
) AS translated_lint_checker_descriptions
ON translated_lint_checker_descriptions.lint_checker_id = lint_checkers.id
INNER JOIN locations
ON lint_warnings.location_id = locations.id
INNER JOIN lint_warning_message_sets
ON lint_warnings.lint_warning_message_set_id = lint_warning_message_sets.id
INNER JOIN lint_warning_messages
ON lint_warning_messages.id = ANY (lint_warning_message_sets.message_ids)
WHERE lint_warnings.id IN (
SELECT lint_warning_id
FROM guix_revision_lint_warnings
WHERE guix_revision_id = $1
)
ORDER BY lint_warnings.id,
CASE
WHEN lint_warning_messages.locale = $3 THEN 2
WHEN lint_warning_messages.locale = 'en_US.UTF-8' THEN 1
ELSE 0 END DESC
), target_lint_warnings AS (
SELECT DISTINCT ON (lint_warnings.id) lint_warnings.id,
packages.name, packages.version,
lint_checkers.name AS lint_checker_name,
translated_lint_checker_descriptions.description AS lint_checker_description,
lint_checkers.network_dependent AS lint_checker_network_dependent,
locations.file, locations.line, locations.column_number,
lint_warning_messages.message,
translated_lint_checker_descriptions.locale AS lint_checker_descriptions_locale
FROM lint_warnings
INNER JOIN packages
ON lint_warnings.package_id = packages.id
INNER JOIN lint_checkers
ON lint_warnings.lint_checker_id = lint_checkers.id
INNER JOIN (
SELECT DISTINCT ON(lint_checkers.id) lint_checkers.id AS lint_checker_id,
lint_checker_descriptions.description description,
lint_checker_descriptions.locale
FROM lint_checkers
INNER JOIN lint_checker_description_sets
ON lint_checker_description_sets.id = lint_checkers.lint_checker_description_set_id
INNER JOIN lint_checker_descriptions
ON lint_checker_descriptions.id = ANY (lint_checker_description_sets.description_ids)
INNER JOIN guix_revision_lint_checkers
ON lint_checkers.id = guix_revision_lint_checkers.lint_checker_id
AND guix_revision_lint_checkers.guix_revision_id = $2
ORDER BY lint_checkers.id,
CASE
WHEN lint_checker_descriptions.locale = $3 THEN 2
WHEN lint_checker_descriptions.locale = 'en_US.UTF-8' THEN 1
ELSE 0
END DESC
) AS translated_lint_checker_descriptions
ON translated_lint_checker_descriptions.lint_checker_id = lint_checkers.id
INNER JOIN locations
ON lint_warnings.location_id = locations.id
INNER JOIN lint_warning_message_sets
ON lint_warnings.lint_warning_message_set_id = lint_warning_message_sets.id
INNER JOIN lint_warning_messages
ON lint_warning_messages.id = ANY (lint_warning_message_sets.message_ids)
WHERE lint_warnings.id IN (
SELECT lint_warning_id
FROM guix_revision_lint_warnings
WHERE guix_revision_id = $2
)
ORDER BY lint_warnings.id,
CASE
WHEN lint_warning_messages.locale = $3 THEN 2
WHEN lint_warning_messages.locale = 'en_US.UTF-8' THEN 1
ELSE 0 END DESC
)
SELECT coalesce(
base_lint_warnings.name,
target_lint_warnings.name
) AS package_name,
coalesce(
base_lint_warnings.version,
target_lint_warnings.version
) AS package_version,
coalesce(
base_lint_warnings.lint_checker_name,
target_lint_warnings.lint_checker_name
) AS lint_checker_name,
coalesce(
base_lint_warnings.message,
target_lint_warnings.message
) AS message,
coalesce(
base_lint_warnings.lint_checker_description,
target_lint_warnings.lint_checker_description
) AS lint_checker_description,
coalesce(
base_lint_warnings.lint_checker_network_dependent,
target_lint_warnings.lint_checker_network_dependent
) AS lint_checker_network_dependent,
coalesce(
base_lint_warnings.file,
target_lint_warnings.file
) AS file,
coalesce(
base_lint_warnings.line,
target_lint_warnings.line
) AS line,
coalesce(
base_lint_warnings.column_number,
target_lint_warnings.column_number
) AS column_number,
CASE
WHEN base_lint_warnings.name IS NULL THEN 'new'
WHEN target_lint_warnings.name IS NULL THEN 'removed'
ELSE 'moved'
END AS change
FROM base_lint_warnings
FULL OUTER JOIN target_lint_warnings
ON base_lint_warnings.name = target_lint_warnings.name
AND base_lint_warnings.lint_checker_name = target_lint_warnings.lint_checker_name
AND (
base_lint_warnings.message = target_lint_warnings.message OR
-- TODO Some lint warnings include the line number in the message, so
-- they'll appear to be altered if the package definition moves within the
-- file, therefore try replacing the line number to see if the message matches
-- that way as well
replace(base_lint_warnings.message,base_lint_warnings.line::varchar,target_lint_warnings.line::varchar) = target_lint_warnings.message
)
WHERE
(
base_lint_warnings.id IS NULL OR
target_lint_warnings.id IS NULL OR
base_lint_warnings.id != target_lint_warnings.id
) AND (
base_lint_warnings.name IS NULL OR
target_lint_warnings.name IS NULL
)
ORDER BY coalesce(base_lint_warnings.name, target_lint_warnings.name) ASC, base_lint_warnings.version, target_lint_warnings.version, change"))
(exec-query conn query
(list base-guix-revision-id
target-guix-revision-id
locale)))
(define* (system-test-derivations-differences-data conn
base_guix_revision_id
target_guix_revision_id
system)
(define query
(string-append "
WITH base_system_tests AS (
SELECT name, description,
derivations.file_name AS derivation_file_name, derivation_output_details_set_id,
locations.file, locations.line, locations.column_number
FROM guix_revision_system_test_derivations
INNER JOIN system_tests
ON guix_revision_system_test_derivations.system_test_id = system_tests.id
INNER JOIN locations
ON system_tests.location_id = locations.id
INNER JOIN derivations
ON guix_revision_system_test_derivations.derivation_id = derivations.id
INNER JOIN derivations_by_output_details_set
ON guix_revision_system_test_derivations.derivation_id = derivations_by_output_details_set.derivation_id
WHERE guix_revision_id = $1
AND guix_revision_system_test_derivations.system = $3
), target_system_tests AS (
SELECT name, description,
derivations.file_name AS derivation_file_name, derivation_output_details_set_id,
locations.file, locations.line, locations.column_number
FROM guix_revision_system_test_derivations
INNER JOIN system_tests
ON guix_revision_system_test_derivations.system_test_id = system_tests.id
INNER JOIN locations
ON system_tests.location_id = locations.id
INNER JOIN derivations
ON guix_revision_system_test_derivations.derivation_id = derivations.id
INNER JOIN derivations_by_output_details_set
ON guix_revision_system_test_derivations.derivation_id = derivations_by_output_details_set.derivation_id
WHERE guix_revision_id = $2
AND guix_revision_system_test_derivations.system = $3
)
SELECT base_system_tests.name, base_system_tests.description, base_system_tests.derivation_file_name,
base_system_tests.file, base_system_tests.line, base_system_tests.column_number,
(
SELECT JSON_AGG(
json_build_object(
'build_server_id', builds.build_server_id,
'build_server_build_id', builds.build_server_build_id,
'status', latest_build_status.status,
'timestamp', latest_build_status.timestamp,
'build_for_equivalent_derivation',
builds.derivation_file_name != base_system_tests.derivation_file_name
)
ORDER BY latest_build_status.timestamp
)
FROM builds
INNER JOIN latest_build_status
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
base_system_tests.derivation_output_details_set_id
) AS base_builds,
target_system_tests.name, target_system_tests.description, target_system_tests.derivation_file_name,
target_system_tests.file, target_system_tests.line, target_system_tests.column_number,
(
SELECT JSON_AGG(
json_build_object(
'build_server_id', builds.build_server_id,
'build_server_build_id', builds.build_server_build_id,
'status', latest_build_status.status,
'timestamp', latest_build_status.timestamp,
'build_for_equivalent_derivation',
builds.derivation_file_name != target_system_tests.derivation_file_name
)
ORDER BY latest_build_status.timestamp
)
FROM builds
INNER JOIN latest_build_status
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
target_system_tests.derivation_output_details_set_id
) AS target_builds
FROM base_system_tests
FULL OUTER JOIN target_system_tests
ON base_system_tests.name = target_system_tests.name
WHERE
base_system_tests.name IS NULL OR
target_system_tests.name IS NULL OR
base_system_tests.derivation_file_name != target_system_tests.derivation_file_name
ORDER BY coalesce(base_system_tests.name, target_system_tests.name) ASC"))
(map
(match-lambda
((base_name base_description base_derivation_file_name
base_file base_line base_column_number
base_builds
target_name target_description target_derivation_file_name
target_file target_line target_column_number
target_builds)
(define (location->alist file line column-number)
`((file . ,file)
(line . ,(string->number line))
(column_number . ,(string->number column-number))))
`((name . ,(or base_name target_name))
(description . ,(if (and (string? base_description)
(string? target_description)
(string=? base_description target_description))
base_description
`((base . ,(if (null? base_description)
'null
base_description))
(target . ,(if (null? target_description)
'null
target_description)))))
(derivation . ,(if (and (string? base_derivation_file_name)
(string? target_derivation_file_name)
(string=? base_derivation_file_name
target_derivation_file_name))
base_derivation_file_name
`((base . ,(if (null? base_derivation_file_name)
'null
base_derivation_file_name))
(target . ,(if (null? target_derivation_file_name)
'null
target_derivation_file_name)))))
(location . ,(if
(and (string? base_file)
(string? target_file)
(string=? base_file target_file)
(string=? base_line target_line)
(string=? base_column_number target_column_number))
(location->alist base_file base_line base_column_number)
`((base . ,(if (null? base_file)
'null
(location->alist
base_file
base_line
base_column_number)))
(target . ,(if (null? target_file)
'null
(location->alist
target_file
target_line
target_column_number))))))
(builds . ,(if (and (string? base_derivation_file_name)
(string? target_derivation_file_name)
(string=? base_derivation_file_name
target_derivation_file_name))
(json-string->scm base_builds)
`((base . ,(if (null? base_builds)
#()
(json-string->scm base_builds)))
(target . ,(if (null? target_builds)
#()
(json-string->scm target_builds)))))))))
(exec-query-with-null-handling
conn
query
(list base_guix_revision_id
target_guix_revision_id
system))))
(define (channel-news-differences-data conn
base-guix-revision-id
target-guix-revision-id)
(define query
"
WITH base_news_entries AS (
SELECT channel_news_entries.id,
channel_news_entries.commit,
channel_news_entries.tag,
(
SELECT JSON_AGG(ARRAY[lang,text])
FROM channel_news_entry_text
INNER JOIN channel_news_entry_titles
ON channel_news_entry_text.id = channel_news_entry_titles.channel_news_entry_text_id
WHERE channel_news_entry_titles.channel_news_entry_id = channel_news_entries.id
) AS title_text,
(
SELECT JSON_AGG(ARRAY[lang,text])
FROM channel_news_entry_text
INNER JOIN channel_news_entry_bodies
ON channel_news_entry_text.id = channel_news_entry_bodies.channel_news_entry_text_id
WHERE channel_news_entry_bodies.channel_news_entry_id = channel_news_entries.id
) AS body_text
FROM channel_news_entries
WHERE id IN (
SELECT channel_news_entry_id
FROM guix_revision_channel_news_entries
WHERE guix_revision_channel_news_entries.guix_revision_id = $1
)
), target_news_entries AS (
SELECT channel_news_entries.id,
channel_news_entries.commit,
channel_news_entries.tag,
(
SELECT JSON_AGG(ARRAY[lang,text])
FROM channel_news_entry_text
INNER JOIN channel_news_entry_titles
ON channel_news_entry_text.id = channel_news_entry_titles.channel_news_entry_text_id
WHERE channel_news_entry_titles.channel_news_entry_id = channel_news_entries.id
) AS title_text,
(
SELECT JSON_AGG(ARRAY[lang,text])
FROM channel_news_entry_text
INNER JOIN channel_news_entry_bodies
ON channel_news_entry_text.id = channel_news_entry_bodies.channel_news_entry_text_id
WHERE channel_news_entry_bodies.channel_news_entry_id = channel_news_entries.id
) AS body_text
FROM channel_news_entries
WHERE id IN (
SELECT channel_news_entry_id
FROM guix_revision_channel_news_entries
WHERE guix_revision_channel_news_entries.guix_revision_id = $2
)
)
SELECT coalesce(
base_news_entries.commit,
target_news_entries.commit
) AS commit,
coalesce(
base_news_entries.tag,
target_news_entries.tag
) AS tag,
coalesce(
base_news_entries.title_text,
target_news_entries.title_text
) AS title_text,
coalesce(
base_news_entries.body_text,
target_news_entries.body_text
) AS body_text,
CASE
WHEN base_news_entries.id IS NULL THEN 'new'
WHEN target_news_entries.id IS NULL THEN 'removed'
ELSE 'changed'
END AS change
FROM base_news_entries
FULL OUTER JOIN target_news_entries
ON base_news_entries.commit = target_news_entries.commit
WHERE (
base_news_entries.id IS NULL OR
target_news_entries.id IS NULL OR
base_news_entries.id != target_news_entries.id
)")
(map
(match-lambda
((commit tag title_text body_text change)
(list commit
tag
(map (match-lambda
(#(lang text)
(cons lang text)))
(vector->list
(json-string->scm title_text)))
(map (match-lambda
(#(lang text)
(cons lang text)))
(vector->list
(json-string->scm body_text)))
(string->symbol change))))
(exec-query-with-null-handling conn query
(list base-guix-revision-id
target-guix-revision-id))))