summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-06-19 22:26:59 +0200
committerLudovic Courtès <ludo@gnu.org>2016-06-20 00:52:53 +0200
commit04eb0fab3a5df2c04299b2a4263b966140f11990 (patch)
treec39548a42d55512be538ec479fe61ac7dddf9c83 /gnu
parenta68d0f6fd5a93dc80fe9d919413f5d3e8db2a5b4 (diff)
gnu: guix: Add 'current-guix' thunk.
* gnu/packages/package-management.scm (source-file?) (make-git-predicate, current-guix): New procedures.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/packages/package-management.scm76
1 files changed, 75 insertions, 1 deletions
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 46743fefb5..f3a1cda149 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -21,9 +21,11 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
+ #:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (guix build-system python)
+ #:use-module ((guix build utils) #:select (with-directory-excursion))
#:use-module ((guix licenses) #:select (gpl2+ gpl3+ lgpl2.1+ asl2.0))
#:use-module (gnu packages)
#:use-module (gnu packages guile)
@@ -48,7 +50,12 @@
#:use-module (gnu packages popt)
#:use-module (gnu packages gnuzilla)
#:use-module (gnu packages cpio)
- #:use-module (gnu packages tls))
+ #:use-module (gnu packages tls)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 popen)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 match))
(define (boot-guile-uri arch)
"Return the URI for the bootstrap Guile tarball for ARCH."
@@ -246,6 +253,73 @@ the Nix package manager.")
(define-public guix guix-devel)
+(define (source-file? file stat)
+ "Return true if FILE is likely a source file, false if it is a typical
+generated file."
+ (define (wrong-extension? file)
+ (or (string-suffix? "~" file)
+ (member (file-extension file)
+ '("o" "a" "lo" "so" "go"))))
+
+ (match (basename file)
+ ((or ".git" "autom4te.cache" "configure" "Makefile" "Makefile.in" ".libs")
+ #f)
+ ((? wrong-extension?)
+ #f)
+ (_
+ #t)))
+
+(define (make-git-predicate directory)
+ "Return a predicate that returns true if a file is part of the Git checkout
+living at DIRECTORY. Upon Git failure, return #f instead of a predicate."
+ (define (parent-directory? thing directory)
+ ;; Return #t if DIRECTORY is the parent of THING.
+ (or (string-suffix? thing directory)
+ (and (string-index thing #\/)
+ (parent-directory? (dirname thing) directory))))
+
+ (let* ((pipe (with-directory-excursion directory
+ (open-pipe* OPEN_READ "git" "ls-files")))
+ (files (let loop ((lines '()))
+ (match (read-line pipe)
+ ((? eof-object?)
+ (reverse lines))
+ (line
+ (loop (cons line lines))))))
+ (status (close-pipe pipe)))
+ (and (zero? status)
+ (lambda (file stat)
+ (match (stat:type stat)
+ ('directory
+ ;; 'git ls-files' does not list directories, only regular files,
+ ;; so we need this special trick.
+ (any (cut parent-directory? <> file) files))
+ ((or 'regular 'symlink)
+ (any (cut string-suffix? <> file) files))
+ (_
+ #f))))))
+
+(define-public current-guix
+ (let ((select? (delay (or (make-git-predicate
+ (string-append (current-source-directory)
+ "/../.."))
+ source-file?))))
+ (lambda ()
+ "Return a package representing Guix built from the current source tree.
+This works by adding the current source tree to the store (after filtering it
+out) and returning a package that uses that as its 'source'."
+ (package
+ (inherit guix)
+ (version (string-append (package-version guix) "+"))
+ (source (local-file "../.." "guix-current"
+ #:recursive? #t
+ #:select? (force select?)))))))
+
+
+;;;
+;;; Other tools.
+;;;
+
(define-public nix
(package
(name "nix")