diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-01-09 23:20:25 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-01-11 10:13:32 +0100 |
commit | 0602d92bb0cf4386946cc0e28ee4da47dbc06bd4 (patch) | |
tree | 18bf5a41c6c65c2b148fc28207e644fdca5f9537 /guix/grafts.scm | |
parent | ca9050d5177a82da63b4716f6b12c7c377a84961 (diff) |
DRAFT gexp: Turn grafting into a build continuation.wip-gexp-grafts
TODO: See FIXME in gexp.scm.
* guix/gexp.scm (gexp->derivation): Rename 'graft?' local variable to
'prev-graft?' and call (set-grafting? #f) unconditionally. When GRAFT?
is true, call 'set-build-continuation' for DRV.
* guix/grafts.scm (graft-derivation*, graft-continuation): New
procedures.
* tests/gexp.scm ("gexp-grafts"): Remove test that is now obsolete.
Diffstat (limited to 'guix/grafts.scm')
-rw-r--r-- | guix/grafts.scm | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/guix/grafts.scm b/guix/grafts.scm index 2006d3908e..da106ae0dc 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -29,6 +29,7 @@ #:use-module (srfi srfi-34) #:use-module (ice-9 match) #:use-module (ice-9 vlist) + #:use-module (ice-9 format) #:export (graft? graft graft-origin @@ -39,6 +40,8 @@ graft-derivation graft-derivation/shallow + graft-continuation + %graft? set-grafting)) @@ -321,6 +324,26 @@ DRV itself to refer to those grafted dependencies." (graft-replacement first) drv)))) +(define graft-derivation* + (store-lift graft-derivation)) + +(define (graft-continuation drv grafts) + "Return a monadic thunk that acts as a built continuation applying GRAFTS to +the result of DRV." + (define _ gettext) ;FIXME: (guix ui)? + (match grafts + (() + (lift1 (const '()) %store-monad)) + (x + (lambda (drv-file-name) + (format #t (_ "applying ~a grafts to~{ ~a~}~%") + (length grafts) + (match (derivation->output-paths drv) + (((outputs . items) ...) + items))) + (mlet %store-monad ((drv (graft-derivation* drv grafts))) + (return (list (derivation-file-name drv)))))))) + ;; The following might feel more at home in (guix packages) but since (guix ;; gexp), which is a lower level, needs them, we put them here. |