[bug#79099,04/34] POC git-version

Message ID 20250726023951.11862-4-ngraves@ngraves.fr
State New
Headers
Series git-version rewrite |

Commit Message

Nicolas Graves July 26, 2025, 2:39 a.m. UTC
---
 guix/git-download.scm | 30 +++++++++++++++++++++----
 guix/packages.scm     | 51 ++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 72 insertions(+), 9 deletions(-)
  

Patch

diff --git a/guix/git-download.scm b/guix/git-download.scm
index ae2073ea06c..838bf336b97 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -22,6 +22,7 @@ 
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix git-download)
+  #:use-module (guix deprecation)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -59,7 +60,14 @@  (define-module (guix git-download)
             git-fetch/lfs
             git-version
             git-file-name
-            git-predicate))
+            git-predicate
+            vc-version)
+  #:re-export (git-version*
+               git-version?
+               make-git-version
+               git-version-semantic
+               git-version-revision
+               git-version-commit))
 
 ;;; Commentary:
 ;;;
@@ -283,8 +291,8 @@  (define* (git-fetch ref hash-algo hash
                            #:guile guile
                            #:git git))))
 
-(define (git-version version revision commit)
-  "Return the version string for packages using git-download."
+(define (vc-version version revision commit)
+  "Return the canonical version string for packages using version control."
   ;; git-version is almost exclusively executed while modules are being loaded.
   ;; This makes any errors hide their backtrace. Avoid the mysterious error
   ;; "Value out of range 0 to N: 7" when the commit ID is too short, which
@@ -296,9 +304,23 @@  (define (git-version version revision commit)
         (&message (message "git-version: commit ID unexpectedly short")))))
   (string-append version "-" revision "." (string-take commit 7)))
 
+(define-deprecated (git-version version revision commit)
+  ;; XXX: Should actually recommend git-version* instead, but the macro
+  ;; expander doesn't like that.  Still, it's OK to migrate to
+  ;; make-git-version in the meantime.
+  make-git-version
+  (vc-version version revision commit))
+
 (define (git-file-name name version)
   "Return the file-name for packages using git-download."
-  (string-append name "-" version "-checkout"))
+  (string-append
+   name "-"
+   (match version
+     (($ <git-version> semantic revision commit)
+      (vc-version semantic revision commit))
+     (semantic
+      semantic))
+   "-checkout"))
 
 
 ;;;
diff --git a/guix/packages.scm b/guix/packages.scm
index 1d5986c5f42..a430f4ebc22 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -44,8 +44,9 @@  (define-module (guix packages)
   #:use-module (guix search-paths)
   #:use-module (guix sets)
   #:use-module (guix deprecation)
-  #:use-module ((guix diagnostics)
-                #:select (formatted-message define-with-syntax-properties))
+  #:use-module ((guix diagnostics) #:select (define-with-syntax-properties
+                                              formatted-message
+                                              leave))
   #:autoload   (guix licenses) (license?)
   #:use-module (guix i18n)
   #:use-module (ice-9 match)
@@ -201,7 +202,15 @@  (define-module (guix packages)
             package-file
             package->derivation
             package->cross-derivation
-            origin->derivation))
+            origin->derivation
+
+            <git-version>
+            git-version*
+            git-version?
+            make-git-version
+            git-version-semantic
+            git-version-revision
+            git-version-commit))
 
 ;; The 'source-module-closure' procedure ca. 1.2.0 did not recognize
 ;; #:re-export-and-replace: <https://issues.guix.gnu.org/52694>.
@@ -614,7 +623,8 @@  (define-record-type* <package>
   package?
   this-package
   (name   package-name)                   ; string
-  (version package-version)               ; string
+  (version %package-version               ; <git-version> instance or string
+           (sanitize warn-unexpected-package-version))
   (source package-source)                 ; <origin> instance
   (build-system package-build-system)     ; <build-system> instance
   (arguments package-arguments            ; arguments for the build method
@@ -1786,7 +1796,9 @@  (define* (package->bag package #:optional
                  ;; name from the package version in various user-facing parts
                  ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
                  ;; prohibits the use of "@", so use "-" instead.
-                 (or (make-bag build-system (string-append name "-" version)
+                 (or (make-bag build-system
+                               (string-append name "-"
+                                              (package-version package))
                                #:system system
                                #:target target
                                #:source source
@@ -2201,3 +2213,32 @@  (define package-source-derivation                 ;somewhat deprecated
          (add-to-store store (basename file) #t "sha256" file))
         (_
          (lower store source system))))))
+
+(define-record-type* <git-version>
+  git-version* ; TODO Rename to git-version at the end of the deprecation.
+  make-git-version
+  git-version? this-git-version
+  (semantic git-version-semantic) ; string
+  (revision git-version-revision) ; string
+  (commit   git-version-commit))  ; string
+
+(define (package-version package)
+  "Return the canonical string version of the package."
+  (match (%package-version package)
+    (($ <git-version> version revision commit)
+     ;; XXX: Copied from (@ (guix git-download) git-version).
+     (when (< (string-length commit) 7)
+       (raise
+        (condition
+         (&message (message "git-version: commit ID unexpectedly short")))))
+     (string-append version "-" revision "." (string-take commit 7)))
+    (version
+     version)))
+
+(define-with-syntax-properties (warn-unexpected-package-version
+                                (value properties))
+  (unless (or (string? value) (git-version? value))
+    (leave (source-properties->location properties)
+           (G_ "The package-version object's implementation field supports \
+only <git-version> instances and strings.")))
+  value)