293 lines
8.1 KiB
Scheme
293 lines
8.1 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 model guix-revision-package-derivation)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (ice-9 threads)
|
|
#:use-module (squee)
|
|
#:use-module (guix-data-service database)
|
|
#:export (insert-guix-revision-package-derivations
|
|
|
|
insert-guix-revision-package-derivation-distribution-counts
|
|
backfill-guix-revision-package-derivation-distribution-counts
|
|
|
|
get-sql-to-select-package-and-related-derivations-for-revision))
|
|
|
|
(define (insert-guix-revision-package-derivations
|
|
conn guix-revision-id package-derivation-ids)
|
|
(define insert
|
|
(string-append "INSERT INTO guix_revision_package_derivations "
|
|
"(revision_id, package_derivation_id) "
|
|
"VALUES "
|
|
(string-join (map (lambda (package-derivation-id)
|
|
(simple-format
|
|
#f "(~A, ~A)"
|
|
guix-revision-id
|
|
package-derivation-id))
|
|
package-derivation-ids)
|
|
", ")
|
|
";"))
|
|
|
|
(exec-query conn insert))
|
|
|
|
(define (insert-guix-revision-package-derivation-distribution-counts
|
|
conn
|
|
guix-revision-id)
|
|
(define system-ids-and-targets
|
|
(exec-query
|
|
conn
|
|
"
|
|
SELECT DISTINCT system_id, target
|
|
FROM package_derivations
|
|
INNER JOIN guix_revision_package_derivations
|
|
ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
|
|
WHERE revision_id = $1"
|
|
(list guix-revision-id)))
|
|
|
|
(define (get-count-for-next-level system target level-counts)
|
|
(define next-level
|
|
(length level-counts))
|
|
|
|
(define query
|
|
(string-append
|
|
(simple-format
|
|
#f
|
|
"
|
|
WITH l0 AS (
|
|
SELECT derivation_id
|
|
FROM package_derivations
|
|
INNER JOIN guix_revision_package_derivations
|
|
ON package_derivations.id
|
|
= guix_revision_package_derivations.package_derivation_id
|
|
WHERE revision_id = 19411
|
|
AND system_id = 4
|
|
AND target = $STR$$STR$~A
|
|
)"
|
|
(if (= next-level 0)
|
|
""
|
|
(simple-format
|
|
#f
|
|
"
|
|
LIMIT ~A"
|
|
(car level-counts))))
|
|
(if (= next-level 0)
|
|
""
|
|
(string-join
|
|
(map
|
|
(match-lambda*
|
|
((level count)
|
|
(simple-format
|
|
#f
|
|
", l~A AS (
|
|
(
|
|
SELECT derivation_outputs.derivation_id
|
|
FROM derivation_outputs WHERE derivation_outputs.id IN (
|
|
SELECT DISTINCT derivation_inputs.derivation_output_id
|
|
FROM l~A
|
|
INNER JOIN derivation_inputs
|
|
ON l~A.derivation_id = derivation_inputs.derivation_id
|
|
)
|
|
) EXCEPT (~A
|
|
)~A
|
|
)"
|
|
level
|
|
(- level 1)
|
|
(- level 1)
|
|
(string-join
|
|
(map
|
|
(lambda (level)
|
|
(simple-format
|
|
#f
|
|
" SELECT derivation_id FROM l~A"
|
|
level))
|
|
(iota level))
|
|
"
|
|
UNION ALL")
|
|
(if count
|
|
(simple-format
|
|
#f
|
|
"
|
|
LIMIT ~A"
|
|
count)
|
|
""))))
|
|
(iota (length level-counts) 1)
|
|
(append (cdr level-counts) '(#f)))
|
|
""))
|
|
(simple-format
|
|
#f
|
|
"
|
|
SELECT COUNT(*) FROM l~A"
|
|
(length level-counts))))
|
|
|
|
(string->number
|
|
(caar
|
|
(exec-query
|
|
conn
|
|
query))))
|
|
|
|
(define (insert-level-count system-id target level count)
|
|
(exec-query
|
|
conn
|
|
"
|
|
INSERT INTO guix_revision_package_derivation_distribution_counts
|
|
VALUES ($1, $2, $3, $4, $5)"
|
|
(list guix-revision-id
|
|
system-id
|
|
target
|
|
(number->string level)
|
|
(number->string count))))
|
|
|
|
(for-each
|
|
(match-lambda
|
|
((system-id target)
|
|
|
|
(let loop ((level-counts '()))
|
|
(let ((level (length level-counts))
|
|
(count (get-count-for-next-level system-id target level-counts)))
|
|
(unless (= count 0)
|
|
(insert-level-count system-id target level count)
|
|
(loop (append level-counts (list count))))))))
|
|
system-ids-and-targets))
|
|
|
|
(define (backfill-guix-revision-package-derivation-distribution-counts)
|
|
(define revision-ids
|
|
(with-thread-postgresql-connection
|
|
(lambda (conn)
|
|
(map
|
|
car
|
|
(exec-query
|
|
conn
|
|
"
|
|
SELECT id
|
|
FROM guix_revisions
|
|
EXCEPT
|
|
SELECT guix_revision_id
|
|
FROM guix_revision_package_derivation_distribution_counts
|
|
ORDER BY id DESC")))))
|
|
|
|
(n-par-for-each
|
|
4
|
|
(lambda (revision-id)
|
|
(simple-format #t "backfilling guix_revision_package_derivation_distribution_counts for revision ~A\n" revision-id)
|
|
(with-thread-postgresql-connection
|
|
(lambda (conn)
|
|
(with-postgresql-transaction
|
|
conn
|
|
(lambda (conn)
|
|
(insert-guix-revision-package-derivation-distribution-counts
|
|
conn
|
|
revision-id))))))
|
|
revision-ids))
|
|
|
|
(define* (get-sql-to-select-package-and-related-derivations-for-revision
|
|
conn
|
|
guix-revision-id
|
|
#:key system-id target)
|
|
(define level-counts
|
|
(map
|
|
(match-lambda
|
|
((level count)
|
|
(list
|
|
(string->number level)
|
|
(string->number count))))
|
|
(exec-query
|
|
conn
|
|
"
|
|
SELECT level, distinct_derivations
|
|
FROM guix_revision_package_derivation_distribution_counts
|
|
WHERE guix_revision_id = $1
|
|
AND system_id = $2
|
|
AND target = $3
|
|
ORDER BY level ASC"
|
|
(list guix-revision-id
|
|
(number->string system-id)
|
|
target))))
|
|
|
|
(define (query level-counts)
|
|
(string-append
|
|
(simple-format
|
|
#f
|
|
"
|
|
WITH l0 AS (
|
|
SELECT derivation_id
|
|
FROM package_derivations
|
|
INNER JOIN guix_revision_package_derivations
|
|
ON package_derivations.id
|
|
= guix_revision_package_derivations.package_derivation_id
|
|
WHERE revision_id = ~A
|
|
AND system_id = ~A
|
|
AND target = $STR$~A$STR$
|
|
LIMIT ~A
|
|
)"
|
|
guix-revision-id
|
|
system-id
|
|
target
|
|
(cdr (car level-counts)))
|
|
(string-join
|
|
(map
|
|
(match-lambda*
|
|
((level count)
|
|
(simple-format
|
|
#f
|
|
", l~A AS (
|
|
(
|
|
SELECT derivation_outputs.derivation_id
|
|
FROM derivation_outputs WHERE derivation_outputs.id IN (
|
|
SELECT DISTINCT derivation_inputs.derivation_output_id
|
|
FROM l~A
|
|
INNER JOIN derivation_inputs
|
|
ON l~A.derivation_id = derivation_inputs.derivation_id
|
|
)
|
|
) EXCEPT (~A
|
|
)~A
|
|
)"
|
|
level
|
|
(- level 1)
|
|
(- level 1)
|
|
(string-join
|
|
(map
|
|
(lambda (level)
|
|
(simple-format
|
|
#f
|
|
" SELECT derivation_id FROM l~A"
|
|
level))
|
|
(iota level))
|
|
"
|
|
UNION ALL")
|
|
(simple-format
|
|
#f
|
|
"
|
|
LIMIT ~A"
|
|
count))))
|
|
(iota (- (length level-counts) 1) 1)
|
|
(cdr (map cdr level-counts)))
|
|
"")
|
|
", all_derivations AS (
|
|
SELECT *
|
|
FROM l0"
|
|
(string-join
|
|
(map (lambda (level)
|
|
(simple-format #f " UNION (SELECT * FROM l~A)" level))
|
|
(iota (- (length level-counts) 1) 1))
|
|
"\n")
|
|
"
|
|
)"))
|
|
|
|
(if level-counts
|
|
(query level-counts)
|
|
#f))
|