diff options
| -rw-r--r-- | Makefile.am | 8 | ||||
| -rw-r--r-- | build-aux/update-guix-package.scm | 135 | ||||
| -rw-r--r-- | gnu/packages/package-management.scm | 2 |
3 files changed, 145 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am index 8fe9e350cc..ee8fa1f14f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -416,6 +416,7 @@ EXTRA_DIST = \ build-aux/download.scm \ build-aux/generate-authors.scm \ build-aux/test-driver.scm \ + build-aux/update-guix-package.scm \ build-aux/run-system-tests.scm \ d3.v3.js \ graph.js \ @@ -539,6 +540,12 @@ gen-AUTHORS: "$(top_srcdir)" "$(distdir)/AUTHORS"; \ fi +update-guix-package: + git rev-parse HEAD + $(top_builddir)/pre-inst-env "$(GUILE)" \ + $(top_srcdir)/build-aux/update-guix-package.scm \ + "`git rev-parse HEAD`" + # Make sure we're not shipping a file that embeds a local /gnu/store file name. assert-no-store-file-names: $(AM_V_at)if grep -r --exclude=*.texi --exclude=*.info \ @@ -574,6 +581,7 @@ hydra-jobs.scm: $(GOBJECTS) .PHONY: assert-no-store-file-names assert-binaries-available .PHONY: assert-final-inputs-self-contained .PHONY: clean-go make-go +.PHONY: update-guix-package ## -------------- ## ## Silent rules. ## diff --git a/build-aux/update-guix-package.scm b/build-aux/update-guix-package.scm new file mode 100644 index 0000000000..d45c183914 --- /dev/null +++ b/build-aux/update-guix-package.scm @@ -0,0 +1,135 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: +;;; +;;; This scripts updates the definition of the 'guix' package in Guix for the +;;; current commit. It requires Git to be installed. +;;; +;;; Code: + +(use-modules (guix) + (guix git-download) + (guix upstream) + (guix utils) + (guix base32) + (guix build utils) + (gnu packages package-management) + (ice-9 match)) + +(define %top-srcdir + (string-append (current-source-directory) "/..")) + +(define version-controlled? + (git-predicate %top-srcdir)) + +(define (package-definition-location) + "Return the source properties of the definition of the 'guix' package." + (call-with-input-file (location-file (package-location guix)) + (lambda (port) + (let loop () + (match (read port) + ((? eof-object?) + (error "definition of 'guix' package could not be found" + (port-filename port))) + (('define-public 'guix value) + (source-properties value)) + (_ + (loop))))))) + +(define* (update-definition commit hash + #:key version old-hash) + "Return a one-argument procedure that takes a string, the definition of the +'guix' package, and returns a string, the update definition for VERSION, +COMMIT." + (define (linear-offset str line column) + ;; Return the offset in characters to reach LINE and COLUMN (both + ;; zero-indexed) in STR. + (call-with-input-string str + (lambda (port) + (let loop ((offset 0)) + (cond ((and (= (port-column port) column) + (= (port-line port) line)) + offset) + ((eof-object? (read-char port)) + (error "line and column not reached!" + str)) + (else + (loop (+ 1 offset)))))))) + + (define (update-hash str) + ;; Replace OLD-HASH with HASH in STR. + (string-replace-substring str + (bytevector->nix-base32-string old-hash) + (bytevector->nix-base32-string hash))) + + (lambda (str) + (match (call-with-input-string str read) + (('let (('version old-version) + ('commit old-commit) + ('revision old-revision)) + defn) + (let* ((location (source-properties defn)) + (line (assq-ref location 'line)) + (column 0) + (offset (linear-offset str line column))) + (string-append (format #f "(let ((version \"~a\") + (commit \"~a\") + (revision ~a))\n" + (or version old-version) + commit + (if (and version + (not (string=? version old-version))) + 0 + (+ 1 old-revision))) + (string-drop (update-hash str) offset)))) + (exp + (error "'guix' package definition is not as expected" exp))))) + + +(define (main . args) + (match args + ((commit version) + (with-store store + (let* ((source (add-to-store store + "guix-checkout" ;dummy name + #t "sha256" %top-srcdir + #:select? version-controlled?)) + (hash (query-path-hash store source)) + (location (package-definition-location)) + (old-hash (origin-sha256 (package-source guix)))) + (edit-expression location + (update-definition commit hash + #:old-hash old-hash + #:version version)) + + ;; Re-add SOURCE to the store, but this time under the real name used + ;; in the 'origin'. This allows us to build the package without + ;; having to make a real checkout; thus, it also works when working + ;; on a private branch. + (reload-module + (resolve-module '(gnu packages package-management))) + (pk source + (add-to-store store + (origin-file-name (package-source guix)) + #t "sha256" source))))) + ((commit) + ;; Automatically deduce the version and revision numbers. + (main commit #f)))) + +(apply main (cdr (command-line))) diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 0c69cda0b5..467613ef94 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -70,6 +70,8 @@ (define-public guix ;; Latest version of Guix, which may or may not correspond to a release. + ;; Note: the 'update-guix-package.scm' script expects this definition to + ;; start precisely like this. (let ((version "0.12.0") (commit "25a49294caf2386e65fc1b12a2508324be0b1cc2") (revision 9)) |