ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-13 06:36:37 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

git: Factorize 'commit-id?' predicate.

Browse source 
* guix/git.scm (commit-id?): New procedure, copied from (guix swh).
(resolve-reference): Use it instead of inline code.
* guix/inferior.scm (channel-full-commit): Likewise.
This commit is contained in:
Ludovic Courtès 2022-10-11 10:42:43 +02:00
parent 7d9fd1d7b7
commit 602527ab97
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 10 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
guix/git.scm
View file

@ -62,6 +62,7 @@ (define-module (guix git)
commit-difference commit-difference
commit-relation commit-relation
commit-descendant? commit-descendant?
commit-id?
remote-refs remote-refs
@ -219,6 +220,12 @@ (define (url+commit->name url sha1)
(last (string-split url #\/)) ".git" "") (last (string-split url #\/)) ".git" "")
"-" (string-take sha1 7))) "-" (string-take sha1 7)))
(define (commit-id? str)
"Return true if STR is likely a Git commit ID, false otherwise---e.g., if it
is a tag name. This is based on a simple heuristic so use with care!"
(and (= (string-length str) 40)
(string-every char-set:hex-digit str)))
(define (resolve-reference repository ref) (define (resolve-reference repository ref)
"Resolve the branch, commit or tag specified by REF, and return the "Resolve the branch, commit or tag specified by REF, and return the
corresponding Git object." corresponding Git object."
@ -254,8 +261,7 @@ (define (resolve-reference repository ref)
#f)) #f))
(_ #f))) (_ #f)))
=> (lambda (commit) (resolve `(commit . ,commit)))) => (lambda (commit) (resolve `(commit . ,commit))))
((or (> (string-length str) 40) ((not (commit-id? str))
(not (string-every char-set:hex-digit str)))
(resolve `(tag . ,str))) ;definitely a tag (resolve `(tag . ,str))) ;definitely a tag
(else (else
(catch 'git-error (catch 'git-error

4
guix/inferior.scm
View file

@ -40,7 +40,7 @@ (define-module (guix inferior)
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix channels) #:use-module (guix channels)
#:use-module ((guix git) #:select (update-cached-checkout)) #:use-module ((guix git) #:select (update-cached-checkout commit-id?))
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -833,7 +833,7 @@ (define (channel-full-commit channel)
prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip." prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip."
(let ((commit (channel-commit channel)) (let ((commit (channel-commit channel))
(branch (channel-branch channel))) (branch (channel-branch channel)))
(if (and commit (= (string-length commit) 40)) (if (and commit (commit-id? commit))
commit commit
(let* ((ref (if commit `(commit . ,commit) `(branch . ,branch))) (let* ((ref (if commit `(commit . ,commit) `(branch . ,branch)))
(cache commit relation (cache commit relation