From a57518484e5437b29496e1c132c6566e1eb437e8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 31 Mar 2024 23:16:30 +0200 Subject: git: Add ‘repository-info’ and use it in (guix channels). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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(-) (limited to 'guix') 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 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 -;;; Copyright © 2018-2023 Ludovic Courtès +;;; Copyright © 2018-2024 Ludovic Courtès ;;; Copyright © 2021 Kyle Meyer ;;; Copyright © 2021 Marius Bakke ;;; Copyright © 2022 Maxime Devos @@ -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)) -- cgit v1.2.3