From 8a42fc71401fce2086111f5d319aeeddf202513a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 23 Feb 2024 14:17:07 +0100
Subject: bzr-download: Implement nar fallback.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* guix/bzr-download.scm (bzr-fetch)[guile-json, guile-lzlib,
guile-gnutls]: New variables.
[build]: Add ‘with-extensions’ and import more modules.  Invoke
‘download-nar’ when ‘bzr-fetch’ returns #f.
* guix/build/bzr.scm (bzr-fetch): Actually return #t on success.

Change-Id: Id5d4ebd0f9ddc3c44b6456d3b46c0000cc7b9997
---
 guix/bzr-download.scm | 43 ++++++++++++++++++++++++++++++++-----------
 1 file changed, 32 insertions(+), 11 deletions(-)

(limited to 'guix/bzr-download.scm')

diff --git a/guix/bzr-download.scm b/guix/bzr-download.scm
index d97f84838e..01c12fd54d 100644
--- a/guix/bzr-download.scm
+++ b/guix/bzr-download.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -51,20 +52,40 @@
     (module-ref distro 'breezy)))
 
 (define* (bzr-fetch ref hash-algo hash
-                       #:optional name
-                       #:key (system (%current-system)) (guile (default-guile))
-                       (bzr (bzr-package)))
+                    #:optional name
+                    #:key (system (%current-system)) (guile (default-guile))
+                    (bzr (bzr-package)))
   "Return a fixed-output derivation that fetches REF, a <bzr-reference>
 object.  The output is expected to have recursive hash HASH of type
 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
+  (define guile-json
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
+
+  (define guile-lzlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib))
+
+  (define guile-gnutls
+    (module-ref (resolve-interface '(gnu packages tls)) 'guile-gnutls))
+
   (define build
-    (with-imported-modules (source-module-closure
-                            '((guix build bzr)))
-      #~(begin
-          (use-modules (guix build bzr))
-          (bzr-fetch
-           (getenv "bzr url") (getenv "bzr reference") #$output
-           #:bzr-command (string-append #+bzr "/bin/brz")))))
+    (with-extensions (list guile-gnutls guile-lzlib guile-json)
+      (with-imported-modules (source-module-closure
+                              '((guix build bzr)
+                                (guix build utils)
+                                (guix build download-nar)))
+        #~(begin
+            (use-modules (guix build bzr)
+                         (guix build download-nar)
+                         (guix build utils)
+                         (srfi srfi-34))
+
+            (or (guard (c ((invoke-error? c)
+                           (report-invoke-error c)
+                           #f))
+                  (bzr-fetch (getenv "bzr url") (getenv "bzr reference")
+                             #$output
+                             #:bzr-command (string-append #+bzr "/bin/brz")))
+                (download-nar #$output))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "bzr-branch") build
@@ -79,7 +100,7 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                                           "LC_ALL" "LC_MESSAGES" "LANG"
                                           "COLUMNS")
                       #:system system
-                      #:local-build? #t  ;don't offload repo branching
+                      #:local-build? #t          ;don't offload repo branching
                       #:hash-algo hash-algo
                       #:hash hash
                       #:recursive? #t
-- 
cgit v1.2.3