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.
This commit is contained in:
Ludovic Courtès 2014-08-23 22:57:16 +02:00
parent c1bc358f29
commit 6119ebf194
2 changed files with 40 additions and 41 deletions

View File

@ -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)))

View File

@ -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 %build-inputs
(((names . dirs) ...)
dirs)))
;; The 'git submodule' commands expects Coreutils, sed,
;; grep, etc. to be in $PATH.
(set-path-environment-variable "PATH" '("bin")
(match '#$inputs
(((names dirs) ...)
dirs)))
(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)))
(git-fetch '#$(git-reference-url ref)
'#$(git-reference-commit ref)
#$output
#:recursive? '#$(git-reference-recursive? ref)
#:git-command (string-append #$git "/bin/git"))))
(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