cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor how channel derivations are handled

Browse source 
Yet again...

This makes the channel-derivations for each system accessible within the
load-new-guix-revision procedure, in preparation for storing them in the
database.
This commit is contained in:
Christopher Baines 2020-02-09 21:40:56 +00:00
parent 60d53f898f
commit e0ee3d224b
1 changed files with 152 additions and 142 deletions
Download patch file Download diff file Expand all files Collapse all files

72
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -714,7 +714,7 @@ WHERE job_id = $1"
(build-derivations store (list derivation))))
(derivation->output-path derivation)))
(define (channel->derivation-file-names-by-system store channel)
(define (channel->derivation-file-names-by-system channel)
(define use-container? (defined?
'open-inferior/container
(resolve-module '(guix inferior))))
@ -732,12 +732,11 @@ WHERE job_id = $1"
,(channel-instance-checkout channel-instance)))))
(map
(lambda (system)
(log-time
(simple-format
#f "computing the derivation-file-name for ~A"
(current-error-port)
"guix-data-service: computing the derivation-file-name for ~A\n"
system)
(lambda ()
(with-store store
((set-current-system system) store)
(let ((manifest
(catch #t
@ -777,9 +776,12 @@ WHERE job_id = $1"
(simple-format
(current-error-port)
"error ~A: ~A\n" key args)
#f))))))))))
#f)))))))
(list ,@systems)))))
(with-store store
(set-build-options store #:fallback? #t)
(let ((inferior
(if use-container?
(open-inferior/container
@ -851,9 +853,9 @@ WHERE job_id = $1"
key parameters))))
(lambda args
(close-inferior inferior)
#f))))
#f)))))
(define (channel->manifest-store-item conn store channel)
(define (channel->derivations-by-system conn channel)
(let* ((derivation-file-names-by-system
(log-time
"computing the channel derivation"
@ -864,12 +866,7 @@ WHERE job_id = $1"
conn
'channel->manifest-store-item
(lambda ()
(channel->derivation-file-names-by-system store channel))))))
(derivation
(read-derivation-from-file (assoc-ref
(assoc-ref derivation-file-names-by-system
(%current-system))
'profile))))
(channel->derivation-file-names-by-system channel)))))))
(for-each
(match-lambda
((system . derivation-file-name)
@ -878,26 +875,35 @@ WHERE job_id = $1"
system
derivation-file-name)))
derivation-file-names-by-system)
derivation-file-names-by-system))
(define (channel-derivations-by-system->guix-store-item
channel-derivations-by-system)
(define (store-item->guix-store-item filename)
(dirname
(readlink
(string-append filename "/bin"))))
(let ((derivation-file-name-for-current-system
(assoc-ref
(assoc-ref channel-derivations-by-system
(%current-system))
'profile)))
(if derivation-file-name-for-current-system
(let ((derivation-for-current-system
(read-derivation-from-file derivation-file-name-for-current-system)))
(with-store store
(set-build-options store #:fallback? #t)
(log-time
"building the channel derivation"
(lambda ()
(build-derivations store (list derivation))))
(derivation->output-path derivation)))
(build-derivations store (list derivation-for-current-system)))))
(define (channel->guix-store-item conn channel)
(catch
#t
(lambda ()
(with-store store
(set-build-options store #:fallback? #t)
(dirname
(readlink
(string-append (channel->manifest-store-item conn
store
channel)
"/bin")))))
(lambda args
(simple-format #t "guix-data-service: load-new-guix-revision: error: ~A\n" args)
(store-item->guix-store-item
(derivation->output-path derivation-for-current-system)))
#f)))
(define (glibc-locales-for-guix-store-path store store-path)
@ -1186,8 +1192,12 @@ ORDER BY packages.name, packages.version"
conn
git-repository-id))
(commit commit)))
(channel-derivations-by-system
(channel->derivations-by-system conn
channel-for-commit))
(store-item
(channel->guix-store-item conn channel-for-commit)))
(channel-derivations-by-system->guix-store-item
channel-derivations-by-system)))
(if store-item
(let ((guix-revision-id
(insert-guix-revision conn git-repository-id