02/03: git: 'resolve-reference' handles 'git describe'-style commit IDs.

[guix-commits]

mbakke pushed a commit to branch master
in repository guix.

commit 1dc3825e9940de44c1f170add7bd26d61830ce34
Author: Marius Bakke <marius@gnu.org>
AuthorDate: Mon Sep 6 00:21:51 2021 +0200

    git: 'resolve-reference' handles 'git describe'-style commit IDs.
    
    * guix/git.scm (resolve-reference): Rewrite tag-or-commit case to recognize
    'git describe' style identifiers and resolve them as commits.
    * doc/guix.texi (origin Reference): Mention it.
---
 doc/guix.texi |  9 +++++----
 guix/git.scm  | 33 ++++++++++++++++++++++++---------
 2 files changed, 29 insertions(+), 13 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 29246ad..f88967b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -47,7 +47,7 @@ Copyright @copyright{} 2017, 2018 Carlo Zancanaro@*
 Copyright @copyright{} 2017 Thomas Danckaert@*
 Copyright @copyright{} 2017 humanitiesNerd@*
 Copyright @copyright{} 2017, 2021 Christine Lemmer-Webber@*
-Copyright @copyright{} 2017, 2018, 2019, 2020 Marius Bakke@*
+Copyright @copyright{} 2017, 2018, 2019, 2020, 2021 Marius Bakke@*
 Copyright @copyright{} 2017, 2019, 2020 Hartmut Goebel@*
 Copyright @copyright{} 2017, 2019, 2020, 2021 Maxim Cournoyer@*
 Copyright @copyright{} 2017, 2018, 2019, 2020, 2021 Tobias Geerinckx-Rice@*
@@ -7010,9 +7010,10 @@ retrieve.
 The URL of the Git repository to clone.
 
 @item @code{commit}
-This string denotes either the commit to fetch (a hexadecimal string,
-either the full SHA1 commit or a ``short'' commit string; the latter is
-not recommended) or the tag to fetch.
+This string denotes either the commit to fetch (a hexadecimal string),
+or the tag to fetch.  You can also use a ``short'' commit ID or a
+@command{git describe} style identifier such as
+@code{v1.0.1-10-g58d7909c97}.
 
 @item @code{recursive?} (default: @code{#f})
 This Boolean indicates whether to recursively fetch Git sub-modules.
diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326..621de0e 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -223,15 +224,29 @@ corresponding Git object."
              (object-lookup-prefix repository (string->oid commit) len)
              (object-lookup repository (string->oid commit)))))
       (('tag-or-commit . str)
-       (if (or (> (string-length str) 40)
-               (not (string-every char-set:hex-digit str)))
-           (resolve `(tag . ,str))              ;definitely a tag
-           (catch 'git-error
-             (lambda ()
-               (resolve `(tag . ,str)))
-             (lambda _
-               ;; There's no such tag, so it must be a commit ID.
-               (resolve `(commit . ,str))))))
+       (cond ((and (string-contains str "-g")
+                   (match (string-split str #\-)
+                     ((version ... revision g+commit)
+                      (if (and (> (string-length g+commit) 4)
+                               (string-every char-set:digit revision)
+                               (string-every char-set:hex-digit
+                                             (string-drop g+commit 1)))
+                          (string-drop g+commit 1)
+                          #f))
+                     (_ #f)))
+              ;; Looks like a 'git describe' style ID, like
+              ;; v1.3.0-7-gaa34d4d28d.
+              => (lambda (commit) (resolve `(commit . ,commit))))
+             ((or (> (string-length str) 40)
+                  (not (string-every char-set:hex-digit str)))
+              (resolve `(tag . ,str)))      ;definitely a tag
+             (else
+              (catch 'git-error
+                (lambda ()
+                  (resolve `(tag . ,str)))
+                (lambda _
+                  ;; There's no such tag, so it must be a commit ID.
+                  (resolve `(commit . ,str)))))))
       (('tag    . tag)
        (let ((oid (reference-name->oid repository
                                        (string-append "refs/tags/" tag))))