[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/09: scripts: hash: Add --git option. WIP
From: |
Jan Nieuwenhuizen |
Subject: |
01/09: scripts: hash: Add --git option. WIP |
Date: |
Sat, 25 Nov 2017 05:38:25 -0500 (EST) |
janneke pushed a commit to branch wip-bootstrap
in repository guix.
commit db43d71c8f3875dd961aebabcc4cb0bee091c4f4
Author: Jan Nieuwenhuizen <address@hidden>
Date: Thu Nov 23 04:30:13 2017 +0100
scripts: hash: Add --git option. WIP
Using
guix hash -gr .
procudes the same hash as doing something like
git clone . tmp && guix hash -rx tmp && rm -r tmp
* guix/git.scm (git-ls-files): New function.
* guix/scripts/hash.scm (%options, show-help): Add `--git'.
(guix-hash)[git-file?]: New function.
---
guix/git.scm | 12 +++++++++++-
guix/scripts/hash.scm | 33 +++++++++++++++++++++++++++++----
2 files changed, 40 insertions(+), 5 deletions(-)
diff --git a/guix/git.scm b/guix/git.scm
index 7a83b56..cb74565 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
+;;; Copyright © 2017 Jan Nieuwenhuizen <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,7 +29,8 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (%repository-cache-directory
- latest-repository-commit))
+ latest-repository-commit
+ git-ls-files))
(define %repository-cache-directory
(make-parameter "/var/cache/guix/checkouts"))
@@ -126,3 +128,11 @@ Git repositories are kept in the cache directory specified
by
(copy-to-store store cache-dir
#:url url
#:repository repository))))
+
+(define (git-ls-files directory)
+ (with-libgit2
+ (let* ((repository (repository-open directory))
+ (oid (reference-target (repository-head repository)))
+ (commit (commit-lookup repository oid))
+ (tree (commit-tree commit)))
+ (tree-list tree))))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index cae5d6b..f255820 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <address@hidden>
;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
-;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
+;;; Copyright © 2016,2017 Jan Nieuwenhuizen <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,6 +20,7 @@
(define-module (guix scripts hash)
#:use-module (guix base32)
+ #:use-module (guix git)
#:use-module (guix hash)
#:use-module (guix serialization)
#:use-module (guix ui)
@@ -52,6 +53,8 @@ and 'hexadecimal' can be used as well).\n"))
(format #t (G_ "
-x, --exclude-vcs exclude version control directories"))
(format #t (G_ "
+ -g, --git consider git files only"))
+ (format #t (G_ "
-f, --format=FMT write the hash in the given format"))
(format #t (G_ "
-r, --recursive compute the hash on FILE recursively"))
@@ -68,6 +71,9 @@ and 'hexadecimal' can be used as well).\n"))
(list (option '(#\x "exclude-vcs") #f #f
(lambda (opt name arg result)
(alist-cons 'exclude-vcs? #t result)))
+ (option '(#\g "git") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'git? #t result)))
(option '(#\f "format") #t #f
(lambda (opt name arg result)
(define fmt-proc
@@ -117,6 +123,21 @@ and 'hexadecimal' can be used as well).\n"))
(else
#f)))
+ (define (git-file? directory)
+ (let* ((files (git-ls-files directory))
+ (directories (delete-duplicates (map dirname files)))
+ (prefix (if (string-suffix? "/" directory) directory
+ (string-append directory "/")))
+ (prefix-length (string-length prefix)))
+ (lambda (file stat)
+ (case (stat:type stat)
+ ((directory)
+ (member (string-drop file prefix-length) directories))
+ ((regular)
+ (member (string-drop file prefix-length) files))
+ (else
+ #f)))))
+
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
@@ -124,9 +145,13 @@ and 'hexadecimal' can be used as well).\n"))
(_ #f))
(reverse opts)))
(fmt (assq-ref opts 'format))
- (select? (if (assq-ref opts 'exclude-vcs?)
- (negate vcs-file?)
- (const #t))))
+ (select? (cond
+ ((assq-ref opts 'exclude-vcs?)
+ (negate vcs-file?))
+ ((assq-ref opts 'git?)
+ (git-file? (car args)))
+ (else
+ (const #t)))))
(define (file-hash file)
;; Compute the hash of FILE.
- branch wip-bootstrap created (now ed85f2d), Jan Nieuwenhuizen, 2017/11/25
- 02/09: gnu: Add stage0-boot., Jan Nieuwenhuizen, 2017/11/25
- 05/09: gnu: Add nyacc-boot., Jan Nieuwenhuizen, 2017/11/25
- 01/09: scripts: hash: Add --git option. WIP,
Jan Nieuwenhuizen <=
- 08/09: Revert "use %bootstrap-guile -- still guile-2.2 in bag-with-origins :-(", Jan Nieuwenhuizen, 2017/11/25
- 03/09: gnu: Add mescc-tools-boot., Jan Nieuwenhuizen, 2017/11/25
- 06/09: gnu: Add tcc-boot., Jan Nieuwenhuizen, 2017/11/25
- 09/09: gnu: Add gcc-boot. WIP, Jan Nieuwenhuizen, 2017/11/25
- 04/09: gnu: Add mes-boot., Jan Nieuwenhuizen, 2017/11/25
- 07/09: use %bootstrap-guile -- still guile-2.2 in bag-with-origins :-(, Jan Nieuwenhuizen, 2017/11/25