From 23db83333568266972e666ee66574db29cdbbdc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 5 Feb 2020 15:52:33 +0100 Subject: import: gem: Rewrite to use a JSON mapping to records. * guix/import/gem.scm (, , ): New record types with JSON mapping. (json->gem-dependencies): New procedures. (rubygems-fetch): Use it. (hex-string->bytevector): Remove. (make-gem-sexp): Expect HASH to be a bytevector. (gem->guix-package): Adjust to use the new data type instead of an alist. (latest-release): Likewise. --- guix/import/gem.scm | 142 +++++++++++++++++++++++++--------------------------- 1 file changed, 68 insertions(+), 74 deletions(-) (limited to 'guix') diff --git a/guix/import/gem.scm b/guix/import/gem.scm index 0bf9ff2552..f4589b98b3 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 David Thompson ;;; Copyright © 2016 Ben Woodcroft ;;; Copyright © 2018 Oleg Pykhalov +;;; Copyright © 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,28 +21,63 @@ (define-module (guix import gem) #:use-module (ice-9 match) - #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-1) - #:use-module (rnrs bytevectors) - #:use-module (json) - #:use-module (web uri) + #:use-module (guix json) #:use-module ((guix download) #:prefix download:) #:use-module (guix import utils) #:use-module (guix import json) #:use-module (guix packages) #:use-module (guix upstream) #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix base16) #:use-module (guix base32) - #:use-module (guix build-system ruby) + #:use-module ((guix build-system ruby) #:select (rubygems-uri)) #:export (gem->guix-package %gem-updater gem-recursive-import)) +;; Gems as defined by the API at . +(define-json-mapping make-gem gem? + json->gem + (name gem-name) ;string + (platform gem-platform) ;string + (version gem-version) ;string + (authors gem-authors) ;string + (licenses gem-licenses "licenses" ;list of strings + vector->list) + (info gem-info) + (sha256 gem-sha256 "sha" ;bytevector + base16-string->bytevector) + (home-page gem-home-page "homepage_uri") ;string + (dependencies gem-dependencies "dependencies" ; + json->gem-dependencies)) + +(define-json-mapping make-gem-dependencies + gem-dependencies? + json->gem-dependencies + (development gem-dependencies-development ;list of + "development" + json->gem-dependency-list) + (runtime gem-dependencies-runtime ;list of + "runtime" + json->gem-dependency-list)) + +(define (json->gem-dependency-list vector) + (if vector + (map json->gem-dependency (vector->list vector)) + '())) + +(define-json-mapping make-gem-dependency gem-dependency? + json->gem-dependency + (name gem-dependency-name) ;string + (requirements gem-dependency-requirements)) ;string + + (define (rubygems-fetch name) - "Return an alist representation of the RubyGems metadata for the package NAME, -or #f on failure." - (json-fetch - (string-append "https://rubygems.org/api/v1/gems/" name ".json"))) + "Return a record for the package NAME, or #f on failure." + (and=> (json-fetch + (string-append "https://rubygems.org/api/v1/gems/" name ".json")) + json->gem)) (define (ruby-package-name name) "Given the NAME of a package on RubyGems, return a Guix-compliant name for @@ -50,41 +86,6 @@ the package." (snake-case name) (string-append "ruby-" (snake-case name)))) -(define (hex-string->bytevector str) - "Convert the hexadecimal encoded string STR to a bytevector." - (define hex-char->int - (match-lambda - (#\0 0) - (#\1 1) - (#\2 2) - (#\3 3) - (#\4 4) - (#\5 5) - (#\6 6) - (#\7 7) - (#\8 8) - (#\9 9) - (#\a 10) - (#\b 11) - (#\c 12) - (#\d 13) - (#\e 14) - (#\f 15))) - - (define (read-byte i) - (let ((j (* 2 i))) - (+ (hex-char->int (string-ref str (1+ j))) - (* (hex-char->int (string-ref str j)) 16)))) - - (let* ((len (/ (string-length str) 2)) - (bv (make-bytevector len))) - (let loop ((i 0)) - (if (= i len) - bv - (begin - (bytevector-u8-set! bv i (read-byte i)) - (loop (1+ i))))))) - (define (make-gem-sexp name version hash home-page synopsis description dependencies licenses) "Return the `package' s-expression for a Ruby package with the given NAME, @@ -97,8 +98,7 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." (uri (rubygems-uri ,name version)) (sha256 (base32 - ,(bytevector->nix-base32-string - (hex-string->bytevector hash)))))) + ,(bytevector->nix-base32-string hash))))) (build-system ruby-build-system) ,@(if (null? dependencies) '() @@ -120,31 +120,25 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." (define* (gem->guix-package package-name #:optional (repo 'rubygems) version) "Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the `package' s-expression corresponding to that package, or #f on failure." - (let ((package (rubygems-fetch package-name))) - (and package - (let* ((name (assoc-ref package "name")) - (version (assoc-ref package "version")) - (hash (assoc-ref package "sha")) - (synopsis (assoc-ref package "info")) ; nothing better to use - (description (beautify-description - (assoc-ref package "info"))) - (home-page (assoc-ref package "homepage_uri")) - (dependencies-names (map (lambda (dep) (assoc-ref dep "name")) - (vector->list - (assoc-ref* package - "dependencies" - "runtime")))) - (dependencies (map (lambda (dep) - (if (string=? dep "bundler") - "bundler" ; special case, no prefix - (ruby-package-name dep))) - dependencies-names)) - (licenses (map string->license - (vector->list - (assoc-ref package "licenses"))))) - (values (make-gem-sexp name version hash home-page synopsis - description dependencies licenses) - dependencies-names))))) + (let ((gem (rubygems-fetch package-name))) + (if gem + (let* ((dependencies-names (map gem-dependency-name + (gem-dependencies-runtime + (gem-dependencies gem)))) + (dependencies (map (lambda (dep) + (if (string=? dep "bundler") + "bundler" ; special case, no prefix + (ruby-package-name dep))) + dependencies-names)) + (licenses (map string->license (gem-licenses gem)))) + (values (make-gem-sexp (gem-name gem) (gem-version gem) + (gem-sha256 gem) (gem-home-page gem) + (gem-info gem) + (beautify-description (gem-info gem)) + dependencies + licenses) + dependencies-names)) + (values #f '())))) (define (guix-package->gem-name package) "Given a PACKAGE built from rubygems.org, return the name of the @@ -185,9 +179,9 @@ package on RubyGems." (define (latest-release package) "Return an for the latest release of PACKAGE." (let* ((gem-name (guix-package->gem-name package)) - (metadata (rubygems-fetch gem-name)) - (version (assoc-ref metadata "version")) - (url (rubygems-uri gem-name version))) + (gem (rubygems-fetch gem-name)) + (version (gem-version gem)) + (url (rubygems-uri gem-name version))) (upstream-source (package (package-name package)) (version version) -- cgit v1.2.3 From c24fe4a52057ea3390faf59fd672a617eff34aea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 5 Feb 2020 16:03:43 +0100 Subject: import: gem: Deal with unavailable licensing info. Fixes . Reported by Seth . * guix/import/gem.scm ()[licenses]: Adjust for non-vector licenses. * tests/gem.scm (test-bar-json): Change "licenses" to 'null'. ("gem-recursive-import"): Adjust accordingly. --- guix/import/gem.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/gem.scm b/guix/import/gem.scm index f4589b98b3..bd5d5b3569 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -44,7 +44,12 @@ (version gem-version) ;string (authors gem-authors) ;string (licenses gem-licenses "licenses" ;list of strings - vector->list) + (lambda (licenses) + ;; This is sometimes #nil (the JSON 'null' value). Arrange + ;; to always return a list. + (cond ((not licenses) '()) + ((vector? licenses) (vector->list licenses)) + (else '())))) (info gem-info) (sha256 gem-sha256 "sha" ;bytevector base16-string->bytevector) -- cgit v1.2.3 From 9d0dfd9a9a7c43363a4e140c20d49f119fe6f2e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20K=C4=85dzio=C5=82ka?= Date: Wed, 5 Feb 2020 19:45:48 +0100 Subject: import: pypi: Support exporting packages with .zip source. * guix/import/pypi.scm (make-pypi-sexp): Rename test-inputs to native-inputs. Restructure the way pypi-uri parameters are generated. Use pypi-uri's extension parameter when required. Add "unzip" to native inputs when the package source is a zip file. Signed-off-by: Marius Bakke --- guix/import/pypi.scm | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 354cae9c4c..6897f42be3 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2019 Maxim Cournoyer +;;; Copyright © 2020 Jakub Kądziołka ;;; ;;; This file is part of GNU Guix. ;;; @@ -363,7 +364,11 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (receive (guix-dependencies upstream-dependencies) (compute-inputs source-url wheel-url temp) (match guix-dependencies - ((required-inputs test-inputs) + ((required-inputs native-inputs) + (when (string-suffix? ".zip" source-url) + (set! native-inputs (cons + '("unzip" ,unzip) + native-inputs))) (values `(package (name ,(python->package-name name)) @@ -371,20 +376,29 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (source (origin (method url-fetch) - ;; PyPI URL are case sensitive, but sometimes a project - ;; named using mixed case has a URL using lower case, so - ;; we must work around this inconsistency. For actual - ;; examples, compare the URLs of the "Deprecated" and - ;; "uWSGI" PyPI packages. - (uri ,(if (string-contains source-url name) - `(pypi-uri ,name version) - `(pypi-uri ,(string-downcase name) version))) + (uri (pypi-uri + ;; PyPI URL are case sensitive, but sometimes + ;; a project named using mixed case has a URL + ;; using lower case, so we must work around this + ;; inconsistency. For actual examples, compare + ;; the URLs of the "Deprecated" and "uWSGI" PyPI + ;; packages. + ,(if (string-contains source-url name) + name + (string-downcase name)) + version + ;; Some packages have been released as `.zip` + ;; instead of the more common `.tar.gz`. For + ;; example, see "path-and-address". + ,@(if (string-suffix? ".zip" source-url) + '(".zip") + '()))) (sha256 (base32 ,(guix-hash-url temp))))) (build-system python-build-system) ,@(maybe-inputs required-inputs 'propagated-inputs) - ,@(maybe-inputs test-inputs 'native-inputs) + ,@(maybe-inputs native-inputs 'native-inputs) (home-page ,home-page) (synopsis ,synopsis) (description ,description) -- cgit v1.2.3 From c35747499411d4efc7b437d63745a6dbc6910df4 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 3 Feb 2020 18:05:02 +0100 Subject: git: Add ssh authentication support. If Guile-Git revision is >= 0.3.0, use SSH agent authentication method for both clone and fetch calls. * guix/git.scm (auth-supported?): New variable, (clone*): set auth-method to ssh-agent if the variable above is true, (update-cached-checkout): ditto. --- guix/git.scm | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index a12f1eec8e..341a2b8dda 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Mathieu Othacehe +;;; Copyright © 2017, 2020 Mathieu Othacehe ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. @@ -108,6 +108,10 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables." (string-append "R:" url) url)))))) +;; Authentication appeared in Guile-Git 0.3.0, check if it is available. +(define auth-supported? + (false-if-exception (resolve-interface '(git auth)))) + (define (clone* url directory) "Clone git repository at URL into DIRECTORY. Upon failure, make sure no empty directory is left behind." @@ -119,7 +123,13 @@ make sure no empty directory is left behind." ;; value in Guile-Git: . (if (module-defined? (resolve-interface '(git)) 'clone-init-options) - (clone url directory (clone-init-options)) + (let ((auth-method (and auth-supported? + (%make-auth-ssh-agent)))) + (clone url directory + (if auth-supported? + (make-clone-options + #:fetch-options (make-fetch-options auth-method)) + (clone-init-options)))) (clone url directory))) (lambda _ (false-if-exception (rmdir directory))))) @@ -276,12 +286,17 @@ When RECURSIVE? is true, check out submodules as well, if any." (with-libgit2 (let* ((cache-exists? (openable-repository? cache-directory)) (repository (if cache-exists? - (repository-open cache-directory) + (repository-open (pk cache-directory)) (clone* url cache-directory)))) ;; Only fetch remote if it has not been cloned just before. (when (and cache-exists? (not (reference-available? repository ref))) - (remote-fetch (remote-lookup repository "origin"))) + (if auth-supported? + (let ((auth-method (and auth-supported? + (%make-auth-ssh-agent)))) + (remote-fetch (remote-lookup repository "origin") + #:fetch-options (make-fetch-options auth-method))) + (remote-fetch (remote-lookup repository "origin")))) (when recursive? (update-submodules repository #:log-port log-port)) (let ((oid (switch-to-ref repository canonical-ref))) -- cgit v1.2.3 From e3e1a7ba08af2d58c47264c543617e499c239444 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Thu, 6 Feb 2020 17:14:39 +0100 Subject: git: Remove leftover pk call. * guix/git.scm (update-cached-checkout): Remove leftover pk call. --- guix/git.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index 341a2b8dda..ca5dbfba1c 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -286,7 +286,7 @@ When RECURSIVE? is true, check out submodules as well, if any." (with-libgit2 (let* ((cache-exists? (openable-repository? cache-directory)) (repository (if cache-exists? - (repository-open (pk cache-directory)) + (repository-open cache-directory) (clone* url cache-directory)))) ;; Only fetch remote if it has not been cloned just before. (when (and cache-exists? -- cgit v1.2.3 From e81344428726f3dae5d2a2e7bb296f46fcde6cc5 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Sun, 9 Feb 2020 23:12:16 +0100 Subject: Update e-mail address for Jakob L. Kreuze. As requested here: . * .mailmap: Add an entry for Jakob. * gnu/machine.scm, gnu/machine/digital-ocean.scm, gnu/machine/ssh.scm, gnu/packages/admin.scm, gnu/packages/i2p.scm, gnu/packages/music.scm, gnu/packages/web.scm, gnu/tests/reconfigure.scm, guix/scripts/deploy.scm, guix/scripts/system/reconfigure.scm: Update their e-mail address. --- guix/scripts/deploy.scm | 2 +- guix/scripts/system/reconfigure.scm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index bc0ceabd3f..ad05c333dc 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 David Thompson -;;; Copyright © 2019 Jakob L. Kreuze +;;; Copyright © 2019 Jakob L. Kreuze ;;; ;;; This file is part of GNU Guix. ;;; diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index 2f9dbb2508..77a72307b4 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2019 Christopher Baines -;;; Copyright © 2019 Jakob L. Kreuze +;;; Copyright © 2019 Jakob L. Kreuze ;;; ;;; This file is part of GNU Guix. ;;; -- cgit v1.2.3 From a063bac618c36658dbb1dbf4a602172cae22975f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 7 Feb 2020 15:24:28 +0100 Subject: git: Add missing exports for . * guix/git.scm (): Export 'git-checkout-commit' and 'git-checkout-recursive?'. --- guix/git.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index ca5dbfba1c..b1ce3ea451 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -46,7 +46,9 @@ git-checkout git-checkout? git-checkout-url - git-checkout-branch)) + git-checkout-branch + git-checkout-commit + git-checkout-recursive?)) (define %repository-cache-directory (make-parameter (string-append (cache-directory #:ensure? #f) -- cgit v1.2.3 From 3d2f29382de2d0ee852745cc002dfe2b5d22e1c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 11 Feb 2020 10:03:22 +0100 Subject: swh: Remove 'id' field from . The "id" field has been removed upstream: https://sympa.inria.fr/sympa/arc/swh-devel/2020-02/msg00005.html * guix/swh.scm ()[id]: Remove. --- guix/swh.scm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/swh.scm b/guix/swh.scm index 3abf9aa1b5..8bdf9965f6 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019 Ludovic Courtès +;;; Copyright © 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,7 +39,6 @@ request-rate-limit-reached? origin? - origin-id origin-type origin-url origin-visits @@ -247,7 +246,6 @@ FALSE-IF-404? is true, return #f upon 404 responses." ;; (define-json-mapping make-origin origin? json->origin - (id origin-id) (visits-url origin-visits-url "origin_visits_url") (type origin-type) (url origin-url)) -- cgit v1.2.3 From 1d88470e1001fa5a9c9235166a47ecbbc67eeeec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 11 Feb 2020 12:17:33 +0100 Subject: describe: Remove dependency on (guix scripts pull). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Until now, 'guix describe' would perform ~3K stat calls and ~1K openat calls because it was pulling (guix scripts pull), which in turn pulls in many (gnu packages …) modules. * guix/scripts/pull.scm (display-profile-content, %vcs-web-views) (channel-commit-hyperlink): Move to... * guix/scripts/describe.scm: ... here. Remove import of (guix scripts pull). --- guix/scripts/describe.scm | 80 +++++++++++++++++++++++++++++++++++++++++++++-- guix/scripts/pull.scm | 80 +++-------------------------------------------- 2 files changed, 82 insertions(+), 78 deletions(-) (limited to 'guix') diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index 99a88c50fa..f13f221da9 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019 Ludovic Courtès +;;; Copyright © 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. @@ -20,18 +20,22 @@ (define-module (guix scripts describe) #:use-module ((guix config) #:select (%guix-version)) #:use-module ((guix ui) #:hide (display-profile-content)) + #:use-module ((guix utils) #:select (string-replace-substring)) #:use-module (guix channels) #:use-module (guix scripts) #:use-module (guix describe) #:use-module (guix profiles) - #:use-module ((guix scripts pull) #:select (display-profile-content)) #:use-module (git) #:use-module (json) #:use-module (srfi srfi-1) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:autoload (ice-9 pretty-print) (pretty-print) - #:export (guix-describe)) + #:use-module (web uri) + #:export (display-profile-content + channel-commit-hyperlink + + guix-describe)) ;;; @@ -173,6 +177,76 @@ in the format specified by FMT." channels)))) (display-package-search-path fmt)) +(define (display-profile-content profile number) + "Display the packages in PROFILE, generation NUMBER, in a human-readable +way and displaying details about the channel's source code." + (display-generation profile number) + (for-each (lambda (entry) + (format #t " ~a ~a~%" + (manifest-entry-name entry) + (manifest-entry-version entry)) + (match (assq 'source (manifest-entry-properties entry)) + (('source ('repository ('version 0) + ('url url) + ('branch branch) + ('commit commit) + _ ...)) + (let ((channel (channel (name 'nameless) + (url url) + (branch branch) + (commit commit)))) + (format #t (G_ " repository URL: ~a~%") url) + (when branch + (format #t (G_ " branch: ~a~%") branch)) + (format #t (G_ " commit: ~a~%") + (if (supports-hyperlinks?) + (channel-commit-hyperlink channel commit) + commit)))) + (_ #f))) + + ;; Show most recently installed packages last. + (reverse + (manifest-entries + (profile-manifest (if (zero? number) + profile + (generation-file-name profile number))))))) + +(define %vcs-web-views + ;; Hard-coded list of host names and corresponding web view URL templates. + ;; TODO: Allow '.guix-channel' files to specify a URL template. + (let ((labhub-url (lambda (repository-url commit) + (string-append + (if (string-suffix? ".git" repository-url) + (string-drop-right repository-url 4) + repository-url) + "/commit/" commit)))) + `(("git.savannah.gnu.org" + ,(lambda (repository-url commit) + (string-append (string-replace-substring repository-url + "/git/" "/cgit/") + "/commit/?id=" commit))) + ("notabug.org" ,labhub-url) + ("framagit.org" ,labhub-url) + ("gitlab.com" ,labhub-url) + ("gitlab.inria.fr" ,labhub-url) + ("github.com" ,labhub-url)))) + +(define* (channel-commit-hyperlink channel + #:optional + (commit (channel-commit channel))) + "Return a hyperlink for COMMIT in CHANNEL, using COMMIT as the hyperlink's +text. The hyperlink links to a web view of COMMIT, when available." + (let* ((url (channel-url channel)) + (uri (string->uri url)) + (host (and uri (uri-host uri)))) + (if host + (match (assoc host %vcs-web-views) + (#f + commit) + ((_ template) + (hyperlink (template url commit) commit))) + commit))) + ;;; ;;; Entry point. diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index cb1be989e1..51d4da209a 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -18,7 +18,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix scripts pull) - #:use-module (guix ui) + #:use-module ((guix ui) #:hide (display-profile-content)) #:use-module (guix colors) #:use-module (guix utils) #:use-module ((guix status) #:select (with-status-verbosity)) @@ -37,6 +37,7 @@ inferior-available-packages close-inferior) #:use-module (guix scripts build) + #:use-module (guix scripts describe) #:autoload (guix build utils) (which) #:use-module ((guix build syscalls) #:select (with-file-lock/no-wait)) @@ -56,13 +57,12 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) - #:use-module (web uri) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module (ice-9 format) - #:export (display-profile-content - channel-list - channel-commit-hyperlink + #:re-export (display-profile-content + channel-commit-hyperlink) + #:export (channel-list with-git-error-handling guix-pull)) @@ -188,42 +188,6 @@ Download and deploy the latest version of Guix.\n")) %standard-build-options)) -(define %vcs-web-views - ;; Hard-coded list of host names and corresponding web view URL templates. - ;; TODO: Allow '.guix-channel' files to specify a URL template. - (let ((labhub-url (lambda (repository-url commit) - (string-append - (if (string-suffix? ".git" repository-url) - (string-drop-right repository-url 4) - repository-url) - "/commit/" commit)))) - `(("git.savannah.gnu.org" - ,(lambda (repository-url commit) - (string-append (string-replace-substring repository-url - "/git/" "/cgit/") - "/commit/?id=" commit))) - ("notabug.org" ,labhub-url) - ("framagit.org" ,labhub-url) - ("gitlab.com" ,labhub-url) - ("gitlab.inria.fr" ,labhub-url) - ("github.com" ,labhub-url)))) - -(define* (channel-commit-hyperlink channel - #:optional - (commit (channel-commit channel))) - "Return a hyperlink for COMMIT in CHANNEL, using COMMIT as the hyperlink's -text. The hyperlink links to a web view of COMMIT, when available." - (let* ((url (channel-url channel)) - (uri (string->uri url)) - (host (and uri (uri-host uri)))) - (if host - (match (assoc host %vcs-web-views) - (#f - commit) - ((_ template) - (hyperlink (template url commit) commit))) - commit))) - (define* (display-profile-news profile #:key concise? current-is-newer?) "Display what's up in PROFILE--new packages, and all that. If @@ -559,40 +523,6 @@ true, display what would be built without actually building it." ;;; Queries. ;;; -(define (display-profile-content profile number) - "Display the packages in PROFILE, generation NUMBER, in a human-readable -way and displaying details about the channel's source code." - (display-generation profile number) - (for-each (lambda (entry) - (format #t " ~a ~a~%" - (manifest-entry-name entry) - (manifest-entry-version entry)) - (match (assq 'source (manifest-entry-properties entry)) - (('source ('repository ('version 0) - ('url url) - ('branch branch) - ('commit commit) - _ ...)) - (let ((channel (channel (name 'nameless) - (url url) - (branch branch) - (commit commit)))) - (format #t (G_ " repository URL: ~a~%") url) - (when branch - (format #t (G_ " branch: ~a~%") branch)) - (format #t (G_ " commit: ~a~%") - (if (supports-hyperlinks?) - (channel-commit-hyperlink channel commit) - commit)))) - (_ #f))) - - ;; Show most recently installed packages last. - (reverse - (manifest-entries - (profile-manifest (if (zero? number) - profile - (generation-file-name profile number))))))) - (define (indented-string str indent) "Return STR with each newline preceded by IDENT spaces." (define indent-string -- cgit v1.2.3 From a65ffbea50021411b62c34fb9262a20626cf221a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 11 Feb 2020 15:43:33 +0100 Subject: ui: Fix typo in comment. Reported by Vincent Legoll . * guix/ui.scm (call-with-error-handling): Remove "come" in comment. --- guix/ui.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index a47dafecd4..dce97fb7b9 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -771,7 +771,7 @@ directories:~{ ~a~}~%") (display-hint (condition-fix-hint c)) (exit 1)) - ;; On Guile 3.0.0, exceptions such as 'unbound-variable' come are + ;; On Guile 3.0.0, exceptions such as 'unbound-variable' are ;; compound and include a '&message'. However, that message only ;; contains the format string. Thus, special-case it here to ;; avoid displaying a bare format string. -- cgit v1.2.3 From 46c5c917ba2d8c73252f40376d653af70381d13a Mon Sep 17 00:00:00 2001 From: Jack Hill Date: Tue, 11 Feb 2020 16:20:43 -0600 Subject: build: go-build-system: Disable Go module support. This allows for upgrading the Go compiler without overhauling go-build-system first. * guix/build/go-build-system.scm (setup-go-environment): Set GO111MODULE to off. Signed-off-by: Alex Griffin --- guix/build/go-build-system.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'guix') diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index 4bc0156a88..0d15f978cd 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016 Petter ;;; Copyright © 2017, 2019 Leo Famulari ;;; Copyright © 2019 Maxim Cournoyer +;;; Copyright © 2020 Jack Hill ;;; ;;; This file is part of GNU Guix. ;;; @@ -141,6 +142,10 @@ dependencies, so it should be self-contained." ;; Using the current working directory as GOPATH makes it easier for packagers ;; who need to manipulate the unpacked source code. (setenv "GOPATH" (getcwd)) + ;; Go 1.13 uses go modules by default. The go build system does not + ;; currently support modules, so turn modules off to continue using the old + ;; GOPATH behavior. + (setenv "GO111MODULE" "off") (setenv "GOBIN" (string-append (assoc-ref outputs "out") "/bin")) (let ((tmpdir (tmpnam))) (match (go-inputs inputs) -- cgit v1.2.3 From 11415d35064cdba5cec1139aede18099cfa14547 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Wed, 5 Feb 2020 18:47:31 +0100 Subject: guix build: Add '--manifest' option. * guix/scripts/build.scm (show-help): Document --manifest argument. (options->things-to-build): When given a manifest, evaluate all the entries. * tests/guix-build.sh: Add test for --manifest. * doc/guix.texi (Additional Build Options): Mention --manifest. * etc/completion/bash/guix: Complete file name if 'guix build' argument is -m. --- guix/scripts/build.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index f054fc2bce..eedf6bf6a8 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver +;;; Copyright © 2020 Marius Bakke ;;; ;;; This file is part of GNU Guix. ;;; @@ -34,6 +35,7 @@ #:use-module (guix monads) #:use-module (guix gexp) + #:use-module (guix profiles) #:autoload (guix http-client) (http-fetch http-get-error?) #:use-module (ice-9 format) #:use-module (ice-9 match) @@ -680,6 +682,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) -f, --file=FILE build the package or derivation that the code within FILE evaluates to")) (display (G_ " + -m, --manifest=FILE build the packages that the manifest given in FILE + evaluates to")) + (display (G_ " -S, --source build the packages' source derivations")) (display (G_ " --sources[=TYPE] build source derivations; TYPE may optionally be one @@ -768,6 +773,9 @@ must be one of 'package', 'all', or 'transitive'~%") (option '(#\f "file") #t #f (lambda (opt name arg result) (alist-cons 'file arg result))) + (option '(#\m "manifest") #t #f + (lambda (opt name arg result) + (alist-cons 'manifest arg result))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) @@ -804,6 +812,14 @@ build---packages, gexps, derivations, and so on." (for-each validate-type lst) lst)) + ;; Note: Taken from (guix scripts refresh). + (define (manifest->packages manifest) + "Return the list of packages in MANIFEST." + (filter-map (lambda (entry) + (let ((item (manifest-entry-item entry))) + (if (package? item) item #f))) + (manifest-entries manifest))) + (append-map (match-lambda (('argument . (? string? spec)) (cond ((derivation-path? spec) @@ -827,6 +843,9 @@ build---packages, gexps, derivations, and so on." (list (specification->package spec))))) (('file . file) (ensure-list (load* file (make-user-module '())))) + (('manifest . manifest) + (manifest->packages + (load* manifest (make-user-module '((guix profiles) (gnu)))))) (('expression . str) (ensure-list (read/eval str))) (('argument . (? derivation? drv)) -- cgit v1.2.3