[bug#61930] [PATCH 0/1] Factorising git->origin function for imports.

[bug#61930] [PATCH 0/1] Factorising git->origin function for imports.

[Nicolas Graves via Guix-patches via]

Hi Guix!

While looking for creating a juliahub import script, I had to look on
how other packages were downloading repositories, and some things could
be factorised. I plan to use this new function for the juliahub importer
I'm writing.

I still need to experiment with it a bit, ensure that all cases are
covered, but here's a preliminary patch to get some feedback.

I believe such could also be done for other VCS, as Katherine Cox-Buday
probably had in mind when writing the go importer.
The code to download and hash from hg is already there in the cran
"download" helper. Maybe we can also add some options to the original
hg-fetch function from guix/build/hg.scm to factorize hg directly ?

-- 
Best regards,
Nicolas Graves

[bug#61930] [PATCH] import: factorising git->origin in guix/import/utils.scm.

[Nicolas Graves via Guix-patches via]

---
 guix/import/elpa.scm     | 44 +++++++++++--------------------------
 guix/import/go.scm       | 47 +++++++++-------------------------------
 guix/import/minetest.scm | 28 ++----------------------
 guix/import/utils.scm    | 36 ++++++++++++++++++++++++++++++
 tests/minetest.scm       | 11 ++--------
 5 files changed, 63 insertions(+), 103 deletions(-)

diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index f9e9f2de53..cfd149a697 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -45,7 +46,6 @@ (define-module (guix import elpa)
   #:use-module ((guix serialization) #:select (write-file))
   #:use-module (guix store)
   #:use-module (guix ui)
-  #:use-module (guix base32)
   #:use-module (guix upstream)
   #:use-module (guix packages)
   #:use-module (guix memoization)
@@ -210,11 +210,6 @@ (define* (fetch-elpa-package name #:optional (repo 'gnu))
                             url)))
       (_ #f))))
 
-(define* (download-git-repository url ref)
-  "Fetch the given REF from the Git repository at URL."
-  (with-store store
-    (latest-repository-commit store url #:ref ref)))
-
 (define (package-name->melpa-recipe package-name)
   "Fetch the MELPA recipe for PACKAGE-NAME, represented as an alist from
 keywords to values."
@@ -234,28 +229,15 @@ (define (data->recipe data)
     (close-port port)
     (data->recipe (cons ':name data))))
 
-(define (git-repository->origin recipe url)
-  "Fetch origin details from the Git repository at URL for the provided MELPA
-RECIPE."
-  (define ref
-    (cond
-     ((assoc-ref recipe #:branch)
-      => (lambda (branch) (cons 'branch branch)))
-     ((assoc-ref recipe #:commit)
-      => (lambda (commit) (cons 'commit commit)))
-     (else
-      '())))
-
-  (let-values (((directory commit) (download-git-repository url ref)))
-    `(origin
-       (method git-fetch)
-       (uri (git-reference
-             (url ,url)
-             (commit ,commit)))
-       (sha256
-        (base32
-         ,(bytevector->nix-base32-string
-           (file-hash* directory #:recursive? #true)))))))
+(define (ref recipe)
+  "Create REF from MELPA RECIPE."
+  (cond
+   ((assoc-ref recipe #:branch)
+    => (lambda (branch) (cons 'branch branch)))
+   ((assoc-ref recipe #:commit)
+    => (lambda (commit) (cons 'commit commit)))
+   (else
+    '())))
 
 (define* (melpa-recipe->origin recipe)
   "Fetch origin details from the MELPA recipe and associated repository for
@@ -266,9 +248,9 @@ (define (gitlab-repo->url repo)
     (string-append "https://gitlab.com/" repo ".git"))
 
   (match (assq-ref recipe ':fetcher)
-    ('github (git-repository->origin recipe (github-repo->url (assq-ref recipe ':repo))))
-    ('gitlab (git-repository->origin recipe (gitlab-repo->url (assq-ref recipe ':repo))))
-    ('git    (git-repository->origin recipe (assq-ref recipe ':url)))
+    ('github (git->origin (github-repo->url (assq-ref recipe ':repo)) (ref recipe)))
+    ('gitlab (git->origin (gitlab-repo->url (assq-ref recipe ':repo)) (ref recipe)))
+    ('git    (git->origin (assq-ref recipe ':url) (ref recipe)))
     (#f #f)   ; if we're not using melpa then this stops us printing a warning
     (_ (warning (G_ "Unsupported MELPA fetcher: ~a, falling back to unstable MELPA source.~%")
                 (assq-ref recipe ':fetcher))
diff --git a/guix/import/go.scm b/guix/import/go.scm
index 90d4c8931d..c8ee16fd39 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -501,49 +502,21 @@ (define (module-meta-data-repo-url meta-data goproxy)
       goproxy
       (module-meta-repo-root meta-data)))
 
-(define* (git-checkout-hash url reference algorithm)
-  "Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or
-tag."
-  (define cache
-    (string-append (or (getenv "TMPDIR") "/tmp")
-                   "/guix-import-go-"
-                   (passwd:name (getpwuid (getuid)))))
-
-  ;; Use a custom cache to avoid cluttering the default one under
-  ;; ~/.cache/guix, but choose one under /tmp so that it's persistent across
-  ;; subsequent "guix import" invocations.
-  (mkdir-p cache)
-  (chmod cache #o700)
-  (let-values (((checkout commit _)
-                (parameterize ((%repository-cache-directory cache))
-                  (update-cached-checkout url
-                                          #:ref
-                                          `(tag-or-commit . ,reference)))))
-    (file-hash* checkout #:algorithm algorithm #:recursive? #true)))
+;; This is done because the version field of the package, which the generated
+;; quoted expression refers to, has been stripped of any 'v' prefixed.
+(define (transform-version version)
+  (let ((plain-version? (string=? version (go-version->git-ref version)))
+        (v-prefixed?    (string-prefix? "v" version)))
+    ,(if (and plain-version? v-prefixed?)
+         '(string-append "v" version)
+         '(go-version->git-ref version))))
 
 (define (vcs->origin vcs-type vcs-repo-url version)
   "Generate the `origin' block of a package depending on what type of source
 control system is being used."
   (case vcs-type
     ((git)
-     (let ((plain-version? (string=? version (go-version->git-ref version)))
-           (v-prefixed?    (string-prefix? "v" version)))
-       `(origin
-          (method git-fetch)
-          (uri (git-reference
-                (url ,vcs-repo-url)
-                ;; This is done because the version field of the package,
-                ;; which the generated quoted expression refers to, has been
-                ;; stripped of any 'v' prefixed.
-                (commit ,(if (and plain-version? v-prefixed?)
-                             '(string-append "v" version)
-                             '(go-version->git-ref version)))))
-          (file-name (git-file-name name version))
-          (sha256
-           (base32
-            ,(bytevector->nix-base32-string
-              (git-checkout-hash vcs-repo-url (go-version->git-ref version)
-                                 (hash-algorithm sha256))))))))
+     (git->origin vcs-repo-url `(tag-or-commit . ,version) transform-version))
     ((hg)
      `(origin
         (method hg-fetch)
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index e5775e2fa9..f080539bda 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,7 +39,6 @@ (define-module (guix import minetest)
   #:use-module (guix import json)
   #:use-module ((gcrypt hash) #:select (open-sha256-port port-sha256))
   #:use-module (json)
-  #:use-module (guix base32)
   #:use-module (guix git)
   #:use-module ((guix git-download) #:prefix download:)
   #:use-module (guix hash)
@@ -283,12 +283,6 @@ (define url (string-append (%contentdb-api) "packages/?type=" type
 
 \f
 
-;; XXX copied from (guix import elpa)
-(define* (download-git-repository url ref)
-  "Fetch the given REF from the Git repository at URL."
-  (with-store store
-    (latest-repository-commit store url #:ref ref)))
-
 (define (make-minetest-sexp author/name version repository commit
                             inputs home-page synopsis
                             description media-license license)
@@ -298,25 +292,7 @@ (define (make-minetest-sexp author/name version repository commit
   `(package
      (name ,(contentdb->package-name author/name))
      (version ,version)
-     (source
-       (origin
-         (method git-fetch)
-         (uri (git-reference
-                (url ,repository)
-                (commit ,commit)))
-         (sha256
-          (base32
-           ;; The git commit is not always available.
-           ,(and commit
-                 (bytevector->nix-base32-string
-                  (file-hash*
-                   (download-git-repository repository
-                                            `(commit . ,commit))
-                   ;; 'download-git-repository' already filtered out the '.git'
-                   ;; directory.
-                   #:select? (const #true)
-                   #:recursive? #true)))))
-         (file-name (git-file-name name version))))
+     (source ,(git->origin repository `(tag-or-commit . ,commit)))
      (build-system minetest-mod-build-system)
      ,@(maybe-propagated-inputs (map contentdb->package-name inputs))
      (home-page ,home-page)
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 72795d2c61..3b31338e00 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2022 Alice Brenon <alice.brenon@ens-lyon.fr>
 ;;; Copyright © 2022 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,6 +41,8 @@ (define-module (guix import utils)
   #:use-module (guix discovery)
   #:use-module (guix build-system)
   #:use-module (guix gexp)
+  #:use-module (guix git)
+  #:use-module (guix hash)
   #:use-module ((guix i18n) #:select (G_))
   #:use-module (guix store)
   #:use-module (guix download)
@@ -63,6 +66,7 @@ (define-module (guix import utils)
 
             url-fetch
             guix-hash-url
+            git->origin
 
             package-names->package-inputs
             maybe-inputs
@@ -153,6 +157,38 @@ (define (guix-hash-url filename)
   "Return the hash of FILENAME in nix-base32 format."
   (bytevector->nix-base32-string (file-sha256 filename)))
 
+(define* (git->origin repo-url ref #:optional ref->commit)
+  "Generate the `origin' block of a package depending on the git source
+control system. REPO-URL or REF can be null."
+  (let-values (((directory commit)
+                (with-store store
+                  (latest-repository-commit store repo-url #:ref ref))))
+    (let* ((version (if (pair? ref)
+                        (cdr ref)
+                        #f))
+           (vcommit (match ref->commit
+                      (#t
+                       commit)
+                      (null?
+                       version)
+                      (_
+                       (ref->commit version)))))
+      `(origin
+         (method git-fetch)
+         (uri (git-reference
+               (url ,(and (not (eq? repo-url 'null)) repo-url))
+               (commit ,vcommit)))
+         (file-name (git-file-name name version))
+         (sha256
+          (base32
+           ,(if (pair? ref)
+                (bytevector->nix-base32-string
+                 (file-hash* directory
+                             ;; 'git-fetch' already filtered out the '.git' directory.
+                             #:select? (const #true)
+                             #:recursive? #true))
+                #f)))))))
+
 (define %spdx-license-identifiers
   ;; https://spdx.org/licenses/
   ;; The gfl1.0, nmap, repoze
diff --git a/tests/minetest.scm b/tests/minetest.scm
index cbb9e83889..c03f731845 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,15 +58,7 @@ (define* (make-package-sexp #:key
   `(package
      (name ,guix-name)
      (version ,version)
-     (source
-      (origin
-        (method git-fetch)
-        (uri (git-reference
-              (url ,(and (not (eq? repo 'null)) repo))
-              (commit #f)))
-        (sha256
-         (base32 #f))
-        (file-name (git-file-name name version))))
+     (source (git->origin repo #f))
      (build-system minetest-mod-build-system)
      ,@(maybe-propagated-inputs inputs)
      (home-page ,home-page)
-- 
2.39.1

[bug#61930] [PATCH] import: factorising git->origin in guix/import/utils.scm.

[Simon Tournier]

Hi Nicolas,

Sorry for the late reply.

On ven., 03 mars 2023 at 12:06, Nicolas Graves via Guix-patches via <guix-patches@gnu.org> wrote:
> ---
>  guix/import/elpa.scm     | 44 +++++++++++--------------------------
>  guix/import/go.scm       | 47 +++++++++-------------------------------
>  guix/import/minetest.scm | 28 ++----------------------
>  guix/import/utils.scm    | 36 ++++++++++++++++++++++++++++++
>  tests/minetest.scm       | 11 ++--------
>  5 files changed, 63 insertions(+), 103 deletions(-)

This patch does not apply anymore.  Could you rebase it on the top of
master?

Well, when using “git format-patch” the option ’--base’ is helpful for
this kind of cases because it stores the base commit against which it
applies.  Then, anyone is able to easily rebase.


> +(define (ref recipe)
> +  "Create REF from MELPA RECIPE."

Maybe instead, I would move this as a local definition under
’melpa-recipe->origin’.

> diff --git a/guix/import/utils.scm b/guix/import/utils.scm
> index 72795d2c61..3b31338e00 100644
> --- a/guix/import/utils.scm
> +++ b/guix/import/utils.scm
> @@ -13,6 +13,7 @@
>  ;;; Copyright © 2022 Alice Brenon <alice.brenon@ens-lyon.fr>
>  ;;; Copyright © 2022 Kyle Meyer <kyle@kyleam.com>
>  ;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
> +;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -40,6 +41,8 @@ (define-module (guix import utils)
>    #:use-module (guix discovery)
>    #:use-module (guix build-system)
>    #:use-module (guix gexp)
> +  #:use-module (guix git)
> +  #:use-module (guix hash)
>    #:use-module ((guix i18n) #:select (G_))
>    #:use-module (guix store)
>    #:use-module (guix download)
> @@ -63,6 +66,7 @@ (define-module (guix import utils)
>  
>              url-fetch
>              guix-hash-url
> +            git->origin
>  
>              package-names->package-inputs
>              maybe-inputs
> @@ -153,6 +157,38 @@ (define (guix-hash-url filename)
>    "Return the hash of FILENAME in nix-base32 format."
>    (bytevector->nix-base32-string (file-sha256 filename)))
>  
> +(define* (git->origin repo-url ref #:optional ref->commit)
> +  "Generate the `origin' block of a package depending on the git source
> +control system. REPO-URL or REF can be null."
> +  (let-values (((directory commit)
> +                (with-store store
> +                  (latest-repository-commit store repo-url #:ref ref))))
> +    (let* ((version (if (pair? ref)
> +                        (cdr ref)
> +                        #f))
> +           (vcommit (match ref->commit
             --^
         why vcommit?

Why not ’identifier’?


Cheers,
simon

bug#61930: close 61930

[Nicolas Graves via Guix-patches via]

Obsolete, see 62202.

-- 
Best regards,
Nicolas Graves