GNU bug report logs - #70132
[PATCH 00/11] Improve startup time and memory footprint for short-lived commands

Previous Next

Full log

Message #11 received at 70132 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 70132 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 02/11] git: Add ‘repository-info’ and use it in (guix channels).
Date: Mon,  1 Apr 2024 22:25:14 +0200

* guix/git.scm (repository-info): New procedure.
* guix/channels.scm (repository->guix-channel): Use it instead of local
code.

Change-Id: I74c758c73a22e16031571ca4271cc9cab0492f6e
---
 guix/channels.scm | 20 ++++++++------------
 guix/git.scm      | 19 ++++++++++++++++++-
 2 files changed, 26 insertions(+), 13 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 10f0e3800f..f26ccbc3ae 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -24,6 +24,7 @@ (define-module (guix channels)
   #:autoload   (guix git) (update-cached-checkout
                            url+commit->name
                            commit-difference
+                           repository-info
                            with-repository)
   #:autoload   (guix git-authenticate) (authenticate-repository)
   #:autoload   (guix openpgp) (openpgp-public-key-fingerprint
@@ -207,18 +208,13 @@ (define* (repository->guix-channel directory
 channel that uses that repository and the commit HEAD currently points to; use
 INTRODUCTION as the channel's introduction.  Return #f if no Git repository
 could be found at DIRECTORY or one of its ancestors."
-  (catch 'git-error
-    (lambda ()
-      (with-repository (repository-discover directory) repository
-        (let* ((head   (repository-head repository))
-               (commit (oid->string (reference-target head))))
-          (channel
-           (inherit %default-guix-channel)
-           (url (repository-working-directory repository))
-           (commit commit)
-           (branch (reference-shorthand head))
-           (introduction introduction)))))
-    (const #f)))
+  (let ((directory commit branch (repository-info directory)))
+    (channel
+     (inherit %default-guix-channel)
+     (url directory)
+     (commit commit)
+     (branch branch)
+     (introduction introduction))))
 
 (define-record-type <channel-instance>
   (channel-instance channel commit checkout)
diff --git a/guix/git.scm b/guix/git.scm
index cbcdb1904b..760b064a9c 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
-;;; Copyright © 2018-2023 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2018-2024 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle <at> kyleam.com>
 ;;; Copyright © 2021 Marius Bakke <marius <at> gnu.org>
 ;;; Copyright © 2022 Maxime Devos <maximedevos <at> telenet.be>
@@ -59,6 +59,7 @@ (define-module (guix git)
             with-repository
             with-git-error-handling
             false-if-git-not-found
+            repository-info
             update-cached-checkout
             url+commit->name
             latest-repository-commit
@@ -330,6 +331,22 @@ (define-syntax-rule (with-git-error-handling body ...)
     (lambda (key err)
       (report-git-error err))))
 
+(define (repository-info directory)
+  "Open the Git repository in DIRECTORY or one of its parent and return three
+values: the working directory of that repository, its checked out commit ID,
+and its checked out reference (such as a branch name).  Return #f (three
+values) if DIRECTORY does not hold a readable Git repository."
+  (catch 'git-error
+    (lambda ()
+      (with-repository (repository-discover directory) repository
+        (let* ((head   (repository-head repository))
+               (commit (oid->string (reference-target head))))
+          (values (repository-working-directory repository)
+                  commit
+                  (reference-shorthand head)))))
+    (lambda _
+      (values #f #f #f))))
+
 (define* (update-submodules repository
                             #:key (log-port (current-error-port))
                             (fetch-options #f))
-- 
2.41.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.