2 files changed, 165 insertions, 49 deletions

diff --git a/etc/tag-release b/etc/tag-release
new file mode 100755
index 0000000..d5f4a45
--- /dev/null
+++ b/etc/tag-release
@@ -0,0 +1,165 @@
+#!/bin/sh
+#-*-Scheme-*-
+
+GUIX="${GUIX:-$(command -v guix)}"
+
+if [ -z "$GUIX" ]; then
+echo "Missing guix executable."
+exit 1
+fi
+
+exec env GUILE_AUTO_COMPILE=0 $GUIX repl -- "$0" "$@"
+!#
+
+;;; SPDX-License-Identifier: LGPL-3.0-or-later
+;;; SPDX-FileCopyrightText: 2026 Sergio Pastor Pérez <sergio.pastor-perez@inria.fr>
+;;; SPDX-FileCopyrightText: 2026 Romain Garbage <romain.garbage@inria.fr>
+;;;
+;;; tag-release.scm --- Tag commits for Guix Science releases.
+;;;
+;;; Commentary:
+;;;
+;;; This utility aims to ease the tagging of commits intended for making
+;;; releases following the Guix Science requirements.
+;;;
+;;; Code:
+
+(use-modules (guix channels)
+             (guix describe)
+             (guix diagnostics)
+             (guix i18n)
+             (ice-9 popen)
+             (ice-9 pretty-print)
+             (ice-9 rdelim)
+             (ice-9 regex)
+             (srfi srfi-1)
+             (srfi srfi-37))
+
+(define %version "0.0.1")
+
+(define %this-channel
+  (channel
+    (name 'guix-science)
+    (url "https://codeberg.org/guix-science/guix-science.git")
+    (branch "master")
+    (introduction
+     (make-channel-introduction
+      "b1fe5aaff3ab48e798a4cce02f0212bc91f423dc"
+      (openpgp-fingerprint
+       "CA4F 8CF4 37D7 478F DA05  5FD4 4213 7701 1A37 8446")))))
+
+(define help-message
+  "Usage: ~a [OPTIONS]... TAG
+
+Where TAG has the following format `vYYYYMMDD'.
+
+OPTIONS:
+
+  --commit=COMMIT    the commit where to place the TAG
+  --guix=COMMIT      the Guix commit to associate with the release
+
+Report bugs to: <https://codeberg.org/guix-science/guix-science/issues>
+")
+
+(define %options
+  (let ((display-and-exit-proc
+         (lambda (msg . rest)
+           (lambda _
+             (apply format (cons* #t msg rest)) (quit)))))
+    (list (option '("commit") #t #f
+                  (lambda (opt name arg result)
+                    (alist-cons 'commit arg result)))
+          (option '("guix") #t #f
+                  (lambda (opt name arg result)
+                    (alist-cons 'guix arg result)))
+          (option '(#\v "version") #f #f
+                  (display-and-exit-proc "tag-release version v~a\n" %version))
+          (option '(#\h "help") #f #f
+                  (display-and-exit-proc help-message #f)))))
+
+
+;;; Helpers
+
+(define (current-guix-channel)
+  "Retrieve the current Guix channel as seen by `guix describe'."
+  (find (lambda (channel)
+          (equal? (channel-name channel) 'guix))
+        (current-channels)))
+
+(define (current-commit)
+  "Return commit as seen by the current working directory."
+  (string-trim-both (run-command "git" "rev-parse" "HEAD")))
+
+(define (make-channels-message tag commit guix-commit)
+  "Generate channels file using COMMIT and GUIX-COMMIT."
+  (let* ((this-pinned (channel
+                        (inherit %this-channel)
+                        (commit commit)))
+         (guix-pinned (channel
+                        (inherit (current-guix-channel))
+                        (commit guix-commit)))
+         (pinned-channels (call-with-output-string
+                            (lambda (port)
+                              (pretty-print
+                               `(list ,@(map channel->code (list this-pinned guix-pinned)))
+                               port)))))
+    (format #f "\
+;; Guix-Science release ~a
+;;
+;; Guix revision: ~a
+~a" tag guix-commit pinned-channels)))
+
+(define (check-tag-format tag)
+  "Check that TAG follows the `vYYYYMMDD' pattern."
+  (unless (string-match "^v[0-9]{8}$" tag)
+    (leave (G_ "TAG must follow the `vYYYYMMDD' pattern, got `~a'~%") tag))
+  tag)
+
+(define (check-commit-format commit)
+  "Check that COMMIT looks like a valid Git commit hash."
+  (unless (string-match "^[0-9a-fA-F]{40}$" commit)
+    (leave (G_ "COMMIT must be a valid Git commit hash, got `~a'~%") commit))
+  commit)
+
+(define (run-command prog . args)
+  "Invoke PROGRAM with the given ARGS."
+  (let* ((port (apply open-pipe* OPEN_READ prog args))
+         (output (read-string port))
+         (status (close-pipe port))
+         (exit-code (status:exit-val status)))
+    (values output exit-code)))
+
+
+;;; Main
+
+(define (main args)
+  (define (parse-args args)
+    (args-fold (cdr args)
+               %options
+               (lambda (opt name arg loads)
+                 (error "Unrecognized option `~A'" name))
+               (lambda (arg result)
+                 (when (assoc-ref result 'argument)
+                   (error "Only 1 argument for TAG accepted"))
+                 (alist-cons 'argument arg result))
+               '()))
+  (let* ((arguments   (parse-args args))
+         (tag         (and=> (or (assoc-ref arguments 'argument)
+                                 (begin
+                                   (display help-message)
+                                   (leave (G_ "missing tag argument~%"))))
+                             check-tag-format))
+         (commit      (and=> (or (assoc-ref arguments 'commit)
+                                 (current-commit))
+                             check-commit-format))
+         (guix-commit (and=> (or (assoc-ref arguments 'guix)
+                                 (channel-commit (current-guix-channel)))
+                             check-commit-format))
+         (message (make-channels-message tag commit guix-commit)))
+    (call-with-values
+        (lambda ()
+          (run-command "git" "tag" "--annotate" "--sign" "-m" message tag commit))
+      (lambda (_ exit-code)
+        (exit exit-code)))))
+
+(main (command-line))
diff --git a/etc/tag-release.sh b/etc/tag-release.sh
deleted file mode 100644
index d9b4a21..0000000
--- a/etc/tag-release.sh
+++ /dev/null
@@ -1,49 +0,0 @@
-#!/bin/sh
-
-set -e
-set -o pipefail
-
-TAG="$1"
-GUIX_SCIENCE_COMMIT="$2"
-GUIX_REVISION="$3"
-
-usage () {
-    echo "usage: $0 <release-tag> <guix-science-commit> <guix-revision>"
-    echo
-    echo "where <release-tag> is in the format vYYYYMMDD, <guix-science-commit>"
-    echo "is the Guix-Science commit to tag and <guix-revision> is the Guix"
-    echo "revision to associate with the release."
-}
-
-# TODO: check arguments.
-if [ $# -ne 3 ] ; then
-    usage
-    exit 1
-fi
-
-echo ";; Guix-Science release $TAG
-;;
-;; Guix revision: $GUIX_REVISION
-(list (channel
-        (name 'guix-science)
-        (url \"https://codeberg.org/guix-science/guix-science.git\")
-        (branch \"master\")
-        (commit
-          \"$GUIX_SCIENCE_COMMIT\")
-        (introduction
-          (make-channel-introduction
-            \"b1fe5aaff3ab48e798a4cce02f0212bc91f423dc\"
-            (openpgp-fingerprint
-              \"CA4F 8CF4 37D7 478F DA05  5FD4 4213 7701 1A37 8446\"))))
-      (channel
-        (name 'guix)
-        (url \"https://git.guix.gnu.org/guix.git\")
-        (branch \"master\")
-        (commit
-          \"$GUIX_REVISION\")
-        (introduction
-          (make-channel-introduction
-            \"9edb3f66fd807b096b48283debdcddccfea34bad\"
-            (openpgp-fingerprint
-              \"BBB0 2DDF 2CEA F6A8 0D1D  E643 A2A0 6DF2 A33A 54FA\")))))
-" | git tag --annotate --sign -F - $TAG $GUIX_SCIENCE_COMMIT