mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
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:
parent
ea7b5a8f3d
commit
c490a0b037
2 changed files with 72 additions and 11 deletions
|
@ -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)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue