maint: Add 'update-guix-package' target.
* build-aux/update-guix-package.scm: New file. * Makefile.am (EXTRA_DIST): Add it. (update-guix-package): New target. (.PHONY): Add it. * gnu/packages/package-management.scm (guix): Mention it.
This commit is contained in:
parent
994a149479
commit
94fa8d7616
@ -416,6 +416,7 @@ EXTRA_DIST = \
|
|||||||
build-aux/download.scm \
|
build-aux/download.scm \
|
||||||
build-aux/generate-authors.scm \
|
build-aux/generate-authors.scm \
|
||||||
build-aux/test-driver.scm \
|
build-aux/test-driver.scm \
|
||||||
|
build-aux/update-guix-package.scm \
|
||||||
build-aux/run-system-tests.scm \
|
build-aux/run-system-tests.scm \
|
||||||
d3.v3.js \
|
d3.v3.js \
|
||||||
graph.js \
|
graph.js \
|
||||||
@ -539,6 +540,12 @@ gen-AUTHORS:
|
|||||||
"$(top_srcdir)" "$(distdir)/AUTHORS"; \
|
"$(top_srcdir)" "$(distdir)/AUTHORS"; \
|
||||||
fi
|
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.
|
# Make sure we're not shipping a file that embeds a local /gnu/store file name.
|
||||||
assert-no-store-file-names:
|
assert-no-store-file-names:
|
||||||
$(AM_V_at)if grep -r --exclude=*.texi --exclude=*.info \
|
$(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-no-store-file-names assert-binaries-available
|
||||||
.PHONY: assert-final-inputs-self-contained
|
.PHONY: assert-final-inputs-self-contained
|
||||||
.PHONY: clean-go make-go
|
.PHONY: clean-go make-go
|
||||||
|
.PHONY: update-guix-package
|
||||||
|
|
||||||
## -------------- ##
|
## -------------- ##
|
||||||
## Silent rules. ##
|
## Silent rules. ##
|
||||||
|
135
build-aux/update-guix-package.scm
Normal file
135
build-aux/update-guix-package.scm
Normal file
@ -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)))
|
@ -70,6 +70,8 @@
|
|||||||
|
|
||||||
(define-public guix
|
(define-public guix
|
||||||
;; Latest version of Guix, which may or may not correspond to a release.
|
;; 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")
|
(let ((version "0.12.0")
|
||||||
(commit "25a49294caf2386e65fc1b12a2508324be0b1cc2")
|
(commit "25a49294caf2386e65fc1b12a2508324be0b1cc2")
|
||||||
(revision 9))
|
(revision 9))
|
||||||
|
Loading…
Reference in New Issue
Block a user