Add fix-derivation
To the load data module, since this is where most of the useful code is.
This commit is contained in:
parent
35281c8a49
commit
bf3fdfd8d3
1 changed files with 70 additions and 1 deletions
|
|
@ -95,7 +95,9 @@
|
|||
guix-revision-loaded-successfully?
|
||||
record-job-event
|
||||
enqueue-load-new-guix-revision-job
|
||||
most-recent-n-load-new-guix-revision-jobs))
|
||||
most-recent-n-load-new-guix-revision-jobs
|
||||
|
||||
fix-derivation))
|
||||
|
||||
(define inferior-package-id
|
||||
(@@ (guix inferior) inferior-package-id))
|
||||
|
|
@ -1229,6 +1231,73 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
|
|||
derivation-ids
|
||||
derivations))))))
|
||||
|
||||
(define (fix-derivation file-name)
|
||||
(define (derivation-missing-inputs? conn drv-id)
|
||||
(let ((inputs (select-derivation-inputs-by-derivation-id
|
||||
conn
|
||||
drv-id)))
|
||||
;; TODO Detect missing inputs, as well as them all missing
|
||||
(null? inputs)))
|
||||
|
||||
(define (derivation-missing-sources? conn drv-id)
|
||||
(let ((sources (select-derivation-sources-by-derivation-id
|
||||
conn
|
||||
drv-id)))
|
||||
;; TODO Detect missing inputs, as well as them all missing
|
||||
(null? sources)))
|
||||
|
||||
(run-fibers
|
||||
(lambda ()
|
||||
(with-postgresql-connection
|
||||
"fix"
|
||||
(lambda (conn)
|
||||
(let ((drv (read-derivation-from-file file-name))
|
||||
(postgresql-connection-pool
|
||||
(make-resource-pool
|
||||
(const conn)
|
||||
1
|
||||
#:name "postgres"))
|
||||
(call-with-utility-thread
|
||||
(lambda (thunk)
|
||||
(thunk)))
|
||||
(derivation-ids-hash-table
|
||||
(make-hash-table)))
|
||||
|
||||
(match (select-derivation-by-file-name conn (derivation-file-name drv))
|
||||
((drv-id rest ...)
|
||||
(when (and (derivation-missing-sources? conn drv-id)
|
||||
(not (null? (derivation-sources drv))))
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(derivations-insert-sources postgresql-connection-pool
|
||||
call-with-utility-thread
|
||||
(vector drv)
|
||||
(vector drv-id)))))
|
||||
|
||||
(when (and (derivation-missing-inputs? conn drv-id)
|
||||
(not (null? (derivation-inputs drv))))
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(let ((input-derivations
|
||||
(map derivation-input-derivation
|
||||
(derivation-inputs drv))))
|
||||
(unless (null? input-derivations)
|
||||
;; Ensure all the input derivations exist
|
||||
(for-each
|
||||
(lambda (chunk)
|
||||
(insert-missing-derivations
|
||||
postgresql-connection-pool
|
||||
call-with-utility-thread
|
||||
derivation-ids-hash-table
|
||||
chunk))
|
||||
(chunk! input-derivations 1000))))))
|
||||
|
||||
(fix-derivation-inputs conn drv))))))))
|
||||
#:hz 0
|
||||
#:parallelism 1))
|
||||
|
||||
(define* (derivation-file-names->derivation-ids postgresql-connection-pool
|
||||
call-with-utility-thread
|
||||
read-derivations/fiberized
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue