me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2014-08-23 22:57:16 +02:00
parent c1bc358f29
commit 6119ebf194
2 changed files with 40 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
guix/download.scm
View File

@ -185,7 +185,7 @@
"http://ftp.debian.org/debian/")))) "http://ftp.debian.org/debian/"))))
(define (gnutls-package) (define (gnutls-package)
"Return the GnuTLS package for SYSTEM." "Return the default GnuTLS package."
(let ((module (resolve-interface '(gnu packages gnutls)))) (let ((module (resolve-interface '(gnu packages gnutls))))
(module-ref module 'gnutls))) (module-ref module 'gnutls)))

79
guix/git-download.scm
View File

@ -17,8 +17,9 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix git-download) (define-module (guix git-download)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:autoload (guix build-system gnu) (standard-inputs) #:autoload (guix build-system gnu) (standard-inputs)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -46,9 +47,15 @@
(recursive? git-reference-recursive? ; whether to recurse into sub-modules (recursive? git-reference-recursive? ; whether to recurse into sub-modules
(default #f))) (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 (define* (git-fetch store ref hash-algo hash
#:optional name #: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 "Return a fixed-output derivation in STORE that fetches REF, a
<git-reference> object. The output is expected to have recursive hash HASH of <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 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))) (guile (module-ref distro 'guile-final)))
(package-derivation store guile system))))) (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 (define inputs
;; When doing 'git clone --recursive', we need sed, grep, etc. to be ;; When doing 'git clone --recursive', we need sed, grep, etc. to be
;; available so that 'git submodule' works. ;; 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)) (standard-inputs (%current-system))
'())) '()))
(let* ((command (string-append (derivation->output-path git-for-build) (define build
"/bin/git")) #~(begin
(builder `(begin (use-modules (guix build git)
(use-modules (guix build git) (guix build utils)
(guix build utils) (ice-9 match))
(ice-9 match))
;; The 'git submodule' commands expects Coreutils, sed, ;; The 'git submodule' commands expects Coreutils, sed,
;; grep, etc. to be in $PATH. ;; grep, etc. to be in $PATH.
(set-path-environment-variable "PATH" '("bin") (set-path-environment-variable "PATH" '("bin")
(match %build-inputs (match '#$inputs
(((names . dirs) ...) (((names dirs) ...)
dirs))) dirs)))
(git-fetch ',(git-reference-url ref) (git-fetch '#$(git-reference-url ref)
',(git-reference-commit ref) '#$(git-reference-commit ref)
%output #$output
#:recursive? ',(git-reference-recursive? ref) #:recursive? '#$(git-reference-recursive? ref)
#:git-command ',command)))) #:git-command (string-append #$git "/bin/git"))))
(build-expression->derivation store (or name "git-checkout") builder
#:system system (run-with-store store
#:local-build? #t (gexp->derivation (or name "git-checkout") build
#:inputs `(("git" ,git-for-build) #:system system
,@inputs) #:local-build? #t
#:hash-algo hash-algo #:hash-algo hash-algo
#:hash hash #:hash hash
#:recursive? #t #:recursive? #t
#:modules '((guix build git) #:modules '((guix build git)
(guix build utils)) (guix build utils))
#:guile-for-build guile-for-build #:guile-for-build guile-for-build
#:local-build? #t))) #:local-build? #t)
#:guile-for-build guile-for-build
#:system system))
;;; git-download.scm ends here ;;; git-download.scm ends here