@@ 23,6 23,8 @@
#:use-module (guix packages)
#:use-module ((guix store) #:select (derivation-path? add-to-store))
#:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:))
+ #:use-module (guix monads)
+ #:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (web uri)
#:use-module (srfi srfi-1)
@@ 167,11 169,10 @@
"http://ftp.fr.debian.org/debian/"
"http://ftp.debian.org/debian/"))))
-(define (gnutls-derivation store system)
- "Return the GnuTLS derivation for SYSTEM."
- (let* ((module (resolve-interface '(gnu packages gnutls)))
- (gnutls (module-ref module 'gnutls)))
- (package-derivation store gnutls system)))
+(define (gnutls-package)
+ "Return the GnuTLS package for SYSTEM."
+ (let ((module (resolve-interface '(gnu packages gnutls))))
+ (module-ref module 'gnutls)))
(define* (url-fetch store url hash-algo hash
#:optional name
@@ 186,22 187,13 @@ different file name.
When one of the URL starts with mirror://, then its host part is
interpreted as the name of a mirror scheme, taken from MIRRORS; MIRRORS
must be a list of symbol/URL-list pairs."
- (define builder
- `(begin
- (use-modules (guix build download))
- (url-fetch ',url %output
- #:mirrors ',mirrors)))
-
(define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system))
- ((and (? string?) (? derivation-path?))
- guile)
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages base)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system)))))
+ (package-derivation store
+ (or guile
+ (let ((distro
+ (resolve-interface '(gnu packages base))))
+ (module-ref distro 'guile-final)))
+ system))
(define file-name
(match url
@@ 219,34 211,36 @@ must be a list of symbol/URL-list pairs."
((url ...)
(any https? url)))))
- (let* ((gnutls-drv (if need-gnutls?
- (gnutls-derivation store system)
- (values #f #f)))
- (gnutls (and gnutls-drv
- (derivation->output-path gnutls-drv "out")))
- (env-vars (if gnutls
- (let ((dir (string-append gnutls "/share/guile/site")))
- ;; XXX: `GUILE_LOAD_COMPILED_PATH' is overridden
- ;; by `build-expression->derivation', so we can't
- ;; set it here.
- `(("GUILE_LOAD_PATH" . ,dir)))
- '())))
- (build-expression->derivation store (or name file-name) builder
- #:system system
- #:inputs (if gnutls-drv
- `(("gnutls" ,gnutls-drv))
- '())
- #:hash-algo hash-algo
- #:hash hash
- #:modules '((guix build download)
- (guix build utils)
- (guix ftp-client))
- #:guile-for-build guile-for-build
- #:env-vars env-vars
+ (define builder
+ #~(begin
+ #$(if need-gnutls?
+
+ ;; Add GnuTLS to the inputs and to the load path.
+ #~(eval-when (load expand eval)
+ (set! %load-path
+ (cons (string-append #$(gnutls-package)
+ "/share/guile/site")
+ %load-path)))
+ #~#t)
+
+ (use-modules (guix build download))
+ (url-fetch '#$url #$output
+ #:mirrors '#$mirrors)))
+
+ (run-with-store store
+ (gexp->derivation (or name file-name) builder
+ #:system system
+ #:hash-algo hash-algo
+ #:hash hash
+ #:modules '((guix build download)
+ (guix build utils)
+ (guix ftp-client))
+ #:guile-for-build guile-for-build
- ;; In general, offloading downloads is not a
- ;; good idea.
- #:local-build? #t)))
+ ;; In general, offloading downloads is not a good idea.
+ #:local-build? #t)
+ #:guile-for-build guile-for-build
+ #:system system))
(define* (download-to-store store url #:optional (name (basename url))
#:key (log (current-error-port)))