nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

git-download: Download from Software Heritage as a last resort. 

* guix/git-download.scm (git-fetch)[inputs]: Add gzip and tar when
'git-reference-recursive?' is false.
[guile-json, gnutls]: New variables.
[modules]: Add (guix swh).
[build]: Wrap in 'with-extensions'.  Add call to 'swh-download'.
This commit is contained in:
Ludovic Courtès 2018-11-19 15:46:50 +01:00 committed by Ludovic Courtès
parent de2bfe9029
commit 608d3dca89
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 44 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
guix/git-download.scm
View File

@ -74,11 +74,22 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
;; available so that 'git submodule' works. ;; available so that 'git submodule' works.
(if (git-reference-recursive? ref) (if (git-reference-recursive? ref)
(standard-packages) (standard-packages)
'()))
;; The 'swh-download' procedure requires tar and gzip.
`(("gzip" ,(module-ref (resolve-interface '(gnu packages compression))
'gzip))
("tar" ,(module-ref (resolve-interface '(gnu packages base))
'tar)))))
(define zlib (define zlib
(module-ref (resolve-interface '(gnu packages compression)) 'zlib)) (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
(define guile-json
(module-ref (resolve-interface '(gnu packages guile)) 'guile-json))
(define gnutls
(module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
(define config.scm (define config.scm
(scheme-file "config.scm" (scheme-file "config.scm"
#~(begin #~(begin
@ -93,30 +104,43 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
(delete '(guix config) (delete '(guix config)
(source-module-closure '((guix build git) (source-module-closure '((guix build git)
(guix build utils) (guix build utils)
(guix build download-nar)))))) (guix build download-nar)
(guix swh))))))
(define build (define build
(with-imported-modules modules (with-imported-modules modules
#~(begin (with-extensions (list guile-json gnutls) ;for (guix swh)
(use-modules (guix build git) #~(begin
(guix build utils) (use-modules (guix build git)
(guix build download-nar) (guix build utils)
(ice-9 match)) (guix build download-nar)
(guix swh)
(ice-9 match))
;; The 'git submodule' commands expects Coreutils, sed, (define recursive?
;; grep, etc. to be in $PATH. (call-with-input-string (getenv "git recursive?") read))
(set-path-environment-variable "PATH" '("bin")
(match '#+inputs
(((names dirs outputs ...) ...)
dirs)))
(or (git-fetch (getenv "git url") (getenv "git commit") ;; The 'git submodule' commands expects Coreutils, sed,
#$output ;; grep, etc. to be in $PATH.
#:recursive? (call-with-input-string (set-path-environment-variable "PATH" '("bin")
(getenv "git recursive?") (match '#+inputs
read) (((names dirs outputs ...) ...)
#:git-command (string-append #+git "/bin/git")) dirs)))
(download-nar #$output)))))
(setvbuf (current-output-port) 'line)
(setvbuf (current-error-port) 'line)
(or (git-fetch (getenv "git url") (getenv "git commit")
#$output
#:recursive? recursive?
#:git-command (string-append #+git "/bin/git"))
(download-nar #$output)
;; As a last resort, attempt to download from Software Heritage.
;; XXX: Currently recursive checkouts are not supported.
(and (not recursive?)
(swh-download (getenv "git url") (getenv "git commit")
#$output)))))))
(mlet %store-monad ((guile (package->derivation guile system))) (mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "git-checkout") build (gexp->derivation (or name "git-checkout") build