DRAFT store: Add support for build continuations.

TODO: Add tests; update guix.texi.

* guix/store.scm (<nix-server>)[continuations]: New field.
(open-connection): Adjust accordingly.
(set-build-continuation!, build-continuation): New procedures.
(build-things): Rename to...
(%build-things): ... this.
(build-things, set-build-continuation): New procedures.
* guix/derivations.scm (build-derivations): Add #:continuation?
parameter and pass it to 'built-things'.  Convert the return value to a
list of store items.
This commit is contained in:
Ludovic Courtès 2017-01-09 22:41:59 +01:00
parent ea7b5a8f3d
commit c490a0b037
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 72 additions and 11 deletions

View file

@ -989,15 +989,28 @@ recursively."
;;; ;;;
(define* (build-derivations store derivations (define* (build-derivations store derivations
#:optional (mode (build-mode normal))) #:optional (mode (build-mode normal))
#:key (continuations? #t))
"Build DERIVATIONS, a list of <derivation> objects or .drv file names, using "Build DERIVATIONS, a list of <derivation> objects or .drv file names, using
the specified MODE." the specified MODE. When CONTINUATIONS? is true, run the \"build
(build-things store (map (match-lambda continuations\" of each of DERIVATIONS. Return the list of store items that
((? string? file) file) were built."
((and drv ($ <derivation>)) (let ((things (build-things store (map (match-lambda
(derivation-file-name drv))) ((? string? file) file)
derivations) ((and drv ($ <derivation>))
mode)) (derivation-file-name drv)))
derivations)
mode)))
;; Convert the list of .drv file names to a list of output file names.
(append-map (match-lambda
((? derivation-path? drv)
(let ((drv (call-with-input-file drv read-derivation)))
(match (derivation->output-paths drv)
(((outputs . items) ...)
items))))
(x
(list x)))
things)))
;;; ;;;

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -71,6 +71,8 @@
add-to-store add-to-store
build-things build-things
build build
set-build-continuation!
set-build-continuation
query-failed-paths query-failed-paths
clear-failed-paths clear-failed-paths
add-temp-root add-temp-root
@ -312,12 +314,16 @@
(define-record-type <nix-server> (define-record-type <nix-server>
(%make-nix-server socket major minor (%make-nix-server socket major minor
ats-cache atts-cache) continuations ats-cache atts-cache)
nix-server? nix-server?
(socket nix-server-socket) (socket nix-server-socket)
(major nix-server-major-version) (major nix-server-major-version)
(minor nix-server-minor-version) (minor nix-server-minor-version)
;; Hash table that maps store items to a "build continuation" for that store
;; item.
(continuations nix-server-build-continuations)
;; Caches. We keep them per-connection, because store paths build ;; Caches. We keep them per-connection, because store paths build
;; during the session are temporary GC roots kept for the duration of ;; during the session are temporary GC roots kept for the duration of
;; the session. ;; the session.
@ -400,6 +406,7 @@ for this connection will be pinned. Return a server object."
(protocol-major v) (protocol-major v)
(protocol-minor v) (protocol-minor v)
(make-hash-table 100) (make-hash-table 100)
(make-hash-table 100)
(make-hash-table 100)))) (make-hash-table 100))))
(let loop ((done? (process-stderr conn))) (let loop ((done? (process-stderr conn)))
(or done? (process-stderr conn))) (or done? (process-stderr conn)))
@ -720,7 +727,19 @@ where FILE is the entry's absolute file name and STAT is the result of
(hash-set! cache args path) (hash-set! cache args path)
path)))))) path))))))
(define build-things (define (set-build-continuation! store item proc)
"Register PROC as a \"build continuation\" for when ITEM is built on STORE.
When 'build-things' is passed ITEM, it calls (PROC STORE ITEM), which must
return a list of store items to build."
(hash-set! (nix-server-build-continuations store) item proc))
(define (build-continuation store item)
"Return the procedure that implements a \"build continuation\" for ITEM, or
#f if there is none."
(hash-ref (nix-server-build-continuations store) item))
(define %build-things
;; This is the raw RPC.
(let ((build (operation (build-things (string-list things) (let ((build (operation (build-things (string-list things)
(integer mode)) (integer mode))
"Do it!" "Do it!"
@ -741,6 +760,29 @@ Return #t on success."
(message "unsupported build mode") (message "unsupported build mode")
(status 1))))))))) (status 1)))))))))
(define* (build-things store things
#:optional (mode (build-mode normal))
#:key (continuations? #t))
"Build THINGS, a list of store items which may be either '.drv' files or
outputs, and return when the worker is done building them. Elements of THINGS
that are not derivations can only be substituted and not built locally. When
CONTINUATIONS? is true, run the \"build continuations\" of THINGS. Return the
list of store items built."
(let loop ((things things)
(built '()))
(match things
(()
built)
(_
(and (%build-things store things mode)
(loop (append-map (lambda (thing)
(let ((proc (build-continuation store thing)))
(if proc
(proc store thing)
'())))
things)
things))))))
(define-operation (add-temp-root (store-path path)) (define-operation (add-temp-root (store-path path))
"Make PATH a temporary root for the duration of the current session. "Make PATH a temporary root for the duration of the current session.
Return #t." Return #t."
@ -1184,6 +1226,12 @@ where FILE is the entry's absolute file name and STAT is the result of
;; Monadic variant of 'build-things'. ;; Monadic variant of 'build-things'.
(store-lift build-things)) (store-lift build-things))
(define (set-build-continuation item proc)
"Register monadic thunk PROC as a \"build continuation\" for ITEM."
(lambda (store)
(set-build-continuation! store item (store-lower proc))
(values *unspecified* store)))
(define set-build-options* (define set-build-options*
(store-lift set-build-options)) (store-lift set-build-options))