From mboxrd@z Thu Jan  1 00:00:00 1970
From: Danny Milosavljevic <dannym@scratchpost.org>
Subject: Re: Cuirass news
Date: Sat, 27 Jan 2018 18:27:16 +0100
Message-ID: <20180127182716.36a0766f@scratchpost.org>
References: <877es6x5xj.fsf@gnu.org> <20180126014630.56fefa68@scratchpost.org>
Mime-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: quoted-printable
Return-path: <guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org>
Received: from eggs.gnu.org ([2001:4830:134:3::10]:59723)
	by lists.gnu.org with esmtp (Exim 4.71)
	(envelope-from <dannym@scratchpost.org>) id 1efUGi-00035c-9P
	for guix-devel@gnu.org; Sat, 27 Jan 2018 12:28:10 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
	(envelope-from <dannym@scratchpost.org>) id 1efUG9-0002MP-P2
	for guix-devel@gnu.org; Sat, 27 Jan 2018 12:27:56 -0500
In-Reply-To: <20180126014630.56fefa68@scratchpost.org>
List-Id: "Development of GNU Guix and the GNU System distribution."
	<guix-devel.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/guix-devel>,
	<mailto:guix-devel-request@gnu.org?subject=unsubscribe>
List-Archive: <http://lists.gnu.org/archive/html/guix-devel/>
List-Post: <mailto:guix-devel@gnu.org>
List-Help: <mailto:guix-devel-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/guix-devel>,
	<mailto:guix-devel-request@gnu.org?subject=subscribe>
Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org
Sender: "Guix-devel" <guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org>
To: Ludovic =?ISO-8859-1?Q?Court=E8s?= <ludo@gnu.org>
Cc: guix-devel <guix-devel@gnu.org>

... and a fix to an example:

Note: I'm incapable of making the pass-through of the fetch-repository resu=
lt
through

   (call-with-output-fdes 1 "/dev/null"
    (lambda () (fetch-repository spec))

work, thus disabled it.

diff --git a/examples/guix-track-git.scm b/examples/guix-track-git.scm
index e3531f0..f867c08 100644
--- a/examples/guix-track-git.scm
+++ b/examples/guix-track-git.scm
@@ -190,20 +190,22 @@ valid."
       (move->fdes port fdes)
       result)))
=20
-(define* (package->git-tracked pkg #:key (branch "master") commit url)
+(define* (package->git-tracked store pkg #:key (branch "master") commit ur=
l)
   (let* ((source (package-source pkg))
          (uri (origin-uri source)))
-    (if (not branch) pkg
-        (let* ((spec (package->spec pkg #:branch branch #:commit commit #:=
url url))
-               (commit (call-with-output-fdes 1 "/dev/null"
-                                              (lambda () (fetch-repository=
 spec))))
-               (url (or url (git-reference-url uri)))
-               (git-dir (string-append (%package-cachedir) "/" (url->file-=
name url)))
-               (hash (bytevector->nix-base32-string (file-hash git-dir)))
-               (source (origin (uri (git-reference (url url) (commit commi=
t)))
-                              (method git-fetch)
-                              (sha256 (base32 hash)))))
-          (set-fields pkg ((package-source) source))))))
+    (if (not branch)
+        pkg
+        (let* ((spec (package->spec pkg #:branch branch #:commit commit #:=
url url)))
+          (let-values (((checkout commit)
+                        (fetch-repository store spec)))
+            (let* ((url (or url (git-reference-url uri)))
+                   ; maybe (string-append (%package-cachedir) "/" (url->fi=
le-name url))
+                   (git-dir checkout)
+                   (hash (bytevector->nix-base32-string (file-hash git-dir=
)))
+                   (source (origin (uri (git-reference (url url) (commit c=
ommit)))
+                                   (method git-fetch)
+                                   (sha256 (base32 hash)))))
+              (set-fields pkg ((package-source) source))))))))
=20
 =0C
 ;;;
@@ -215,7 +217,7 @@ valid."
          (pkg (specification->package name))
          (branch (or (assoc-ref arguments 'branch) "master"))
          (url (assoc-ref arguments 'url))
-         (pkg.git (package->git-tracked pkg #:branch branch #:url url))
+         (pkg.git (package->git-tracked store pkg #:branch branch #:url ur=
l))
          (system (or (assoc-ref arguments 'system) "x86_64-linux")))
     (parameterize ((%graft? #f))
       (list (package-job store (job-name pkg) pkg.git system)))))