Make some sweeping changes to loading new revisions
Move in the direction of being able to run multiple inferior REPLs, and use some vectors rather than lists in places (maybe this is more efficient).
This commit is contained in:
Christopher Baines
parent
89782b3449
commit
f5acc60288
|
|
@ -18,6 +18,7 @@
|
|||
(define-module (guix-data-service jobs load-new-guix-revision)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-43)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 threads)
|
||||
#:use-module (ice-9 textual-ports)
|
||||
|
|
@ -457,72 +458,78 @@ WHERE job_id = $1")
|
|||
|
||||
#f)))
|
||||
|
||||
(define (all-inferior-lint-warnings inf store packages)
|
||||
(define locales
|
||||
'("cs_CZ.UTF-8"
|
||||
"da_DK.UTF-8"
|
||||
"de_DE.UTF-8"
|
||||
"eo_EO.UTF-8"
|
||||
"es_ES.UTF-8"
|
||||
"fr_FR.UTF-8"
|
||||
"hu_HU.UTF-8"
|
||||
"nl_NL.UTF-8"
|
||||
"pl_PL.UTF-8"
|
||||
"pt_BR.UTF-8"
|
||||
;;"sr_SR.UTF-8"
|
||||
"sv_SE.UTF-8"
|
||||
"vi_VN.UTF-8"
|
||||
"zh_CN.UTF-8"))
|
||||
(define locales
|
||||
'("cs_CZ.UTF-8"
|
||||
"da_DK.UTF-8"
|
||||
"de_DE.UTF-8"
|
||||
"eo_EO.UTF-8"
|
||||
"es_ES.UTF-8"
|
||||
"fr_FR.UTF-8"
|
||||
"hu_HU.UTF-8"
|
||||
"nl_NL.UTF-8"
|
||||
"pl_PL.UTF-8"
|
||||
"pt_BR.UTF-8"
|
||||
;;"sr_SR.UTF-8"
|
||||
"sv_SE.UTF-8"
|
||||
"vi_VN.UTF-8"
|
||||
"zh_CN.UTF-8"))
|
||||
|
||||
(define (cleanup-inferior inf)
|
||||
(format (current-error-port)
|
||||
"inferior heap before cleanup: ~a MiB used (~a MiB heap)~%"
|
||||
(round
|
||||
(/ (inferior-eval
|
||||
'(let ((stats (gc-stats)))
|
||||
(- (assoc-ref stats 'heap-size)
|
||||
(assoc-ref stats 'heap-free-size)))
|
||||
inf)
|
||||
(expt 2. 20)))
|
||||
(round
|
||||
(/ (inferior-eval '(assoc-ref (gc-stats) 'heap-size) inf)
|
||||
(expt 2. 20))))
|
||||
(define (inferior-lint-checkers inf)
|
||||
(and
|
||||
(or (inferior-eval '(and (resolve-module '(guix lint) #:ensure #f)
|
||||
(use-modules (guix lint))
|
||||
#t)
|
||||
inf)
|
||||
(begin
|
||||
(simple-format (current-error-port)
|
||||
"warning: no (guix lint) module found\n")
|
||||
#f))
|
||||
(inferior-eval
|
||||
`(begin
|
||||
(define (lint-descriptions-by-locale checker)
|
||||
(let* ((source-locale "en_US.UTF-8")
|
||||
(source-description
|
||||
(begin
|
||||
(setlocale LC_MESSAGES source-locale)
|
||||
(G_ (lint-checker-description checker))))
|
||||
(descriptions-by-locale
|
||||
(filter-map
|
||||
(lambda (locale)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(setlocale LC_MESSAGES locale))
|
||||
(lambda (key . args)
|
||||
(error
|
||||
(simple-format
|
||||
#f
|
||||
"error changing locale to ~A: ~A ~A"
|
||||
locale key args))))
|
||||
(let ((description
|
||||
(G_ (lint-checker-description checker))))
|
||||
(setlocale LC_MESSAGES source-locale)
|
||||
(if (string=? description source-description)
|
||||
#f
|
||||
(cons locale description))))
|
||||
(list ,@locales))))
|
||||
(cons (cons source-locale source-description)
|
||||
descriptions-by-locale)))
|
||||
|
||||
;; Clean the cached store connections, as there are caches associated with
|
||||
;; these that take up lots of memory
|
||||
(inferior-eval
|
||||
'(when (defined? '%store-table) (hash-clear! %store-table))
|
||||
inf)
|
||||
(map (lambda (checker)
|
||||
(list (lint-checker-name checker)
|
||||
(lint-descriptions-by-locale checker)
|
||||
(if (memq checker %network-dependent-checkers)
|
||||
#t
|
||||
#f)))
|
||||
%all-checkers))
|
||||
inf)))
|
||||
|
||||
(catch
|
||||
'match-error
|
||||
(lambda ()
|
||||
(inferior-eval '(invalidate-derivation-caches!) inf))
|
||||
(lambda (key . args)
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n")))
|
||||
|
||||
(inferior-eval '(gc) inf)
|
||||
|
||||
(format (current-error-port)
|
||||
"inferior heap after cleanup: ~a MiB used (~a MiB heap)~%"
|
||||
(round
|
||||
(/ (inferior-eval
|
||||
'(let ((stats (gc-stats)))
|
||||
(- (assoc-ref stats 'heap-size)
|
||||
(assoc-ref stats 'heap-free-size)))
|
||||
inf)
|
||||
(expt 2. 20)))
|
||||
(round
|
||||
(/ (inferior-eval '(assoc-ref (gc-stats) 'heap-size) inf)
|
||||
(expt 2. 20)))))
|
||||
|
||||
(define (lint-warnings-for-checker packages checker-name)
|
||||
(define (inferior-lint-warnings inf store checker-name)
|
||||
(define lint-warnings-for-checker
|
||||
`(lambda (store)
|
||||
(let* ((checker (find (lambda (checker)
|
||||
(let* ((checker-name (quote ,checker-name))
|
||||
(checker (find (lambda (checker)
|
||||
(eq? (lint-checker-name checker)
|
||||
',checker-name))
|
||||
checker-name))
|
||||
%local-checkers))
|
||||
(check (lint-checker-check checker)))
|
||||
|
||||
|
|
@ -571,98 +578,32 @@ WHERE job_id = $1")
|
|||
(cons (cons source-locale source-message)
|
||||
messages-by-locale))))
|
||||
|
||||
(filter-map
|
||||
(lambda (package-id)
|
||||
(let* ((package (hashv-ref %package-table package-id))
|
||||
(warnings
|
||||
(map process-lint-warning
|
||||
(with-exception-handler
|
||||
(lambda (exn)
|
||||
(simple-format (current-error-port)
|
||||
"exception checking ~A with ~A checker: ~A\n"
|
||||
package ',checker-name exn)
|
||||
(raise-exception exn))
|
||||
(lambda ()
|
||||
(if (and lint-checker-requires-store?-defined?
|
||||
(lint-checker-requires-store? checker))
|
||||
(vector-map
|
||||
(lambda (_ package)
|
||||
(map process-lint-warning
|
||||
(with-exception-handler
|
||||
(lambda (exn)
|
||||
(simple-format (current-error-port)
|
||||
"exception checking ~A with ~A checker: ~A\n"
|
||||
package checker-name exn)
|
||||
(raise-exception exn))
|
||||
(lambda ()
|
||||
(if (and lint-checker-requires-store?-defined?
|
||||
(lint-checker-requires-store? checker))
|
||||
|
||||
(check package #:store store)
|
||||
(check package)))
|
||||
#:unwind? #t))))
|
||||
(if (null? warnings)
|
||||
#f
|
||||
(cons package-id warnings))))
|
||||
(list ,@(map inferior-package-id packages))))))
|
||||
(check package #:store store)
|
||||
(check package)))
|
||||
#:unwind? #t)))
|
||||
gds-inferior-packages))))
|
||||
|
||||
(and
|
||||
(or (inferior-eval '(and (resolve-module '(guix lint) #:ensure #f)
|
||||
(use-modules (guix lint))
|
||||
#t)
|
||||
inf)
|
||||
(begin
|
||||
(simple-format (current-error-port)
|
||||
"warning: no (guix lint) module found\n")
|
||||
#f))
|
||||
(let ((checkers
|
||||
(inferior-eval
|
||||
`(begin
|
||||
(define (lint-descriptions-by-locale checker)
|
||||
(let* ((source-locale "en_US.UTF-8")
|
||||
(source-description
|
||||
(begin
|
||||
(setlocale LC_MESSAGES source-locale)
|
||||
(G_ (lint-checker-description checker))))
|
||||
(descriptions-by-locale
|
||||
(filter-map
|
||||
(lambda (locale)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(setlocale LC_MESSAGES locale))
|
||||
(lambda (key . args)
|
||||
(error
|
||||
(simple-format
|
||||
#f
|
||||
"error changing locale to ~A: ~A ~A"
|
||||
locale key args))))
|
||||
(let ((description
|
||||
(G_ (lint-checker-description checker))))
|
||||
(setlocale LC_MESSAGES source-locale)
|
||||
(if (string=? description source-description)
|
||||
#f
|
||||
(cons locale description))))
|
||||
(list ,@locales))))
|
||||
(cons (cons source-locale source-description)
|
||||
descriptions-by-locale)))
|
||||
(with-time-logging (simple-format #f "getting ~A lint warnings"
|
||||
checker-name)
|
||||
(inferior-eval-with-store
|
||||
inf
|
||||
store
|
||||
lint-warnings-for-checker)))
|
||||
|
||||
(map (lambda (checker)
|
||||
(list (lint-checker-name checker)
|
||||
(lint-descriptions-by-locale checker)
|
||||
(if (memq checker %network-dependent-checkers)
|
||||
#t
|
||||
#f)))
|
||||
%all-checkers))
|
||||
inf)))
|
||||
(map
|
||||
(match-lambda
|
||||
((name description network-dependent?)
|
||||
(cons
|
||||
(list name description network-dependent?)
|
||||
(if (or network-dependent?
|
||||
(eq? name 'derivation))
|
||||
'()
|
||||
(let ((warnings
|
||||
(with-time-logging (simple-format #f "getting ~A lint warnings"
|
||||
name)
|
||||
(inferior-eval-with-store
|
||||
inf
|
||||
store
|
||||
(lint-warnings-for-checker packages
|
||||
name)))))
|
||||
(cleanup-inferior inf)
|
||||
warnings)))))
|
||||
checkers))))
|
||||
|
||||
(define (all-inferior-package-derivations store inf packages)
|
||||
(define (inferior-fetch-system-target-pairs inf)
|
||||
(define inf-systems
|
||||
(inferior-guix-systems inf))
|
||||
|
||||
|
|
@ -712,8 +653,15 @@ WHERE job_id = $1")
|
|||
targets)))
|
||||
cross-derivations))
|
||||
|
||||
(append supported-system-pairs
|
||||
supported-system-cross-build-pairs))
|
||||
|
||||
(define (inferior-package-derivations store inf system target)
|
||||
(define proc
|
||||
'(lambda (store system-target-pair)
|
||||
`(lambda (store)
|
||||
(define system-target-pair
|
||||
(cons ,system ,target))
|
||||
|
||||
(define target-system-alist
|
||||
(if (defined? 'platforms (resolve-module '(guix platform)))
|
||||
(filter-map
|
||||
|
|
@ -762,7 +710,7 @@ WHERE job_id = $1")
|
|||
"error ~A: ~A\n" key args)
|
||||
#f))))
|
||||
|
||||
(define (derivation-for-system-and-target inferior-package-id package system target)
|
||||
(define (derivation-for-system-and-target package system target)
|
||||
(catch
|
||||
'misc-error
|
||||
(lambda ()
|
||||
|
|
@ -776,13 +724,10 @@ WHERE job_id = $1")
|
|||
(package-derivation store package system))))
|
||||
;; You don't always get what you ask for, so check
|
||||
(if (string=? system (derivation-system derivation))
|
||||
(list inferior-package-id
|
||||
system
|
||||
target
|
||||
(let ((file-name
|
||||
(derivation-file-name derivation)))
|
||||
(add-temp-root store file-name)
|
||||
file-name))
|
||||
(let ((file-name
|
||||
(derivation-file-name derivation)))
|
||||
(add-temp-root store file-name)
|
||||
file-name)
|
||||
(begin
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
|
|
@ -801,140 +746,96 @@ WHERE job_id = $1")
|
|||
args)
|
||||
#f)))
|
||||
|
||||
(filter-map
|
||||
(lambda (inferior-package-id)
|
||||
(let ((package (hashv-ref %package-table inferior-package-id)))
|
||||
(catch
|
||||
#t
|
||||
(lambda ()
|
||||
(let* ((system (car system-target-pair))
|
||||
(target (cdr system-target-pair))
|
||||
(supported-systems (get-supported-systems package system))
|
||||
(system-supported?
|
||||
(and supported-systems
|
||||
(->bool (member system supported-systems))))
|
||||
(target-supported?
|
||||
(or (not target)
|
||||
(let ((system-for-target
|
||||
(assoc-ref target-system-alist
|
||||
target)))
|
||||
(or (not system-for-target)
|
||||
(->bool
|
||||
(member system-for-target
|
||||
(package-supported-systems package)
|
||||
string=?)))))))
|
||||
(vector-map
|
||||
(lambda (_ package)
|
||||
(catch
|
||||
#t
|
||||
(lambda ()
|
||||
(let* ((system (car system-target-pair))
|
||||
(target (cdr system-target-pair))
|
||||
(supported-systems (get-supported-systems package system))
|
||||
(system-supported?
|
||||
(and supported-systems
|
||||
(->bool (member system supported-systems))))
|
||||
(target-supported?
|
||||
(or (not target)
|
||||
(let ((system-for-target
|
||||
(assoc-ref target-system-alist
|
||||
target)))
|
||||
(or (not system-for-target)
|
||||
(->bool
|
||||
(member system-for-target
|
||||
(package-supported-systems package)
|
||||
string=?)))))))
|
||||
|
||||
(when (string=? (package-name package) "guix")
|
||||
(when (string=? (package-name package) "guix")
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"looking at guix package (supported systems: ~A, system supported: ~A, target supported: ~A\n"
|
||||
supported-systems
|
||||
system-supported?
|
||||
target-supported?))
|
||||
|
||||
(if system-supported?
|
||||
(if target-supported?
|
||||
(derivation-for-system-and-target package
|
||||
system
|
||||
target)
|
||||
#f)
|
||||
#f)))
|
||||
(lambda (key . args)
|
||||
(if (and (eq? key 'system-error)
|
||||
(eq? (car args) 'fport_write))
|
||||
(begin
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"looking at guix package (supported systems: ~A, system supported: ~A, target supported: ~A\n"
|
||||
supported-systems
|
||||
system-supported?
|
||||
target-supported?))
|
||||
|
||||
(if system-supported?
|
||||
(if target-supported?
|
||||
(derivation-for-system-and-target inferior-package-id
|
||||
package
|
||||
system
|
||||
target)
|
||||
#f)
|
||||
#f)))
|
||||
(lambda (key . args)
|
||||
(if (and (eq? key 'system-error)
|
||||
(eq? (car args) 'fport_write))
|
||||
(begin
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"error: while processing ~A, exiting: ~A: ~A\n"
|
||||
(package-name package)
|
||||
key
|
||||
args)
|
||||
(exit 1))
|
||||
(begin
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"error: while processing ~A ignoring error: ~A: ~A\n"
|
||||
(package-name package)
|
||||
key
|
||||
args)
|
||||
#f))))))
|
||||
gds-inferior-package-ids)))
|
||||
"error: while processing ~A, exiting: ~A: ~A\n"
|
||||
(package-name package)
|
||||
key
|
||||
args)
|
||||
(exit 1))
|
||||
(begin
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"error: while processing ~A ignoring error: ~A: ~A\n"
|
||||
(package-name package)
|
||||
key
|
||||
args)
|
||||
#f)))))
|
||||
gds-inferior-packages)))
|
||||
|
||||
(inferior-eval
|
||||
'(when (defined? 'systems (resolve-module '(guix platform)))
|
||||
(use-modules (guix platform)))
|
||||
inf)
|
||||
|
||||
(inferior-eval
|
||||
`(define gds-inferior-package-ids
|
||||
(list ,@(map inferior-package-id packages)))
|
||||
inf)
|
||||
(format (current-error-port)
|
||||
"heap size: ~a MiB~%"
|
||||
(round
|
||||
(/ (assoc-ref (gc-stats) 'heap-size)
|
||||
(expt 2. 20))))
|
||||
|
||||
(inferior-eval
|
||||
`(define gds-packages-proc ,proc)
|
||||
inf)
|
||||
(catch
|
||||
'match-error
|
||||
(lambda ()
|
||||
(inferior-eval '(invalidate-derivation-caches!) inf))
|
||||
(lambda (key . args)
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n")))
|
||||
|
||||
(append-map!
|
||||
(lambda (system-target-pair)
|
||||
(format (current-error-port)
|
||||
"heap size: ~a MiB~%"
|
||||
(round
|
||||
(/ (assoc-ref (gc-stats) 'heap-size)
|
||||
(expt 2. 20))))
|
||||
;; Clean the cached store connections, as there are caches associated
|
||||
;; with these that take up lots of memory
|
||||
(inferior-eval '(when (defined? '%store-table) (hash-clear! %store-table)) inf)
|
||||
|
||||
(format (current-error-port)
|
||||
"inferior heap before cleanup: ~a MiB used (~a MiB heap)~%"
|
||||
(round
|
||||
(/ (inferior-eval
|
||||
'(let ((stats (gc-stats)))
|
||||
(- (assoc-ref stats 'heap-size)
|
||||
(assoc-ref stats 'heap-free-size)))
|
||||
inf)
|
||||
(expt 2. 20)))
|
||||
(round
|
||||
(/ (inferior-eval '(assoc-ref (gc-stats) 'heap-size) inf)
|
||||
(expt 2. 20))))
|
||||
(catch
|
||||
'match-error
|
||||
(lambda ()
|
||||
(inferior-eval '(invalidate-derivation-caches!) inf))
|
||||
(lambda (key . args)
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n")))
|
||||
(with-time-logging
|
||||
(simple-format #f "getting derivations for ~A" (cons system target))
|
||||
(inferior-eval-with-store
|
||||
inf
|
||||
store
|
||||
proc)))
|
||||
|
||||
;; Clean the cached store connections, as there are caches associated
|
||||
;; with these that take up lots of memory
|
||||
(inferior-eval '(when (defined? '%store-table) (hash-clear! %store-table)) inf)
|
||||
|
||||
(inferior-eval '(gc) inf)
|
||||
|
||||
(format (current-error-port)
|
||||
"inferior heap after cleanup: ~a MiB used (~a MiB heap)~%"
|
||||
(round
|
||||
(/ (inferior-eval
|
||||
'(let ((stats (gc-stats)))
|
||||
(- (assoc-ref stats 'heap-size)
|
||||
(assoc-ref stats 'heap-free-size)))
|
||||
inf)
|
||||
(expt 2. 20)))
|
||||
(round
|
||||
(/ (inferior-eval '(assoc-ref (gc-stats) 'heap-size) inf)
|
||||
(expt 2. 20))))
|
||||
|
||||
(with-time-logging
|
||||
(simple-format #f "getting derivations for ~A" system-target-pair)
|
||||
(inferior-eval-with-store
|
||||
inf
|
||||
store
|
||||
`(lambda (store)
|
||||
(gds-packages-proc store (cons ,(car system-target-pair)
|
||||
,(cdr system-target-pair)))))))
|
||||
(append supported-system-pairs
|
||||
supported-system-cross-build-pairs)))
|
||||
|
||||
(define (deduplicate-inferior-packages packages)
|
||||
(define (sort-and-deduplicate-inferior-packages packages)
|
||||
(pair-fold
|
||||
(lambda (pair result)
|
||||
(if (null? (cdr pair))
|
||||
|
|
@ -997,20 +898,42 @@ WHERE job_id = $1")
|
|||
;; same name and version, but different derivations. Guix will warn
|
||||
;; about this case though, generally this means only one of the
|
||||
;; packages should be exported.
|
||||
(deduplicate-inferior-packages
|
||||
(append! packages non-exported-replacements))))
|
||||
(sort-and-deduplicate-inferior-packages
|
||||
(append! packages non-exported-replacements)))
|
||||
|
||||
(deduplicated-packages-length
|
||||
(length deduplicated-packages)))
|
||||
|
||||
deduplicated-packages))
|
||||
(inferior-eval
|
||||
`(use-modules (srfi srfi-43))
|
||||
inf)
|
||||
|
||||
(inferior-eval
|
||||
`(define gds-inferior-packages
|
||||
(make-vector ,deduplicated-packages-length))
|
||||
inf)
|
||||
|
||||
(inferior-eval
|
||||
`(for-each
|
||||
(lambda (index id)
|
||||
(vector-set! gds-inferior-packages
|
||||
index
|
||||
(or (hashv-ref %package-table id)
|
||||
(error "missing package id"))))
|
||||
(iota ,deduplicated-packages-length)
|
||||
(list ,@(map inferior-package-id deduplicated-packages)))
|
||||
inf)
|
||||
|
||||
(list->vector deduplicated-packages)))
|
||||
|
||||
(define* (all-inferior-packages-data inf packages #:key (process-replacements? #t))
|
||||
(let* ((package-license-data
|
||||
(with-time-logging "fetching inferior package license metadata"
|
||||
(inferior-packages->license-data inf packages)))
|
||||
(inferior-packages->license-data inf)))
|
||||
(package-metadata
|
||||
(with-time-logging "fetching inferior package metadata"
|
||||
(map
|
||||
(lambda (package)
|
||||
(vector-map
|
||||
(lambda (_ package)
|
||||
(let ((translated-package-descriptions-and-synopsis
|
||||
(inferior-packages->translated-package-descriptions-and-synopsis
|
||||
inf package)))
|
||||
|
|
@ -1022,28 +945,31 @@ WHERE job_id = $1")
|
|||
packages)))
|
||||
(package-replacement-data
|
||||
(if process-replacements?
|
||||
(map (lambda (package)
|
||||
(let ((replacement (inferior-package-replacement package)))
|
||||
(if replacement
|
||||
;; I'm not sure if replacements can themselves be
|
||||
;; replaced, but I do know for sure that there are
|
||||
;; infinite chains of replacements (python(2)-urllib3
|
||||
;; in 7c4c781aa40c42d4cd10b8d9482199f3db345e1b for
|
||||
;; example).
|
||||
;;
|
||||
;; This code currently just capures the first level
|
||||
;; of replacements
|
||||
(first
|
||||
(all-inferior-packages-data
|
||||
inf
|
||||
(list replacement)
|
||||
#:process-replacements? #f))
|
||||
#f)))
|
||||
packages)
|
||||
(vector-map
|
||||
(lambda (_ package)
|
||||
(let ((replacement (inferior-package-replacement package)))
|
||||
(if replacement
|
||||
;; I'm not sure if replacements can themselves be
|
||||
;; replaced, but I do know for sure that there are
|
||||
;; infinite chains of replacements (python(2)-urllib3
|
||||
;; in 7c4c781aa40c42d4cd10b8d9482199f3db345e1b for
|
||||
;; example).
|
||||
;;
|
||||
;; This code currently just capures the first level
|
||||
;; of replacements
|
||||
(first
|
||||
(all-inferior-packages-data
|
||||
inf
|
||||
(vector replacement)
|
||||
#:process-replacements? #f))
|
||||
#f)))
|
||||
packages)
|
||||
#f)))
|
||||
|
||||
`((names . ,(map inferior-package-name packages))
|
||||
(versions . ,(map inferior-package-version packages))
|
||||
`((names . ,(vector-map (lambda (_ pkg) (inferior-package-name pkg))
|
||||
packages))
|
||||
(versions . ,(vector-map (lambda (_ pkg) (inferior-package-version pkg))
|
||||
packages))
|
||||
(license-data . ,package-license-data)
|
||||
(metadata . ,package-metadata)
|
||||
(replacemnets . ,package-replacement-data))))
|
||||
|
|
@ -1055,25 +981,30 @@ WHERE job_id = $1")
|
|||
conn
|
||||
(inferior-packages->license-id-lists
|
||||
conn
|
||||
(assq-ref inferior-packages-data 'license-data))))
|
||||
;; TODO Don't needlessly convert
|
||||
(vector->list
|
||||
(assq-ref inferior-packages-data 'license-data)))))
|
||||
((all-package-metadata-ids new-package-metadata-ids)
|
||||
(with-time-logging "inserting package metadata entries"
|
||||
(inferior-packages->package-metadata-ids
|
||||
conn
|
||||
(assq-ref inferior-packages-data 'metadata)
|
||||
;; TODO Don't needlessly convert
|
||||
(vector->list
|
||||
(assq-ref inferior-packages-data 'metadata))
|
||||
package-license-set-ids)))
|
||||
((replacement-ids)
|
||||
(or (and=> (assq-ref inferior-packages-data 'replacements)
|
||||
(lambda (all-replacement-data)
|
||||
(with-time-logging "inserting package replacements"
|
||||
(map (lambda (replacement-data)
|
||||
(if replacement-data
|
||||
(first
|
||||
(insert-packages conn (list replacement-data)))
|
||||
(cons "integer" NULL)))
|
||||
all-replacement-data))))
|
||||
(make-list (length package-license-set-ids)
|
||||
(cons "integer" NULL)))))
|
||||
(vector-map
|
||||
(lambda (_ replacement-data)
|
||||
(if replacement-data
|
||||
(first
|
||||
(insert-packages conn (list replacement-data)))
|
||||
(cons "integer" NULL)))
|
||||
all-replacement-data))))
|
||||
(make-vector (length package-license-set-ids)
|
||||
(cons "integer" NULL)))))
|
||||
|
||||
(unless (null? new-package-metadata-ids)
|
||||
(with-time-logging "fetching package metadata tsvector entries"
|
||||
|
|
@ -1083,75 +1014,80 @@ WHERE job_id = $1")
|
|||
(with-time-logging "getting package-ids"
|
||||
(inferior-packages->package-ids
|
||||
conn
|
||||
(zip (assq-ref inferior-packages-data 'names)
|
||||
(assq-ref inferior-packages-data 'versions)
|
||||
;; TODO Do this more efficiently
|
||||
(zip (vector->list (assq-ref inferior-packages-data 'names))
|
||||
(vector->list (assq-ref inferior-packages-data 'versions))
|
||||
all-package-metadata-ids
|
||||
replacement-ids)))))
|
||||
(vector->list replacement-ids))))))
|
||||
|
||||
(define (insert-lint-warnings conn inferior-package-id->package-database-id
|
||||
(define (insert-lint-warnings conn
|
||||
package-ids
|
||||
lint-checker-ids
|
||||
lint-warnings-data)
|
||||
(lint-warnings-data->lint-warning-ids
|
||||
conn
|
||||
(append-map
|
||||
(lambda (lint-checker-id warnings-by-package-id)
|
||||
(append-map
|
||||
(match-lambda
|
||||
((package-id . warnings)
|
||||
(map
|
||||
(match-lambda
|
||||
((location-data messages-by-locale)
|
||||
(let ((location-id
|
||||
(location->location-id
|
||||
conn
|
||||
(apply location location-data)))
|
||||
(lint-warning-message-set-id
|
||||
(lint-warning-message-data->lint-warning-message-set-id
|
||||
conn
|
||||
messages-by-locale)))
|
||||
(list lint-checker-id
|
||||
(inferior-package-id->package-database-id package-id)
|
||||
location-id
|
||||
lint-warning-message-set-id))))
|
||||
(fold (lambda (location-and-messages result)
|
||||
(if (member location-and-messages result)
|
||||
(begin
|
||||
(apply
|
||||
simple-format
|
||||
(current-error-port)
|
||||
"warning: skipping duplicate lint warning ~A ~A\n"
|
||||
location-and-messages)
|
||||
result)
|
||||
(append result
|
||||
(list location-and-messages))))
|
||||
'()
|
||||
warnings))))
|
||||
warnings-by-package-id))
|
||||
(append-map!
|
||||
(lambda (lint-checker-id warnings-per-package)
|
||||
(if warnings-per-package
|
||||
(vector-fold
|
||||
(lambda (_ result package-id warnings)
|
||||
(append!
|
||||
result
|
||||
(map
|
||||
(match-lambda
|
||||
((location-data messages-by-locale)
|
||||
(let ((location-id
|
||||
(location->location-id
|
||||
conn
|
||||
(apply location location-data)))
|
||||
(lint-warning-message-set-id
|
||||
(lint-warning-message-data->lint-warning-message-set-id
|
||||
conn
|
||||
messages-by-locale)))
|
||||
(list lint-checker-id
|
||||
package-id
|
||||
location-id
|
||||
lint-warning-message-set-id))))
|
||||
(fold (lambda (location-and-messages result)
|
||||
;; TODO Sort to delete duplicates, rather than use member
|
||||
(if (member location-and-messages result)
|
||||
(begin
|
||||
(apply
|
||||
simple-format
|
||||
(current-error-port)
|
||||
"warning: skipping duplicate lint warning ~A ~A\n"
|
||||
location-and-messages)
|
||||
result)
|
||||
(append! result
|
||||
(list location-and-messages))))
|
||||
'()
|
||||
warnings))))
|
||||
'()
|
||||
package-ids
|
||||
warnings-per-package)
|
||||
'()))
|
||||
lint-checker-ids
|
||||
(map cdr lint-warnings-data))))
|
||||
lint-warnings-data)))
|
||||
|
||||
(define (inferior-data->package-derivation-ids
|
||||
conn inf
|
||||
inferior-package-id->package-database-id
|
||||
inferior-data-4-tuples)
|
||||
(let ((derivation-ids
|
||||
(derivation-file-names->derivation-ids
|
||||
conn
|
||||
(map fourth inferior-data-4-tuples)))
|
||||
(flat-package-ids-systems-and-targets
|
||||
(map
|
||||
(match-lambda
|
||||
((inferior-package-id system target derivation-file-name)
|
||||
(list (inferior-package-id->package-database-id
|
||||
inferior-package-id)
|
||||
system
|
||||
(or target ""))))
|
||||
inferior-data-4-tuples)))
|
||||
package-ids
|
||||
inferior-packages-system-and-target-to-derivations-alist)
|
||||
(append-map!
|
||||
(lambda (data)
|
||||
(let* ((system-and-target (car data))
|
||||
(derivations-vector (cdr data))
|
||||
(derivation-ids
|
||||
(derivation-file-names->derivation-ids
|
||||
conn
|
||||
derivations-vector)))
|
||||
|
||||
|
||||
(insert-package-derivations conn
|
||||
flat-package-ids-systems-and-targets
|
||||
derivation-ids)))
|
||||
(insert-package-derivations conn
|
||||
(car system-and-target)
|
||||
(or (cdr system-and-target) "")
|
||||
package-ids
|
||||
derivation-ids)))
|
||||
inferior-packages-system-and-target-to-derivations-alist))
|
||||
|
||||
(define guix-store-path
|
||||
(let ((store-path #f))
|
||||
|
|
@ -1516,12 +1452,35 @@ WHERE job_id = $1")
|
|||
(let* ((packages
|
||||
(with-time-logging "fetching inferior packages"
|
||||
(inferior-packages-plus-replacements inf)))
|
||||
(inferior-lint-warnings
|
||||
(with-time-logging "fetching inferior lint warnings"
|
||||
(all-inferior-lint-warnings inf store packages)))
|
||||
(inferior-data-4-tuples
|
||||
(inferior-lint-checkers-data
|
||||
(inferior-lint-checkers inf))
|
||||
(inferior-lint-warnings-data
|
||||
(and inferior-lint-checkers-data
|
||||
(with-time-logging "fetching inferior lint warnings"
|
||||
(map
|
||||
(match-lambda
|
||||
((checker-name _ network-dependent?)
|
||||
(and (and (not network-dependent?)
|
||||
;; Running the derivation linter is
|
||||
;; currently infeasible
|
||||
(not (eq? checker-name 'derivation)))
|
||||
(inferior-lint-warnings inf
|
||||
store
|
||||
checker-name))))
|
||||
inferior-lint-checkers-data))))
|
||||
(inferior-system-target-pairs
|
||||
(inferior-fetch-system-target-pairs inf))
|
||||
(inferior-packages-system-and-target-to-derivations-alist
|
||||
(with-time-logging "getting inferior derivations"
|
||||
(all-inferior-package-derivations store inf packages)))
|
||||
(map
|
||||
(match-lambda
|
||||
((system . target)
|
||||
(cons (cons system target)
|
||||
(inferior-package-derivations store
|
||||
inf
|
||||
system
|
||||
target))))
|
||||
inferior-system-target-pairs)))
|
||||
(inferior-system-tests
|
||||
(if skip-system-tests?
|
||||
(begin
|
||||
|
|
@ -1544,84 +1503,70 @@ WHERE job_id = $1")
|
|||
;; avoid any concurrency issues
|
||||
(obtain-advisory-transaction-lock conn
|
||||
'load-new-guix-revision-inserts))
|
||||
(let* ((package-ids
|
||||
(insert-packages conn packages-data))
|
||||
(inferior-package-id->package-database-id
|
||||
(let ((lookup-table
|
||||
(alist->hashq-table
|
||||
(map (lambda (package package-id)
|
||||
(cons (inferior-package-id package)
|
||||
package-id))
|
||||
packages
|
||||
package-ids))))
|
||||
(lambda (inferior-id)
|
||||
(or
|
||||
(hashq-ref lookup-table inferior-id)
|
||||
(error
|
||||
(simple-format
|
||||
#f
|
||||
"error: inferior-package-id->package-database-id: ~A missing\n"
|
||||
inferior-id)))))))
|
||||
(with-time-logging
|
||||
"inserting data"
|
||||
(let* ((package-ids
|
||||
(insert-packages conn packages-data)))
|
||||
(when inferior-lint-warnings
|
||||
(let* ((lint-checker-ids
|
||||
(lint-checkers->lint-checker-ids
|
||||
conn
|
||||
(map (match-lambda
|
||||
((name descriptions-by-locale network-dependent)
|
||||
(list
|
||||
name
|
||||
network-dependent
|
||||
(lint-checker-description-data->lint-checker-description-set-id
|
||||
conn descriptions-by-locale))))
|
||||
inferior-lint-checkers-data)))
|
||||
(lint-warning-ids
|
||||
(insert-lint-warnings
|
||||
conn
|
||||
package-ids
|
||||
lint-checker-ids
|
||||
inferior-lint-warnings-data)))
|
||||
(insert-guix-revision-lint-checkers conn
|
||||
guix-revision-id
|
||||
lint-checker-ids)
|
||||
|
||||
(chunk-for-each!
|
||||
(lambda (lint-warning-ids-chunk)
|
||||
(insert-guix-revision-lint-warnings conn
|
||||
guix-revision-id
|
||||
lint-warning-ids-chunk))
|
||||
5000
|
||||
lint-warning-ids)))
|
||||
|
||||
(when inferior-lint-warnings
|
||||
(let* ((lint-checker-ids
|
||||
(lint-checkers->lint-checker-ids
|
||||
conn
|
||||
(map (match-lambda
|
||||
((name descriptions-by-locale network-dependent)
|
||||
(list
|
||||
name
|
||||
network-dependent
|
||||
(lint-checker-description-data->lint-checker-description-set-id
|
||||
conn descriptions-by-locale))))
|
||||
(map car inferior-lint-warnings))))
|
||||
(lint-warning-ids
|
||||
(insert-lint-warnings
|
||||
conn
|
||||
inferior-package-id->package-database-id
|
||||
lint-checker-ids
|
||||
inferior-lint-warnings)))
|
||||
(insert-guix-revision-lint-checkers conn
|
||||
guix-revision-id
|
||||
lint-checker-ids)
|
||||
|
||||
(chunk-for-each!
|
||||
(lambda (lint-warning-ids-chunk)
|
||||
(insert-guix-revision-lint-warnings conn
|
||||
(when inferior-system-tests
|
||||
(insert-system-tests-for-guix-revision conn
|
||||
guix-revision-id
|
||||
lint-warning-ids-chunk))
|
||||
5000
|
||||
lint-warning-ids)))
|
||||
inferior-system-tests))
|
||||
|
||||
(when inferior-system-tests
|
||||
(insert-system-tests-for-guix-revision conn
|
||||
guix-revision-id
|
||||
inferior-system-tests))
|
||||
(let* ((package-derivation-ids
|
||||
(with-time-logging "inferior-data->package-derivation-ids"
|
||||
(inferior-data->package-derivation-ids
|
||||
conn
|
||||
inf
|
||||
package-ids
|
||||
inferior-packages-system-and-target-to-derivations-alist)))
|
||||
(ids-count
|
||||
(length package-derivation-ids)))
|
||||
(chunk-for-each! (lambda (package-derivation-ids-chunk)
|
||||
(insert-guix-revision-package-derivations
|
||||
conn
|
||||
guix-revision-id
|
||||
package-derivation-ids-chunk))
|
||||
2000
|
||||
package-derivation-ids)
|
||||
(simple-format
|
||||
#t "Successfully loaded ~A package/derivation pairs\n"
|
||||
ids-count))
|
||||
|
||||
(let* ((package-derivation-ids
|
||||
(with-time-logging "inferior-data->package-derivation-ids"
|
||||
(inferior-data->package-derivation-ids
|
||||
conn inf inferior-package-id->package-database-id
|
||||
inferior-data-4-tuples)))
|
||||
(ids-count
|
||||
(length package-derivation-ids)))
|
||||
(chunk-for-each! (lambda (package-derivation-ids-chunk)
|
||||
(insert-guix-revision-package-derivations
|
||||
conn
|
||||
guix-revision-id
|
||||
package-derivation-ids-chunk))
|
||||
2000
|
||||
package-derivation-ids)
|
||||
(simple-format
|
||||
#t "Successfully loaded ~A package/derivation pairs\n"
|
||||
ids-count))
|
||||
|
||||
(with-time-logging
|
||||
"insert-guix-revision-package-derivation-distribution-counts"
|
||||
(insert-guix-revision-package-derivation-distribution-counts
|
||||
conn
|
||||
guix-revision-id))))
|
||||
(with-time-logging
|
||||
"insert-guix-revision-package-derivation-distribution-counts"
|
||||
(insert-guix-revision-package-derivation-distribution-counts
|
||||
conn
|
||||
guix-revision-id)))))
|
||||
#t)
|
||||
(lambda (key . args)
|
||||
(simple-format (current-error-port)
|
||||
|
|
|
|||
|
|
@ -33,7 +33,8 @@
|
|||
(let ((derivation-ids
|
||||
(derivation-file-names->derivation-ids
|
||||
conn
|
||||
(map cdr derivations-by-system))))
|
||||
(list->vector
|
||||
(map cdr derivations-by-system)))))
|
||||
|
||||
(exec-query
|
||||
conn
|
||||
|
|
@ -49,7 +50,7 @@ VALUES "
|
|||
system
|
||||
derivation-id))
|
||||
(map car derivations-by-system)
|
||||
derivation-ids)
|
||||
(vector->list derivation-ids))
|
||||
", "))))
|
||||
#t)
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@
|
|||
|
||||
(define-module (guix-data-service model derivation)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-43)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 format)
|
||||
|
|
@ -1545,7 +1546,8 @@ LIMIT $1"
|
|||
|
||||
(update-derivation-ids-hash-table! conn
|
||||
derivation-ids-hash-table
|
||||
input-derivation-file-names)
|
||||
(list->vector
|
||||
input-derivation-file-names))
|
||||
(simple-format
|
||||
#t
|
||||
"debug: ensure-input-derivations-exist: checking for missing input derivations\n")
|
||||
|
|
@ -1743,18 +1745,20 @@ WHERE " criteria ";"))
|
|||
(define (update-derivation-ids-hash-table! conn
|
||||
derivation-ids-hash-table
|
||||
file-names)
|
||||
(define file-names-count (length file-names))
|
||||
(define file-names-count (vector-length file-names))
|
||||
|
||||
(simple-format #t "debug: update-derivation-ids-hash-table!: ~A file-names\n"
|
||||
file-names-count)
|
||||
(let ((missing-file-names
|
||||
(fold (lambda (file-name result)
|
||||
(if (hash-ref derivation-ids-hash-table
|
||||
file-name)
|
||||
result
|
||||
(cons file-name result)))
|
||||
'()
|
||||
file-names)))
|
||||
(vector-fold
|
||||
(lambda (_ result file-name)
|
||||
(if (and file-name
|
||||
(hash-ref derivation-ids-hash-table
|
||||
file-name))
|
||||
result
|
||||
(cons file-name result)))
|
||||
'()
|
||||
file-names)))
|
||||
|
||||
(simple-format
|
||||
#t "debug: update-derivation-ids-hash-table!: lookup ~A file-names, ~A not cached\n"
|
||||
|
|
@ -1773,6 +1777,9 @@ WHERE " criteria ";"))
|
|||
(chunk! missing-file-names 1000)))))
|
||||
|
||||
(define (derivation-file-names->derivation-ids conn derivation-file-names)
|
||||
(define derivations-count
|
||||
(vector-length derivation-file-names))
|
||||
|
||||
(define (insert-source-files-missing-nars derivation-ids)
|
||||
(define (derivation-ids->next-related-derivation-ids! ids seen-ids)
|
||||
(delete-duplicates/sort!
|
||||
|
|
@ -1862,10 +1869,9 @@ INNER JOIN derivation_source_files
|
|||
next-related-derivation-ids
|
||||
seen-ids)))))))
|
||||
|
||||
(if (null? derivation-file-names)
|
||||
'()
|
||||
(let* ((derivations-count (length derivation-file-names))
|
||||
(derivation-ids-hash-table (make-hash-table
|
||||
(if (= 0 derivations-count)
|
||||
#()
|
||||
(let* ((derivation-ids-hash-table (make-hash-table
|
||||
;; Account for more derivations in
|
||||
;; the graph
|
||||
(* 2 derivations-count))))
|
||||
|
|
@ -1879,10 +1885,16 @@ INNER JOIN derivation_source_files
|
|||
|
||||
(let ((missing-derivation-filenames
|
||||
(deduplicate-strings
|
||||
(filter (lambda (derivation-file-name)
|
||||
(not (hash-ref derivation-ids-hash-table
|
||||
derivation-file-name)))
|
||||
derivation-file-names))))
|
||||
(vector-fold
|
||||
(lambda (_ result derivation-file-name)
|
||||
(if (not derivation-file-name)
|
||||
result
|
||||
(if (hash-ref derivation-ids-hash-table
|
||||
derivation-file-name)
|
||||
result
|
||||
(cons derivation-file-name result))))
|
||||
'()
|
||||
derivation-file-names))))
|
||||
|
||||
(chunk-for-each!
|
||||
(lambda (missing-derivation-filenames-chunk)
|
||||
|
|
@ -1907,14 +1919,25 @@ INNER JOIN derivation_source_files
|
|||
missing-derivation-filenames)
|
||||
|
||||
(let ((all-ids
|
||||
(map (lambda (derivation-file-name)
|
||||
(vector-map
|
||||
(lambda (_ derivation-file-name)
|
||||
(if derivation-file-name
|
||||
(or (hash-ref derivation-ids-hash-table
|
||||
derivation-file-name)
|
||||
(error "missing derivation id")))
|
||||
derivation-file-names)))
|
||||
(error "missing derivation id"))
|
||||
#f))
|
||||
derivation-file-names)))
|
||||
|
||||
(with-time-logging "insert-source-files-missing-nars"
|
||||
(insert-source-files-missing-nars all-ids))
|
||||
(insert-source-files-missing-nars
|
||||
;; TODO Avoid this conversion
|
||||
(vector-fold
|
||||
(lambda (_ result x)
|
||||
(if x
|
||||
(cons x result)
|
||||
result))
|
||||
'()
|
||||
all-ids)))
|
||||
|
||||
all-ids)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -28,39 +28,39 @@
|
|||
(define inferior-package-id
|
||||
(@@ (guix inferior) inferior-package-id))
|
||||
|
||||
(define (inferior-packages->license-data inf packages)
|
||||
(define (proc packages)
|
||||
`(map (lambda (inferior-package-id)
|
||||
(let ((package (hashv-ref %package-table inferior-package-id)))
|
||||
(match (package-license package)
|
||||
((? license? license)
|
||||
(list
|
||||
(list (license-name license)
|
||||
(license-uri license)
|
||||
(license-comment license))))
|
||||
((values ...)
|
||||
(map (match-lambda
|
||||
((? license? license)
|
||||
(list (license-name license)
|
||||
(license-uri license)
|
||||
(license-comment license)))
|
||||
(x
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"error: unknown license value ~A for package ~A"
|
||||
x package)
|
||||
'()))
|
||||
values))
|
||||
(x
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"error: unknown license value ~A for package ~A"
|
||||
x package)
|
||||
'()))))
|
||||
(list ,@(map inferior-package-id packages))))
|
||||
(define (inferior-packages->license-data inf)
|
||||
(define proc
|
||||
`(vector-map
|
||||
(lambda (_ package)
|
||||
(match (package-license package)
|
||||
((? license? license)
|
||||
(list
|
||||
(list (license-name license)
|
||||
(license-uri license)
|
||||
(license-comment license))))
|
||||
((values ...)
|
||||
(map (match-lambda
|
||||
((? license? license)
|
||||
(list (license-name license)
|
||||
(license-uri license)
|
||||
(license-comment license)))
|
||||
(x
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"error: unknown license value ~A for package ~A"
|
||||
x package)
|
||||
'()))
|
||||
values))
|
||||
(x
|
||||
(simple-format
|
||||
(current-error-port)
|
||||
"error: unknown license value ~A for package ~A"
|
||||
x package)
|
||||
'())))
|
||||
gds-inferior-packages))
|
||||
|
||||
(inferior-eval '(use-modules (guix licenses)) inf)
|
||||
(inferior-eval (proc packages) inf))
|
||||
(inferior-eval proc inf))
|
||||
|
||||
(define (inferior-packages->license-id-lists conn license-data)
|
||||
(define (string-or-null v)
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@
|
|||
|
||||
(define-module (guix-data-service model package-derivation)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-43)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (squee)
|
||||
|
|
@ -26,17 +27,26 @@
|
|||
count-packages-derivations-in-revision))
|
||||
|
||||
(define (insert-package-derivations conn
|
||||
package-ids-systems-and-targets
|
||||
system
|
||||
target
|
||||
package-ids
|
||||
derivation-ids)
|
||||
(define system-id
|
||||
(system->system-id conn system))
|
||||
|
||||
(define data-4-tuples
|
||||
(map (match-lambda*
|
||||
(((package-id system target) derivation-id)
|
||||
(list package-id
|
||||
derivation-id
|
||||
(system->system-id conn system)
|
||||
target)))
|
||||
package-ids-systems-and-targets
|
||||
derivation-ids))
|
||||
(vector-fold
|
||||
(lambda (_ result package-id derivation-id)
|
||||
(if derivation-id
|
||||
(cons (list package-id
|
||||
derivation-id
|
||||
system-id
|
||||
target)
|
||||
result)
|
||||
result))
|
||||
'()
|
||||
package-ids
|
||||
derivation-ids))
|
||||
|
||||
(if (null? data-4-tuples)
|
||||
'()
|
||||
|
|
|
|||
|
|
@ -264,11 +264,12 @@ INSERT INTO packages (name, version, package_metadata_id) VALUES "
|
|||
RETURNING id"))
|
||||
|
||||
(define (inferior-packages->package-ids conn package-entries)
|
||||
(insert-missing-data-and-return-all-ids
|
||||
conn
|
||||
"packages"
|
||||
'(name version package_metadata_id replacement_package_id)
|
||||
package-entries))
|
||||
(list->vector
|
||||
(insert-missing-data-and-return-all-ids
|
||||
conn
|
||||
"packages"
|
||||
'(name version package_metadata_id replacement_package_id)
|
||||
package-entries)))
|
||||
|
||||
(define (select-package-versions-for-revision conn
|
||||
commit
|
||||
|
|
|
|||
Loading…
Reference in New Issue