From 789fc77bef3601ceb49ea96d84dbe9e9286dca75 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Wed, 19 Dec 2018 17:02:38 -0600 Subject: refresh: github: updates for origins using 'git-fetch'. * guix/import/github.scm (updated-github-url): Respond with the repository url for the 'git-fetch' fetch method. (github-package?): Simplify boolean expression. (github-repository, github-user-slash-repository): Strip trailing ".git" from project if present. (latest-release): Recognize a 'git-reference'. --- guix/import/github.scm | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/guix/import/github.scm b/guix/import/github.scm index af9f56e1dc..ad662e7b02 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ben Woodcroft ;;; Copyright © 2017, 2018 Ludovic Courtès +;;; Copyright © 2018 Eric Bavier ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,7 @@ #:use-module (srfi srfi-34) #:use-module (guix utils) #:use-module ((guix download) #:prefix download:) + #:use-module ((guix git-download) #:prefix download:) #:use-module (guix import utils) #:use-module (guix import json) #:use-module (guix packages) @@ -52,6 +54,7 @@ false if none is recognized" (github-user-slash-repository url))) (repo (github-repository url))) (cond + ((string-suffix? ".git" url) url) ((string-suffix? (string-append "/tarball/v" version) url) (string-append prefix "/tarball/v" new-version)) ((string-suffix? (string-append "/tarball/" version) url) @@ -86,26 +89,29 @@ false if none is recognized" (#t #f))) ; Some URLs are not recognised. #f)) - (let ((source-url (and=> (package-source old-package) origin-uri)) + (let ((source-uri (and=> (package-source old-package) origin-uri)) (fetch-method (and=> (package-source old-package) origin-method))) - (if (eq? fetch-method download:url-fetch) - (match source-url - ((? string?) - (updated-url source-url)) - ((source-url ...) - (find updated-url source-url))) - #f))) + (cond + ((eq? fetch-method download:url-fetch) + (match source-uri + ((? string?) + (updated-url source-uri)) + ((source-uri ...) + (find updated-url source-uri)))) + ((eq? fetch-method download:git-fetch) + (updated-url (download:git-reference-url source-uri))) + (else #f)))) (define (github-package? package) "Return true if PACKAGE is a package from GitHub, else false." - (not (eq? #f (updated-github-url package "dummy")))) + (->bool (updated-github-url package "dummy"))) (define (github-repository url) "Return a string e.g. bedtools2 of the name of the repository, from a string URL of the form 'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz'" (match (string-split (uri-path (string->uri url)) #\/) ((_ owner project . rest) - (string-append project)))) + (string-append (basename project ".git"))))) (define (github-user-slash-repository url) "Return a string e.g. arq5x/bedtools2 of the owner and the name of the @@ -113,7 +119,7 @@ repository separated by a forward slash, from a string URL of the form 'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz'" (match (string-split (uri-path (string->uri url)) #\/) ((_ owner project . rest) - (string-append owner "/" project)))) + (string-append owner "/" (basename project ".git"))))) (define %github-token ;; Token to be passed to Github.com to avoid the 60-request per hour @@ -213,6 +219,8 @@ https://github.com/settings/tokens")) (match (origin-uri origin) ((? string? url) url) ;surely a github.com URL + ((? download:git-reference? ref) + (download:git-reference-url ref)) ((urls ...) (find (cut string-contains <> "github.com") urls)))) -- cgit v1.2.3 From b3d0617a55c62fe75af44707a3cd4138fa97e62d Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 3 Jan 2019 08:31:15 +0100 Subject: import: cran: Download tarballs only once. * guix/import/cran.scm (download): New procedure. (fetch-description, description->package): Use it. --- guix/import/cran.scm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index aaa1caf035..507e77ed79 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -161,6 +161,12 @@ bioconductor package NAME, or #F if the package is unknown." (bioconductor-packages-list)) (cut assoc-ref <> "Version"))) +;; Little helper to download URLs only once. +(define download + (memoize + (lambda (url) + (with-store store (download-to-store store url))))) + (define (fetch-description repository name) "Return an alist of the contents of the DESCRIPTION file for the R package NAME in the given REPOSITORY, or #f in case of failure. NAME is @@ -183,7 +189,7 @@ from ~s: ~a (~s)~%" ;; download the source tarball, and then extract the DESCRIPTION file. (and-let* ((version (latest-bioconductor-package-version name)) (url (car (bioconductor-uri name version))) - (tarball (with-store store (download-to-store store url)))) + (tarball (download url))) (call-with-temporary-directory (lambda (dir) (parameterize ((current-error-port (%make-void-port "rw+")) @@ -299,7 +305,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file." ((url rest ...) url) ((? string? url) url) (_ #f))) - (tarball (with-store store (download-to-store store source-url))) + (tarball (download source-url)) (sysdepends (append (if (needs-zlib? tarball) '("zlib") '()) (map string-downcase (listify meta "SystemRequirements")))) -- cgit v1.2.3 From 632ea817b88974f616e159ef7dcc174901a77aa3 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 3 Jan 2019 08:32:05 +0100 Subject: import: cran: Use HTTPS. * guix/import/cran.scm (%cran-url): Use HTTPS. --- guix/import/cran.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 507e77ed79..243203928d 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -125,7 +125,7 @@ package definition." ((package-inputs ...) `((,type (,'quasiquote ,(format-inputs package-inputs))))))) -(define %cran-url "http://cran.r-project.org/web/packages/") +(define %cran-url "https://cran.r-project.org/web/packages/") (define %bioconductor-url "https://bioconductor.org/packages/") ;; The latest Bioconductor release is 3.8. Bioconductor packages should be -- cgit v1.2.3 From 7bb6420c5a4b1db46651f044cec9d804c1de56a3 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 3 Jan 2019 08:32:50 +0100 Subject: import: cran: Abort if no description could be fetched. * guix/import/cran.scm (cran->guix-package): Only proceed if a valid description could be fetched. --- guix/import/cran.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 243203928d..ac9097073e 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -358,7 +358,8 @@ s-expression corresponding to that package, or #f on failure." (eq? repo 'bioconductor)) ;; Retry import from CRAN (cran->guix-package package-name 'cran) - (description->package repo description)))))) + (and description + (description->package repo description))))))) (define* (cran-recursive-import package-name #:optional (repo 'gnu)) (recursive-import package-name repo -- cgit v1.2.3 From 2a13642b6549727e7d93be871041465cacfb167f Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 3 Jan 2019 08:33:46 +0100 Subject: import: cran: Default to 'cran repo. * guix/import/cran.scm (cran-recursive-import): Default to 'cran repo. --- guix/import/cran.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index ac9097073e..15163bd165 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -361,7 +361,7 @@ s-expression corresponding to that package, or #f on failure." (and description (description->package repo description))))))) -(define* (cran-recursive-import package-name #:optional (repo 'gnu)) +(define* (cran-recursive-import package-name #:optional (repo 'cran)) (recursive-import package-name repo #:repo->guix-package cran->guix-package #:guix-name cran-guix-name)) -- cgit v1.2.3 From 9ec154f51f52ee3702c611637e96ccb0d59f543a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 5 Jan 2019 00:01:18 +0100 Subject: gexp: Lowering a honors SYSTEM and TARGET. * guix/gexp.scm (computed-file-compiler): Pass #:system and #:target to 'gexp->derivation'. * tests/gexp.scm ("lower-object, computed-file, #:system"): New test. --- guix/gexp.scm | 7 ++++--- tests/gexp.scm | 20 +++++++++++++++++++- 2 files changed, 23 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index 88cabc8ed5..febd72a904 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; Copyright © 2018 Jan Nieuwenhuizen ;;; @@ -388,8 +388,9 @@ This is the declarative counterpart of 'gexp->derivation'." (mlet %store-monad ((guile (lower-object guile system #:target target))) (apply gexp->derivation name gexp #:guile-for-build guile - options)) - (apply gexp->derivation name gexp options))))) + #:system system #:target target options)) + (apply gexp->derivation name gexp + #:system system #:target target options))))) (define-record-type (%program-file name gexp guile path) diff --git a/tests/gexp.scm b/tests/gexp.scm index 35a76a496e..c4b437cd49 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -1171,6 +1171,24 @@ (string=? (readlink (string-append comp "/text")) text))))))) +(test-equal "lower-object, computed-file, #:system" + '("mips64el-linux") + (run-with-store %store + (let* ((exp #~(symlink #$coreutils #$output)) + (computed (computed-file "computed" exp + #:guile %bootstrap-guile))) + ;; Make sure that the SYSTEM argument to 'lower-object' is honored. + (mlet* %store-monad ((drv (lower-object computed "mips64el-linux")) + (refs (references* (derivation-file-name drv)))) + (return (delete-duplicates + (filter-map (lambda (file) + (and (string-suffix? ".drv" file) + (let ((drv (read-derivation-from-file + file))) + (derivation-system drv)))) + (cons (derivation-file-name drv) + refs)))))))) + (test-assert "lower-object & gexp-input-error?" (guard (c ((gexp-input-error? c) (gexp-error-invalid-input c))) -- cgit v1.2.3 From ec651f2562241064db7dd0d2a181cd85c787b541 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 5 Jan 2019 00:04:12 +0100 Subject: guix build: Honor '--system' for file-like objects and gexps. Fixes a bug whereby "guix build -f file.scm -s SYSTEM" would not honor SYSTEM when 'file.scm' returns a gexp or a file-like object. * guix/scripts/build.scm (options->derivations): Pass #:system to 'run-with-store' in the 'file-like?' and 'gexp?' cases. --- guix/scripts/build.scm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 0b7da3189e..564bdf0ced 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -788,13 +788,15 @@ package '~a' has no source~%") ((? file-like? obj) (list (run-with-store store (lower-object obj system - #:target (assoc-ref opts 'target))))) + #:target (assoc-ref opts 'target)) + #:system system))) ((? gexp? gexp) (list (run-with-store store (mbegin %store-monad (set-guile-for-build (default-guile)) (gexp->derivation "gexp" gexp - #:system system)))))) + #:system system)) + #:system system)))) (map (cut transform store <>) (options->things-to-build opts)))))) -- cgit v1.2.3 From a173f09811baa2f368fd77dd7a7e3552e2e56040 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 5 Jan 2019 00:06:04 +0100 Subject: ui: It's 2019 now! * guix/ui.scm (show-version-and-exit): Change year to 2019. --- guix/ui.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 44336ee8fd..4c31246920 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2013, 2018 Mark H Weaver ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Cyril Roelandt @@ -466,7 +466,7 @@ See the \"Application Setup\" section in the manual, for more info.\n"))))) "Display version information for COMMAND and `(exit 0)'." (simple-format #t "~a (~a) ~a~%" command %guix-package-name %guix-version) - (format #t "Copyright ~a 2018 ~a" + (format #t "Copyright ~a 2019 ~a" ;; TRANSLATORS: Translate "(C)" to the copyright symbol ;; (C-in-a-circle), if this symbol is available in the user's ;; locale. Otherwise, do not translate "(C)"; leave it as-is. */ -- cgit v1.2.3 From 18524466bb25a1926277b1111d15fb378ff7941e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 5 Jan 2019 23:04:58 +0100 Subject: git-download: 'git-fetch' really returns #f upon error. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This allows the fallback code in (guix git-download) to actually run. Regression introduced in commit 329dabe13bf98b899b907b45565434c5140804f5. Fixes . Reported by Björn Höfling . * guix/build/git.scm (git-fetch): Guard against 'invoke-error?' and really return #f upon failure. --- guix/build/git.scm | 54 +++++++++++++++++++++++++++++++++--------------------- 1 file changed, 33 insertions(+), 21 deletions(-) (limited to 'guix') diff --git a/guix/build/git.scm b/guix/build/git.scm index 2d1700a9b9..5b90033c4d 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2016 Ludovic Courtès +;;; Copyright © 2014, 2016, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,8 @@ (define-module (guix build git) #:use-module (guix build utils) + #:use-module (srfi srfi-34) + #:use-module (ice-9 format) #:export (git-fetch)) ;;; Commentary: @@ -39,31 +41,41 @@ recursively. Return #t on success, #f otherwise." (mkdir-p directory) - (with-directory-excursion directory - (invoke git-command "init") - (invoke git-command "remote" "add" "origin" url) - (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit)) - (invoke git-command "checkout" "FETCH_HEAD") - (begin - (setvbuf (current-output-port) 'line) - (format #t "Failed to do a shallow fetch; retrying a full fetch...~%") - (invoke git-command "fetch" "origin") - (invoke git-command "checkout" commit))) - (when recursive? - ;; Now is the time to fetch sub-modules. - (unless (zero? (system* git-command "submodule" "update" - "--init" "--recursive")) - (error "failed to fetch sub-modules" url)) + (guard (c ((invoke-error? c) + (format (current-error-port) + "git-fetch: '~a~{ ~a~}' failed with exit code ~a~%" + (invoke-error-program c) + (invoke-error-arguments c) + (or (invoke-error-exit-status c) ;XXX: not quite accurate + (invoke-error-stop-signal c) + (invoke-error-term-signal c))) + (delete-file-recursively directory) + #f)) + (with-directory-excursion directory + (invoke git-command "init") + (invoke git-command "remote" "add" "origin" url) + (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit)) + (invoke git-command "checkout" "FETCH_HEAD") + (begin + (setvbuf (current-output-port) 'line) + (format #t "Failed to do a shallow fetch; retrying a full fetch...~%") + (invoke git-command "fetch" "origin") + (invoke git-command "checkout" commit))) + (when recursive? + ;; Now is the time to fetch sub-modules. + (unless (zero? (system* git-command "submodule" "update" + "--init" "--recursive")) + (error "failed to fetch sub-modules" url)) - ;; In sub-modules, '.git' is a flat file, not a directory, - ;; so we can use 'find-files' here. - (for-each delete-file-recursively - (find-files directory "^\\.git$"))) + ;; In sub-modules, '.git' is a flat file, not a directory, + ;; so we can use 'find-files' here. + (for-each delete-file-recursively + (find-files directory "^\\.git$"))) ;; The contents of '.git' vary as a function of the current ;; status of the Git repo. Since we want a fixed output, this ;; directory needs to be taken out. (delete-file-recursively ".git") - #t)) + #t))) ;;; git.scm ends here -- cgit v1.2.3 From c070d1423fcbdc48e749545ecdf277404ab7d77d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 5 Jan 2019 23:10:04 +0100 Subject: git-download: Use 'invoke'. * guix/build/git.scm (git-fetch): Use 'invoke' instead of 'system*' for "git submodule update". --- guix/build/git.scm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/build/git.scm b/guix/build/git.scm index 5b90033c4d..669e38cd32 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -63,9 +63,7 @@ recursively. Return #t on success, #f otherwise." (invoke git-command "checkout" commit))) (when recursive? ;; Now is the time to fetch sub-modules. - (unless (zero? (system* git-command "submodule" "update" - "--init" "--recursive")) - (error "failed to fetch sub-modules" url)) + (invoke git-command "submodule" "update" "--init" "--recursive") ;; In sub-modules, '.git' is a flat file, not a directory, ;; so we can use 'find-files' here. -- cgit v1.2.3 From 012bf5c4c03e30633f137960bd0677e204c638a7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 6 Jan 2019 00:21:14 +0100 Subject: lint: Rename checker to 'github-url'. * guix/scripts/lint.scm (%checkers): Rename 'github-uri' to 'github-url' to match the documentation. --- guix/scripts/lint.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 2c1c7ec669..040480c1ac 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Cyril Roelandt ;;; Copyright © 2014, 2015 Eric Bavier -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2015, 2016 Mathieu Lirzin ;;; Copyright © 2016 Danny Milosavljevic ;;; Copyright © 2016 Hartmut Goebel @@ -1108,8 +1108,8 @@ or a list thereof") (description "Suggest 'mirror://' URLs") (check check-mirror-url)) (lint-checker - (name 'github-uri) - (description "Suggest GitHub URIs") + (name 'github-url) + (description "Suggest GitHub URLs") (check check-github-url)) (lint-checker (name 'source-file-name) -- cgit v1.2.3 From b5f8c2c88543158e8aca76aa98f9009f6b9e743a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Nov 2018 17:17:45 +0100 Subject: hydra: Compute jobs in an inferior. Previously we would rely on auto-compilation of all the Guix modules. The complete evaluation would take ~15mn on berlin.guixsd.org and require lots of RAM. This approach should be faster since potentially only part of the modules are rebuilt. Furthermore, as a side-effect, it builds the derivations that 'guix pull' uses. * build-aux/hydra/gnu-system.scm: Remove 'eval-when' form. (hydra-jobs): New procedure. * gnu/ci.scm (package->alist, qemu-jobs, system-test-jobs) (tarball-jobs): Return strings for the 'license' field. * guix/self.scm (compiled-guix)[*cli-modules*]: Add (gnu ci). --- build-aux/hydra/gnu-system.scm | 73 ++++++++++++++++++++++++++---------------- gnu/ci.scm | 20 +++++++++--- guix/self.scm | 3 +- 3 files changed, 62 insertions(+), 34 deletions(-) (limited to 'guix') diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index 150c2bdf4f..775bbd9db2 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -23,39 +23,56 @@ ;;; tool. ;;; -(use-modules (system base compile)) +(use-modules (guix inferior) (guix channels) + (guix) + (guix ui) + (srfi srfi-1) + (ice-9 match)) -(eval-when (expand load eval) +;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output +;; port to the bit bucket, let us write to the error port instead. +(setvbuf (current-error-port) _IOLBF) +(set-current-output-port (current-error-port)) - ;; Pre-load the compiler so we don't end up auto-compiling it. - (compile #t) +(define (hydra-jobs store arguments) + "Return a list of jobs where each job is a NAME/THUNK pair." + (define checkout + ;; Extract metadata about the 'guix' checkout. Its key in ARGUMENTS may + ;; vary, so pick up the first one that's neither 'subset' nor 'systems'. + (any (match-lambda + ((key . value) + (and (not (memq key '(systems subset))) + value))) + arguments)) - ;; Use our very own Guix modules. - (set! %fresh-auto-compile #t) + (define commit + (assq-ref checkout 'revision)) - ;; Ignore .go files except for Guile's. This is because our checkout in the - ;; store has mtime set to the epoch, and thus .go files look newer, even - ;; though they may not correspond. Use 'reverse' so that /gnu/store/…-guile - ;; comes before /run/current-system/profile. - (set! %load-compiled-path - (list - (dirname (dirname (search-path (reverse %load-compiled-path) - "ice-9/boot-9.go"))))) + (define source + (assq-ref checkout 'file-name)) - (and=> (assoc-ref (current-source-location) 'filename) - (lambda (file) - (let ((dir (canonicalize-path - (string-append (dirname file) "/../..")))) - (format (current-error-port) "prepending ~s to the load path~%" - dir) - (set! %load-path (cons dir %load-path)))))) + (define instance + (checkout->channel-instance source #:commit commit)) -(use-modules (gnu ci)) + (define derivation + ;; Compute the derivation of Guix for COMMIT. + (run-with-store store + (channel-instances->derivation (list instance)))) -;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output -;; port to the bit bucket, let us write to the error port instead. -(setvbuf (current-error-port) _IOLBF) -(set-current-output-port (current-error-port)) + (show-what-to-build store (list derivation)) + (build-derivations store (list derivation)) + + ;; Open an inferior for the just-built Guix. + (let ((inferior (open-inferior (derivation->output-path derivation)))) + (inferior-eval '(use-modules (gnu ci) (ice-9 match)) inferior) -;; Return the procedure from (gnu ci). -hydra-jobs + (map (match-lambda + ((name . fields) + ;; Hydra expects a thunk, so here it is. + (cons name (lambda () fields)))) + (inferior-eval-with-store inferior store + `(lambda (store) + (map (match-lambda + ((name . thunk) + (cons name (thunk)))) + (hydra-jobs store ',arguments))))))) diff --git a/gnu/ci.scm b/gnu/ci.scm index 7db7e6062f..c071f21e0a 100644 --- a/gnu/ci.scm +++ b/gnu/ci.scm @@ -27,7 +27,8 @@ #:use-module (guix derivations) #:use-module (guix monads) #:use-module (guix ui) - #:use-module ((guix licenses) #:select (gpl3+)) + #:use-module ((guix licenses) + #:select (gpl3+ license? license-name)) #:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix scripts system) #:select (read-operating-system)) #:use-module ((guix scripts pack) @@ -69,7 +70,16 @@ #:graft? #f))) (description . ,(package-synopsis package)) (long-description . ,(package-description package)) - (license . ,(package-license package)) + + ;; XXX: Hydra ignores licenses that are not a structure or a + ;; list thereof. + (license . ,(let loop ((license (package-license package))) + (match license + ((? license?) + (license-name license)) + ((lst ...) + (map loop license))))) + (home-page . ,(package-home-page package)) (maintainers . ("bug-guix@gnu.org")) (max-silent-time . ,(or (assoc-ref (package-properties package) @@ -133,7 +143,7 @@ SYSTEM." (description . "Stand-alone QEMU image of the GNU system") (long-description . "This is a demo stand-alone QEMU image of the GNU system.") - (license . ,gpl3+) + (license . ,(license-name gpl3+)) (max-silent-time . 600) (timeout . 3600) (home-page . ,%guix-home-page-url) @@ -194,7 +204,7 @@ system.") (description . ,(format #f "GuixSD '~a' system test" (system-test-name test))) (long-description . ,(system-test-description test)) - (license . ,gpl3+) + (license . ,(license-name gpl3+)) (max-silent-time . 600) (timeout . 3600) (home-page . ,%guix-home-page-url) @@ -217,7 +227,7 @@ system.") (description . "Stand-alone binary Guix tarball") (long-description . "This is a tarball containing binaries of Guix and all its dependencies, and ready to be installed on non-GuixSD distributions.") - (license . ,gpl3+) + (license . ,(license-name gpl3+)) (home-page . ,%guix-home-page-url) (maintainers . ("bug-guix@gnu.org")))) diff --git a/guix/self.scm b/guix/self.scm index f2db3dbf52..2664fd886f 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -624,7 +624,8 @@ assumed to be part of MODULES." (define *cli-modules* (scheme-node "guix-cli" - (scheme-modules* source "/guix/scripts") + (append (scheme-modules* source "/guix/scripts") + `((gnu ci))) (list *core-modules* *extra-modules* *core-package-modules* *package-modules* *system-modules*) -- cgit v1.2.3 From 46cf4cd6766d0a7186af513d33def5637ea8529c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 7 Jan 2019 12:08:33 +0100 Subject: Remove (guix build pull). This module had been unused since commit 5f93d97005897c2d859f0be1bdff34c88467ec61 (Oct. 2017). * guix/build/pull.scm: Delete. * Makefile.am (MODULES): Remove. --- Makefile.am | 3 +- guix/build/pull.scm | 154 ---------------------------------------------------- 2 files changed, 1 insertion(+), 156 deletions(-) delete mode 100644 guix/build/pull.scm (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index e74916cc0a..9f30d5b2b0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès # Copyright © 2013 Andreas Enge # Copyright © 2015, 2017 Alex Kost # Copyright © 2016, 2018 Mathieu Lirzin @@ -172,7 +172,6 @@ MODULES = \ guix/build/union.scm \ guix/build/profiles.scm \ guix/build/compile.scm \ - guix/build/pull.scm \ guix/build/rpath.scm \ guix/build/cvs.scm \ guix/build/svn.scm \ diff --git a/guix/build/pull.scm b/guix/build/pull.scm deleted file mode 100644 index a011e366f6..0000000000 --- a/guix/build/pull.scm +++ /dev/null @@ -1,154 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2016, 2017 Ludovic Courtès -;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix build pull) - #:use-module (guix modules) - #:use-module (guix build utils) - #:use-module (guix build compile) - #:use-module (ice-9 ftw) - #:use-module (ice-9 match) - #:use-module (ice-9 format) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-34) - #:export (build-guix)) - -;;; Commentary: -;;; -;;; Helpers for the 'guix pull' command to unpack and build Guix. -;;; -;;; Code: - -(define (has-all-its-dependencies? file) - "Return true if the dependencies of the module defined in FILE are -available, false otherwise." - (let ((module (call-with-input-file file - (lambda (port) - (match (read port) - (('define-module name _ ...) - name)))))) - ;; If one of the dependencies of MODULE is missing, we get a - ;; '&missing-dependency-error'. - (guard (c ((missing-dependency-error? c) #f)) - (source-module-closure (list module) #:select? (const #t))))) - -(define (all-scheme-files directory) - "Return a sorted list of Scheme files found in DIRECTORY." - ;; Load guix/ modules before gnu/ modules to get somewhat steadier - ;; progress reporting. - (sort (filter (cut string-suffix? ".scm" <>) - (find-files directory "\\.scm")) - (let ((guix (string-append directory "/guix")) - (gnu (string-append directory "/gnu"))) - (lambda (a b) - (or (and (string-prefix? guix a) - (string-prefix? gnu b)) - (string Date: Mon, 7 Jan 2019 13:55:32 +0100 Subject: lint: Avoid 'dirname' call at the top level. * guix/scripts/lint.scm (%distro-directory): Wrap in 'mlambda'. (check-patch-file-names): Adjust accordingly. --- guix/scripts/lint.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 040480c1ac..9acec48577 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -595,7 +595,8 @@ from ~a") 'home-page))))) (define %distro-directory - (dirname (search-path %load-path "gnu.scm"))) + (mlambda () + (dirname (search-path %load-path "gnu.scm")))) (define (check-patch-file-names package) "Emit a warning if the patches requires by PACKAGE are badly named or if the @@ -620,12 +621,12 @@ patch could not be found." 'patch-file-names)) ;; Check whether we're reaching tar's maximum file name length. - (let ((prefix (string-length %distro-directory)) + (let ((prefix (string-length (%distro-directory))) (margin (string-length "guix-0.13.0-10-123456789/")) (max 99)) (for-each (match-lambda ((? string? patch) - (when (> (+ margin (if (string-prefix? %distro-directory + (when (> (+ margin (if (string-prefix? (%distro-directory) patch) (- (string-length patch) prefix) (string-length patch))) -- cgit v1.2.3 From 6090b0beb035e53449ea344506b76dcc2de8ca0d Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Wed, 19 Dec 2018 22:43:43 +0100 Subject: import: opam: Add recursive option. * guix/script/import/opam.scm: Add recursive option. * guix/import/opam.scm (opam->guix-package): return two values. (opam-recursive-import): New variable. --- guix/import/opam.scm | 70 +++++++++++++++++++++++++++++--------------- guix/scripts/import/opam.scm | 27 +++++++++++++---- 2 files changed, 69 insertions(+), 28 deletions(-) (limited to 'guix') diff --git a/guix/import/opam.scm b/guix/import/opam.scm index c42a5d767d..cdf05e7d25 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -33,7 +33,8 @@ #:use-module (guix utils) #:use-module (guix import utils) #:use-module ((guix licenses) #:prefix license:) - #:export (opam->guix-package)) + #:export (opam->guix-package + opam-recursive-import)) ;; Define a PEG parser for the opam format (define-peg-pattern SP none (or " " "\n")) @@ -128,7 +129,6 @@ path to the repository." (else (string-append "ocaml-" name)))) (define (metadata-ref file lookup) - (pk 'file file 'lookup lookup) (fold (lambda (record acc) (match record ((record key val) @@ -166,6 +166,21 @@ path to the repository." (('conditional-value val condition) (if (native? condition) (dependency->input val) "")))) +(define (dependency->name dependency) + (match dependency + (('string-pat str) str) + (('conditional-value val condition) + (dependency->name val)))) + +(define (dependency-list->names lst) + (filter + (lambda (name) + (not (or + (string-prefix? "conf-" name) + (equal? name "ocaml") + (equal? name "findlib")))) + (map dependency->name lst))) + (define (ocaml-names->guix-names names) (map ocaml-name->guix-name (remove (lambda (name) @@ -193,32 +208,41 @@ path to the repository." (define (opam->guix-package name) (and-let* ((repository (get-opam-repository)) (version (find-latest-version name repository)) - (file (string-append repository "/packages/" name "/" name "." (pk 'version version) "/opam")) + (file (string-append repository "/packages/" name "/" name "." version "/opam")) (opam-content (get-metadata file)) - (url-dict (metadata-ref (pk 'metadata opam-content) "url")) + (url-dict (metadata-ref opam-content "url")) (source-url (metadata-ref url-dict "src")) (requirements (metadata-ref opam-content "depends")) + (dependencies (dependency-list->names requirements)) (inputs (dependency-list->inputs (depends->inputs requirements))) (native-inputs (dependency-list->inputs (depends->native-inputs requirements)))) (call-with-temporary-output-file (lambda (temp port) (and (url-fetch source-url temp) - `(package - (name ,(ocaml-name->guix-name name)) - (version ,(metadata-ref opam-content "version")) - (source - (origin - (method url-fetch) - (uri ,source-url) - (sha256 (base32 ,(guix-hash-url temp))))) - (build-system ocaml-build-system) - ,@(if (null? inputs) - '() - `((inputs ,(list 'quasiquote inputs)))) - ,@(if (null? native-inputs) - '() - `((native-inputs ,(list 'quasiquote native-inputs)))) - (home-page ,(metadata-ref opam-content "homepage")) - (synopsis ,(metadata-ref opam-content "synopsis")) - (description ,(metadata-ref opam-content "description")) - (license #f))))))) + (values + `(package + (name ,(ocaml-name->guix-name name)) + (version ,(metadata-ref opam-content "version")) + (source + (origin + (method url-fetch) + (uri ,source-url) + (sha256 (base32 ,(guix-hash-url temp))))) + (build-system ocaml-build-system) + ,@(if (null? inputs) + '() + `((inputs ,(list 'quasiquote inputs)))) + ,@(if (null? native-inputs) + '() + `((native-inputs ,(list 'quasiquote native-inputs)))) + (home-page ,(metadata-ref opam-content "homepage")) + (synopsis ,(metadata-ref opam-content "synopsis")) + (description ,(metadata-ref opam-content "description")) + (license #f)) + dependencies)))))) + +(define (opam-recursive-import package-name) + (recursive-import package-name #f + #:repo->guix-package (lambda (name repo) + (opam->guix-package name)) + #:guix-name ocaml-name->guix-name)) diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm index b549878742..2d249a213f 100644 --- a/guix/scripts/import/opam.scm +++ b/guix/scripts/import/opam.scm @@ -25,6 +25,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-opam)) @@ -43,6 +44,8 @@ Import and convert the opam package for PACKAGE-NAME.\n")) (display (G_ " -h, --help display this help and exit")) (display (G_ " + -r, --recursive import packages recursively")) + (display (G_ " -V, --version display version information and exit")) (newline) (show-bug-report-information)) @@ -56,6 +59,9 @@ Import and convert the opam package for PACKAGE-NAME.\n")) (option '(#\V "version") #f #f (lambda args (show-version-and-exit "guix import opam"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) %standard-import-options)) @@ -81,11 +87,22 @@ Import and convert the opam package for PACKAGE-NAME.\n")) (reverse opts)))) (match args ((package-name) - (let ((sexp (opam->guix-package package-name))) - (unless sexp - (leave (G_ "failed to download meta-data for package '~a'~%") - package-name)) - sexp)) + (if (assoc-ref opts 'recursive) + ;; Recursive import + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (reverse + (stream->list + (opam-recursive-import package-name)))) + ;; Single import + (let ((sexp (opam->guix-package package-name))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + package-name)) + sexp))) (() (leave (G_ "too few arguments~%"))) ((many ...) -- cgit v1.2.3 From 755e6d4a0ab32e8f854262a6c563c3662b336983 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Wed, 19 Dec 2018 23:20:39 +0100 Subject: import: opam: Add updater. * guix/import/opam.scm (%opam-updater): New variable. --- guix/import/opam.scm | 59 +++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 54 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/import/opam.scm b/guix/import/opam.scm index cdf05e7d25..b30d28561b 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -27,14 +27,19 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) #:use-module (web uri) + #:use-module (guix build-system) + #:use-module (guix build-system ocaml) #:use-module (guix http-client) #:use-module (guix git) #:use-module (guix ui) + #:use-module (guix packages) + #:use-module (guix upstream) #:use-module (guix utils) #:use-module (guix import utils) #:use-module ((guix licenses) #:prefix license:) #:export (opam->guix-package - opam-recursive-import)) + opam-recursive-import + %opam-updater)) ;; Define a PEG parser for the opam format (define-peg-pattern SP none (or " " "\n")) @@ -205,11 +210,17 @@ path to the repository." (list dependency (list 'unquote (string->symbol dependency)))) (ocaml-names->guix-names lst))) -(define (opam->guix-package name) +(define (opam-fetch name) (and-let* ((repository (get-opam-repository)) (version (find-latest-version name repository)) - (file (string-append repository "/packages/" name "/" name "." version "/opam")) - (opam-content (get-metadata file)) + (file (string-append repository "/packages/" name "/" name "." version "/opam"))) + `(("metadata" ,@(get-metadata file)) + ("version" . ,version)))) + +(define (opam->guix-package name) + (and-let* ((opam-file (opam-fetch name)) + (version (assoc-ref opam-file "version")) + (opam-content (assoc-ref opam-file "metadata")) (url-dict (metadata-ref opam-content "url")) (source-url (metadata-ref url-dict "src")) (requirements (metadata-ref opam-content "depends")) @@ -222,7 +233,7 @@ path to the repository." (values `(package (name ,(ocaml-name->guix-name name)) - (version ,(metadata-ref opam-content "version")) + (version ,version) (source (origin (method url-fetch) @@ -246,3 +257,41 @@ path to the repository." #:repo->guix-package (lambda (name repo) (opam->guix-package name)) #:guix-name ocaml-name->guix-name)) + +(define (guix-package->opam-name package) + "Given an OCaml PACKAGE built from OPAM, return the name of the +package in OPAM." + (let ((upstream-name (assoc-ref + (package-properties package) + 'upstream-name)) + (name (package-name package))) + (cond + (upstream-name upstream-name) + ((string-prefix? "ocaml-" name) (substring name 6)) + (else name)))) + +(define (opam-package? package) + "Return true if PACKAGE is an OCaml package from OPAM" + (and + (equal? (build-system-name (package-build-system package)) 'ocaml) + (not (string-prefix? "ocaml4" (package-name package))))) + +(define (latest-release package) + "Return an for the latest release of PACKAGE." + (and-let* ((opam-name (guix-package->opam-name package)) + (opam-file (opam-fetch opam-name)) + (version (assoc-ref opam-file "version")) + (opam-content (assoc-ref opam-file "metadata")) + (url-dict (metadata-ref opam-content "url")) + (source-url (metadata-ref url-dict "src"))) + (upstream-source + (package (package-name package)) + (version version) + (urls (list source-url))))) + +(define %opam-updater + (upstream-updater + (name 'opam) + (description "Updater for OPAM packages") + (pred opam-package?) + (latest latest-release))) -- cgit v1.2.3 From f31ce9ecf1ecb4eeab4fc37792684b3fa03ec95f Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Wed, 19 Dec 2018 23:55:44 +0100 Subject: import: opam: Parse comments. * guix/import/opam.scm: Add comment support in parser. --- guix/import/opam.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/opam.scm b/guix/import/opam.scm index b30d28561b..c254db5f2c 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -42,7 +42,8 @@ %opam-updater)) ;; Define a PEG parser for the opam format -(define-peg-pattern SP none (or " " "\n")) +(define-peg-pattern comment none (and "#" (* STRCHR) "\n")) +(define-peg-pattern SP none (or " " "\n" comment)) (define-peg-pattern SP2 body (or " " "\n")) (define-peg-pattern QUOTE none "\"") (define-peg-pattern QUOTE2 body "\"") -- cgit v1.2.3 From 49c35bbb71f80bdd7c01b4d74e08335c3ec5331c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 7 Jan 2019 22:57:34 +0100 Subject: self: Move all modules into a single directory. This halves the number of elements in %LOAD-PATH and %LOAD-COMPILED-PATH and halves the number of 'stat' calls as reported by: env -i $(type -P guix) build -e '(@ (gnu packages base) coreutils)' -nd * guix/self.scm (node-source+compiled, guile-module-union): New procedures. (guix-command): Remove 'compiled-modules' parameter. Remove 'source-directories' and 'object-directories' variables and add 'module-directory'. Change command so that it adds nothing but MODULE-DIRECTORY to %LOAD-PATH and %LOAD-COMPILED-PATH. (whole-package): Remove #:compiled-modules. Assume MODULES contains 'share/guile/site' and 'lib/guile' and adjust code accordingly. (compiled-guix): When PULL-VERSION is 1, use 'node-source+compiled' only. Remove #:compiled-modules argument to 'whole-package'. * guix/channels.scm (whole-package-for-legacy): Add 'module+compiled' and pass it to 'whole-package'. --- guix/channels.scm | 24 ++++++++++- guix/self.scm | 125 ++++++++++++++++++++++++++++++++++-------------------- 2 files changed, 100 insertions(+), 49 deletions(-) (limited to 'guix') diff --git a/guix/channels.scm b/guix/channels.scm index 75503bb0ae..6b860f3bd8 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -335,6 +335,26 @@ modules in the old ~/.config/guix/latest style." (define packages (resolve-interface '(gnu packages guile))) + (define modules+compiled + ;; Since MODULES contains both .scm and .go files at its root, re-bundle + ;; it so that it has share/guile/site and lib/guile, which is what + ;; 'whole-package' expects. + (computed-file (derivation-name modules) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (define version + (effective-version)) + (define share + (string-append #$output "/share/guile/site")) + (define lib + (string-append #$output "/lib/guile/" version)) + + (mkdir-p share) (mkdir-p lib) + (symlink #$modules (string-append share "/" version)) + (symlink #$modules (string-append lib "/site-ccache")))))) + (letrec-syntax ((list (syntax-rules (->) ((_) '()) @@ -346,7 +366,7 @@ modules in the old ~/.config/guix/latest style." ((_ variable rest ...) (cons (module-ref packages 'variable) (list rest ...)))))) - (whole-package name modules + (whole-package name modules+compiled ;; In the "old style", %SELF-BUILD-FILE would simply return a ;; derivation that builds modules. We have to infer what the diff --git a/guix/self.scm b/guix/self.scm index 2664fd886f..1e9d5b70e5 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -133,6 +133,30 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." #:name (file-mapping-name mapping) #:system system)) +(define (node-source+compiled node) + "Return a \"bundle\" containing both the source code and object files for +NODE's modules, under their FHS directories: share/guile/site and lib/guile." + (define build + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (define source + (string-append #$output "/share/guile/site/" + (effective-version))) + + (define object + (string-append #$output "/lib/guile/" (effective-version) + "/site-ccache")) + + (mkdir-p (dirname source)) + (symlink #$(node-source node) source) + (mkdir-p (dirname object)) + (symlink #$(node-compiled node) object)))) + + (computed-file (string-append (node-name node) "-modules") + build)) + (define (node-fold proc init nodes) (let loop ((nodes nodes) (visited (setq)) @@ -364,36 +388,53 @@ DOMAIN, a gettext domain." (computed-file "guix-manual" build)) -(define* (guix-command modules #:optional compiled-modules +(define* (guile-module-union things #:key (name "guix-module-union")) + "Return the union of the subset of THINGS (packages, computed files, etc.) +that provide Guile modules." + (define build + (with-imported-modules '((guix build union)) + #~(begin + (use-modules (guix build union)) + + (define (modules directory) + (string-append directory "/share/guile/site")) + + (define (objects directory) + (string-append directory "/lib/guile")) + + (union-build #$output + (filter (lambda (directory) + (or (file-exists? (modules directory)) + (file-exists? (objects directory)))) + '#$things) + + #:log-port (%make-void-port "w"))))) + + (computed-file name build)) + +(define* (guix-command modules #:key source (dependencies '()) guile (guile-version (effective-version))) "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its load path." - (define source-directories - (map (lambda (package) - (file-append package "/share/guile/site/" - guile-version)) - dependencies)) - - (define object-directories - (map (lambda (package) - (file-append package "/lib/guile/" - guile-version "/site-ccache")) - dependencies)) + (define module-directory + ;; To minimize the number of 'stat' calls needed to locate a module, + ;; create the union of all the module directories. + (guile-module-union (cons modules dependencies))) (program-file "guix-command" #~(begin (set! %load-path - (append (filter file-exists? '#$source-directories) - %load-path)) - - (set! %load-compiled-path - (append (filter file-exists? '#$object-directories) - %load-compiled-path)) + (cons (string-append #$module-directory + "/share/guile/site/" + (effective-version)) + %load-path)) - (set! %load-path (cons #$modules %load-path)) (set! %load-compiled-path - (cons (or #$compiled-modules #$modules) + (cons (string-append #$module-directory + "/lib/guile/" + (effective-version) + "/site-ccache") %load-compiled-path)) (let ((guix-main (module-ref (resolve-interface '(guix ui)) @@ -436,7 +477,6 @@ load path." (define* (whole-package name modules dependencies #:key (guile-version (effective-version)) - compiled-modules info daemon miscellany guile (command (guix-command modules @@ -444,10 +484,9 @@ load path." #:guile guile #:guile-version guile-version))) "Return the whole Guix package NAME that uses MODULES, a derivation of all -the modules, and DEPENDENCIES, a list of packages depended on. COMMAND is the -'guix' program to use; INFO is the Info manual. When COMPILED-MODULES is -true, it is linked as 'lib/guile/X.Y/site-ccache'; otherwise, .go files are -assumed to be part of MODULES." +the modules (under share/guile/site and lib/guile), and DEPENDENCIES, a list +of packages depended on. COMMAND is the 'guix' program to use; INFO is the +Info manual." (computed-file name (with-imported-modules '((guix build utils)) #~(begin @@ -461,28 +500,22 @@ assumed to be part of MODULES." (symlink (string-append #$daemon "/bin/guix-daemon") (string-append #$output "/bin/guix-daemon"))) - (let ((modules (string-append #$output - "/share/guile/site/" - (effective-version))) - (info #$info)) - (mkdir-p (dirname modules)) - (symlink #$modules modules) + (let ((share (string-append #$output "/share")) + (lib (string-append #$output "/lib")) + (info #$info)) + (mkdir-p share) + (symlink #$(file-append modules "/share/guile") + (string-append share "/guile")) (when info - (symlink #$info - (string-append #$output - "/share/info")))) + (symlink #$info (string-append share "/info"))) + + (mkdir-p lib) + (symlink #$(file-append modules "/lib/guile") + (string-append lib "/guile"))) (when #$miscellany (copy-recursively #$miscellany #$output - #:log (%make-void-port "w"))) - - ;; Object files. - (when #$compiled-modules - (let ((modules (string-append #$output "/lib/guile/" - (effective-version) - "/site-ccache"))) - (mkdir-p (dirname modules)) - (symlink #$compiled-modules modules))))))) + #:log (%make-void-port "w"))))))) (define* (compiled-guix source #:key (version %guix-version) (pull-version 1) @@ -681,15 +714,13 @@ assumed to be part of MODULES." ;; Version 1 is when we return the full package. (cond ((= 1 pull-version) ;; The whole package, with a standard file hierarchy. - (let* ((modules (built-modules (compose list node-source))) - (compiled (built-modules (compose list node-compiled))) - (command (guix-command modules compiled + (let* ((modules (built-modules (compose list node-source+compiled))) + (command (guix-command modules #:source source #:dependencies dependencies #:guile guile-for-build #:guile-version guile-version))) (whole-package name modules dependencies - #:compiled-modules compiled #:command command #:guile guile-for-build -- cgit v1.2.3 From efff32452a050e2cd715c38717dd03cad5511bc0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 7 Jan 2019 23:45:15 +0100 Subject: gexp: 'gexp->script' does not emit load-path expression when unnecessary. This removes two elements from %LOAD-PATH and %LOAD-COMPILED-PATH of the 'guix' command and thus further reduces the number of 'stat' calls it makes. * guix/gexp.scm (load-path-expression): Return #f when MODULES and EXTENSIONS are both empty. (gexp->script): Don't emit anything when SET-LOAD-PATH is #f. --- guix/gexp.scm | 57 ++++++++++++++++++++++++++++++++------------------------- 1 file changed, 32 insertions(+), 25 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index febd72a904..f7c064297b 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1315,30 +1315,33 @@ they can refer to each other." #:key (extensions '())) "Return as a monadic value a gexp that sets '%load-path' and '%load-compiled-path' to point to MODULES, a list of module names. MODULES -are searched for in PATH." - (mlet %store-monad ((modules (imported-modules modules - #:module-path path)) - (compiled (compiled-modules modules - #:extensions extensions - #:module-path path))) - (return (gexp (eval-when (expand load eval) - (set! %load-path - (cons (ungexp modules) - (append (map (lambda (extension) - (string-append extension - "/share/guile/site/" - (effective-version))) - '((ungexp-native-splicing extensions))) - %load-path))) - (set! %load-compiled-path - (cons (ungexp compiled) - (append (map (lambda (extension) - (string-append extension - "/lib/guile/" - (effective-version) - "/site-ccache")) - '((ungexp-native-splicing extensions))) - %load-compiled-path)))))))) +are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty." + (if (and (null? modules) (null? extensions)) + (with-monad %store-monad + (return #f)) + (mlet %store-monad ((modules (imported-modules modules + #:module-path path)) + (compiled (compiled-modules modules + #:extensions extensions + #:module-path path))) + (return (gexp (eval-when (expand load eval) + (set! %load-path + (cons (ungexp modules) + (append (map (lambda (extension) + (string-append extension + "/share/guile/site/" + (effective-version))) + '((ungexp-native-splicing extensions))) + %load-path))) + (set! %load-compiled-path + (cons (ungexp compiled) + (append (map (lambda (extension) + (string-append extension + "/lib/guile/" + (effective-version) + "/site-ccache")) + '((ungexp-native-splicing extensions))) + %load-compiled-path))))))))) (define* (gexp->script name exp #:key (guile (default-guile)) @@ -1362,7 +1365,11 @@ imported modules in its search path. Look up EXP's modules in MODULE-PATH." "#!~a/bin/guile --no-auto-compile~%!#~%" (ungexp guile)) - (write '(ungexp set-load-path) port) + (ungexp-splicing + (if set-load-path + (gexp ((write '(ungexp set-load-path) port))) + (gexp ()))) + (write '(ungexp exp) port) (chmod port #o555)))) #:module-path module-path))) -- cgit v1.2.3 From 08fdee39110a51cd76afac7a9adf10c794a4c272 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 8 Jan 2019 18:07:16 +0100 Subject: self: Compress Info files. Fixes . Reported by Adonay Felipe Nogueira . * guix/self.scm (info-manual): Compress Info files. --- guix/self.scm | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index 1e9d5b70e5..e9a768bc90 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -384,7 +384,14 @@ DOMAIN, a gettext domain." (basename texi ".texi") ".info"))) (cons "guix.texi" - (find-files "." "^guix\\.[a-z]{2}\\.texi$")))))) + (find-files "." "^guix\\.[a-z]{2}\\.texi$"))) + + ;; Compress Info files. + (setenv "PATH" + #+(file-append (specification->package "gzip") "/bin")) + (for-each (lambda (file) + (invoke "gzip" "-9n" file)) + (find-files #$output "\\.info(-[0-9]+)?$"))))) (computed-file "guix-manual" build)) -- cgit v1.2.3 From a21a906fcd31c918431622f7ac56b21c269368fb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 8 Jan 2019 18:17:22 +0100 Subject: pull: Document '--system'. Fixes . Reported by Alex Kost . This is a followup to 5923102f7b58f0a0120926ec5b81ed48b26a188e. * guix/scripts/pull.scm (show-help): Add '--system'. --- guix/scripts/pull.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 862556d12b..e7ff44c0d5 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2017 Marius Bakke ;;; ;;; This file is part of GNU Guix. @@ -88,6 +88,8 @@ Download and deploy the latest version of Guix.\n")) -p, --profile=PROFILE use PROFILE instead of ~/.config/guix/current")) (display (G_ " -n, --dry-run show what would be pulled and built")) + (display (G_ " + -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (G_ " --bootstrap use the bootstrap Guile to build the new Guix")) (newline) -- cgit v1.2.3