From f220a8384890b2a50f30c62fba56e507333f1a92 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 14 Jan 2015 14:42:10 +0100 Subject: packages: Convert source derivations to monadic style. * guix/packages.scm (origin->derivation): Take body from 'package-source-derivation', and change it to monadic style. Expect METHOD to a monadic procedure. (package-source-derivation): Define in terms of 'origin->derivation'. * guix/download.scm (url-fetch): Remove 'store' argument. Remove 'guile-for-build' variable. Turn into a monadic procedure. * guix/git-download.scm (git-fetch): Likewise. * guix/svn-download.scm (svn-fetch): Likewise. * tests/builders.scm (url-fetch*): New procedure. Change tests to call 'url-fetch*' instead of 'url-fetch'. * tests/packages.scm ("package-source-derivation, snippet"): Remove 'store' parameter of 'fetch' and change it to use 'interned-file' instead of 'add-to-store'. * gnu/packages/bootstrap.scm (bootstrap-origin)[boot]: Remove 'store' parameter. --- tests/builders.scm | 21 ++++++++++++--------- tests/packages.scm | 6 +++--- 2 files changed, 15 insertions(+), 12 deletions(-) (limited to 'tests') diff --git a/tests/builders.scm b/tests/builders.scm index 579246d04d..e5acc3e038 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -59,6 +59,9 @@ (define network-reachable? (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) +(define url-fetch* + (store-lower url-fetch)) + (test-begin "builders") @@ -68,8 +71,8 @@ "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")) (hash (nix-base32-string->bytevector "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) - (drv (url-fetch %store url 'sha256 hash - #:guile %bootstrap-guile)) + (drv (url-fetch* %store url 'sha256 hash + #:guile %bootstrap-guile)) (out-path (derivation->output-path drv))) (and (build-derivations %store (list drv)) (file-exists? out-path) @@ -78,16 +81,16 @@ (test-assert "url-fetch, file" (let* ((file (search-path %load-path "guix.scm")) (hash (call-with-input-file file port-sha256)) - (out (url-fetch %store file 'sha256 hash))) + (out (url-fetch* %store file 'sha256 hash))) (and (file-exists? out) (valid-path? %store out)))) (test-assert "url-fetch, file URI" (let* ((file (search-path %load-path "guix.scm")) (hash (call-with-input-file file port-sha256)) - (out (url-fetch %store - (string-append "file://" (canonicalize-path file)) - 'sha256 hash))) + (out (url-fetch* %store + (string-append "file://" (canonicalize-path file)) + 'sha256 hash))) (and (file-exists? out) (valid-path? %store out)))) @@ -99,8 +102,8 @@ (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") (hash (nix-base32-string->bytevector "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) - (tarball (url-fetch %store url 'sha256 hash - #:guile %bootstrap-guile)) + (tarball (url-fetch* %store url 'sha256 hash + #:guile %bootstrap-guile)) (build (gnu-build %store "hello-2.8" `(("source" ,tarball) ,@%bootstrap-inputs) diff --git a/tests/packages.scm b/tests/packages.scm index f7d6155ecc..3ee44adc98 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -178,10 +178,10 @@ (let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz" (%current-system))) (sha256 (call-with-input-file file port-sha256)) - (fetch (lambda* (store url hash-algo hash + (fetch (lambda* (url hash-algo hash #:optional name #:key system) (pk 'fetch url hash-algo hash name system) - (add-to-store store (basename url) #f "sha256" url))) + (interned-file url))) (source (bootstrap-origin (origin (method fetch) -- cgit 1.4.1