diff mbox series

[bug#73126] git-download: Add git-origin macro.

Message ID 20240908203024.4762-1-herman@rimm.ee
State New
Headers show
Series [bug#73126] git-download: Add git-origin macro. | expand

Commit Message

Herman Rimm Sept. 8, 2024, 8:30 p.m. UTC 
* guix/packages.scm (git-origin-helper, git-origin): Add macros.
---
 guix/git-download.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)
diff mbox series

Patch

diff --git a/guix/git-download.scm b/guix/git-download.scm
index ae2073ea06..d32f9a25eb 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -55,6 +55,8 @@  (define-module (guix git-download)
             git-reference-commit
             git-reference-recursive?
 
+            git-origin
+
             git-fetch
             git-fetch/lfs
             git-version
@@ -87,6 +89,31 @@  (define (git-lfs-package)
   (let ((distro (resolve-interface '(gnu packages version-control))))
     (module-ref distro 'git-lfs)))
 
+(define-syntax git-origin-helper
+  (syntax-rules (commit hash repository)
+    ((_ () (fields ...) c repo)
+     (origin fields ...
+             (method git-fetch)
+             (uri (git-reference (commit c)
+                                 (url repo)))))
+    ((_ ((commit exp) rest ...) others _ repo)
+     (git-origin-helper (rest ...) others exp repo))
+    ((_ ((hash exp) rest ...) (others ...) c repo)
+     (git-origin-helper
+       (rest ...)
+       (others ... (hash (content-hash (base32 exp) sha256)))
+       c
+       repo))
+    ((_ ((repository exp) rest ...) others c _)
+     (git-origin-helper (rest ...) others c exp))
+    ((_ (field rest ...) (others ...) c repo)
+     (git-origin-helper (rest ...) (others ... field) c repo))))
+
+(define-syntax-rule (git-origin fields ...)
+  "Build an <origin> record, converting the commit and repository field
+specifications to a <git-reference> and hash to a <content-hash>."
+  (git-origin-helper (fields ...) () #f #f))
+
 (define (git-fetch-builder git git-lfs git-ref-recursive? hash-algo)
   (define inputs
     `(,(or git (git-package))