diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-08-23 22:57:16 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-08-23 22:58:09 +0200 |
commit | 6119ebf1941a47f42cbf24f17066333fed3d6e3d (patch) | |
tree | 53d1b7f009beb53df10101b345c99ee6eb01b30c | |
parent | c1bc358f293b97c9575f6195c3e7a119b05199ce (diff) | |
download | guix-6119ebf1941a47f42cbf24f17066333fed3d6e3d.tar.gz guix-6119ebf1941a47f42cbf24f17066333fed3d6e3d.zip |
git-download: Rewrite using gexps.
* guix/git-download.scm (git-package): New procedure.
(git-fetch): Use it. Remove 'git-for-build'.
Use a gexp and 'gexp->derivation'.
* guix/download.scm (gnutls-package): Fix docstring.
-rw-r--r-- | guix/download.scm | 2 | ||||
-rw-r--r-- | guix/git-download.scm | 79 |
2 files changed, 40 insertions, 41 deletions
diff --git a/guix/download.scm b/guix/download.scm index 22c3ba19ca..92d08fc2bd 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -185,7 +185,7 @@ "http://ftp.debian.org/debian/")))) (define (gnutls-package) - "Return the GnuTLS package for SYSTEM." + "Return the default GnuTLS package." (let ((module (resolve-interface '(gnu packages gnutls)))) (module-ref module 'gnutls))) diff --git a/guix/git-download.scm b/guix/git-download.scm index 43d190db54..5691e8a870 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -17,8 +17,9 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix git-download) + #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix records) - #:use-module (guix derivations) #:use-module (guix packages) #:autoload (guix build-system gnu) (standard-inputs) #:use-module (ice-9 match) @@ -46,9 +47,15 @@ (recursive? git-reference-recursive? ; whether to recurse into sub-modules (default #f))) +(define (git-package) + "Return the default Git package." + (let ((distro (resolve-interface '(gnu packages version-control)))) + (module-ref distro 'git))) + (define* (git-fetch store ref hash-algo hash #:optional name - #:key (system (%current-system)) guile git) + #:key (system (%current-system)) guile + (git (git-package))) "Return a fixed-output derivation in STORE that fetches REF, a <git-reference> object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if @@ -62,15 +69,6 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) - (define git-for-build - (match git - ((? package?) - (package-derivation store git system)) - (#f ; the default - (let* ((distro (resolve-interface '(gnu packages version-control))) - (git (module-ref distro 'git))) - (package-derivation store git system))))) - (define inputs ;; When doing 'git clone --recursive', we need sed, grep, etc. to be ;; available so that 'git submodule' works. @@ -78,36 +76,37 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if (standard-inputs (%current-system)) '())) - (let* ((command (string-append (derivation->output-path git-for-build) - "/bin/git")) - (builder `(begin - (use-modules (guix build git) - (guix build utils) - (ice-9 match)) + (define build + #~(begin + (use-modules (guix build git) + (guix build utils) + (ice-9 match)) + + ;; The 'git submodule' commands expects Coreutils, sed, + ;; grep, etc. to be in $PATH. + (set-path-environment-variable "PATH" '("bin") + (match '#$inputs + (((names dirs) ...) + dirs))) - ;; The 'git submodule' commands expects Coreutils, sed, - ;; grep, etc. to be in $PATH. - (set-path-environment-variable "PATH" '("bin") - (match %build-inputs - (((names . dirs) ...) - dirs))) + (git-fetch '#$(git-reference-url ref) + '#$(git-reference-commit ref) + #$output + #:recursive? '#$(git-reference-recursive? ref) + #:git-command (string-append #$git "/bin/git")))) - (git-fetch ',(git-reference-url ref) - ',(git-reference-commit ref) - %output - #:recursive? ',(git-reference-recursive? ref) - #:git-command ',command)))) - (build-expression->derivation store (or name "git-checkout") builder - #:system system - #:local-build? #t - #:inputs `(("git" ,git-for-build) - ,@inputs) - #:hash-algo hash-algo - #:hash hash - #:recursive? #t - #:modules '((guix build git) - (guix build utils)) - #:guile-for-build guile-for-build - #:local-build? #t))) + (run-with-store store + (gexp->derivation (or name "git-checkout") build + #:system system + #:local-build? #t + #:hash-algo hash-algo + #:hash hash + #:recursive? #t + #:modules '((guix build git) + (guix build utils)) + #:guile-for-build guile-for-build + #:local-build? #t) + #:guile-for-build guile-for-build + #:system system)) ;;; git-download.scm ends here |