[bug#73833] [PATCH] guix: import: composer: Improve composer-fetch.

[bug#73833] [PATCH] guix: import: composer: Improve composer-fetch.

[Nicolas Graves via Guix-patches via]

* guix/import/composer.scm (composer-fetch): Handle a case where
packages are #f. This improves composer-fetch behavior, which was
sometimes buggy.
---
 guix/import/composer.scm | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/guix/import/composer.scm b/guix/import/composer.scm
index abc9023be4..febde97791 100644
--- a/guix/import/composer.scm
+++ b/guix/import/composer.scm
@@ -111,7 +111,7 @@ (define* (composer-fetch name #:key (version #f))
                             (let ((pkgs (assoc-ref pkg "packages")))
                               (or (assoc-ref pkgs name) pkg))))))
     (if packages
-        (json->composer-package
+        (and=>
          (if version
              (assoc-ref packages version)
              (cdr
@@ -125,7 +125,8 @@ (define* (composer-fetch name #:key (version #f))
                         cur-max))
                    (_ cur-max)))
                (cons* "0.0.0" #f)
-               packages))))
+               packages)))
+         json->composer-package)
         #f)))
 
 (define (php-package-name name)
-- 
2.46.0

[bug#73833] [PATCH v2 0/5] Large improvements to import utils, composer import, and refresh.

[Nicolas Graves via Guix-patches via]

This patch series merges a lot of different worthwhile contributions
to the import system in Guix. Patches 1 and 2 are extracted from the
work I did on the Juliahub importer to homogeneize and factor out a
git->origin function. Patch 3 has a lot of various but transparent and
explained improvements to the composer import, which should be renamed
to "packagist" instead of "composer" by the way. Patch 4 is a fix to a
shortcoming in refresh. Patch 5 shows a way to use upstream-inputs to
update packages using requirement constraints from packagist.

Nicolas Graves (5):
  guix: import: utils: Add function git->origin.
  tests: go: Add mock-git->origin function.
  guix: import: composer: Improve importer.
  guix: refresh: Keep the version field of each update specification.
  guix: refresh: Implement basic upstream-source-inputs rich updates.

 guix/import/composer.scm | 236 ++++++++++++++++++++++-----------------
 guix/import/elpa.scm     |  44 +++-----
 guix/import/go.scm       |  57 +++-------
 guix/import/minetest.scm |  28 +----
 guix/import/utils.scm    |  39 +++++++
 guix/scripts/refresh.scm |  59 ++++++++--
 tests/composer.scm       |   2 +-
 tests/go.scm             |  30 +++--
 tests/minetest.scm       |  15 +--
 9 files changed, 280 insertions(+), 230 deletions(-)

-- 
2.46.0

[bug#73833] [PATCH v2 1/5] guix: import: utils: Add function git->origin.

[Nicolas Graves via Guix-patches via]

* guix/import/utils.scm: (git->origin): Add function.

* guix/import/elpa.scm
(download-git-repository): Remove function download-git-repository.
(git-repository->origin): Remove function git-repository->origin.
(ref): Add function ref.
(melpa-recipe->origin): Use functions git->origin and ref.

* guix/import/go.scm
(git-checkout-hash): Remove function git-checkout-hash.
(transform-version): Add function transform-version.
(vcs->origin): Use functions git->origin and transform-version. Add
optional argument transform-version.

* tests/import/go.scm
(go-module->guix-package): Adapt test case to changes in guix/import/go.scm.

* guix/import/minetest.scm
(download-git-repository): Remove function download-git-repository.
(make-minetest-sexp): Use function git->origin.

* tests/minetest.scm
(make-package-sexp): Use function git->origin.
(example-package): Adapt test-case to git->origin.

* guix/import/composer.scm
(make-php-sexp): Use function git->origin.

Change-Id: Ied05a63bdd60fbafe26fbbb4e115ff6f0bb9db3c
---
 guix/import/composer.scm | 85 ++++++++++++++--------------------------
 guix/import/elpa.scm     | 44 ++++++---------------
 guix/import/go.scm       | 57 ++++++++-------------------
 guix/import/minetest.scm | 28 ++-----------
 guix/import/utils.scm    | 39 ++++++++++++++++++
 tests/go.scm             | 29 ++++++++++----
 tests/minetest.scm       | 15 ++-----
 7 files changed, 127 insertions(+), 170 deletions(-)

diff --git a/guix/import/composer.scm b/guix/import/composer.scm
index abc9023be4..a6a482021f 100644
--- a/guix/import/composer.scm
+++ b/guix/import/composer.scm
@@ -19,12 +19,9 @@
 (define-module (guix import composer)
   #:use-module (ice-9 match)
   #:use-module (json)
-  #:use-module (guix base32)
-  #:use-module (guix build git)
-  #:use-module (guix build utils)
-  #:use-module (guix build-system)
   #:use-module (guix build-system composer)
   #:use-module ((guix diagnostics) #:select (warning))
+  #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix hash)
   #:use-module (guix i18n)
   #:use-module (guix import json)
@@ -32,11 +29,10 @@ (define-module (guix import composer)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix memoization)
   #:use-module (guix packages)
-  #:use-module (guix serialization)
+  #:use-module (guix store)
   #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:export (composer->guix-package
             %composer-updater
@@ -143,55 +139,34 @@ (define (make-php-sexp composer-package)
          (dependencies (map php-package-name
                             (composer-package-require composer-package)))
          (dev-dependencies (map php-package-name
-                                (composer-package-dev-require composer-package)))
-         (git? (equal? (composer-source-type source) "git")))
-    ((if git? call-with-temporary-directory call-with-temporary-output-file)
-     (lambda* (temp #:optional port)
-       (and (if git?
-               (begin
-                 (mkdir-p temp)
-                 (git-fetch (composer-source-url source)
-                            (composer-source-reference source)
-                            temp))
-               (url-fetch (composer-source-url source) temp))
-            `(package
-               (name ,(composer-package-name composer-package))
-               (version ,(composer-package-version composer-package))
-               (source
-                (origin
-                  ,@(if git?
-                        `((method git-fetch)
-                          (uri (git-reference
-                                (url ,(if (string-suffix?
-                                           ".git"
-                                           (composer-source-url source))
-                                          (string-drop-right
-                                           (composer-source-url source)
-                                           (string-length ".git"))
-                                          (composer-source-url source)))
-                                (commit ,(composer-source-reference source))))
-                          (file-name (git-file-name name version))
-                          (sha256
-                           (base32
-                            ,(bytevector->nix-base32-string
-                              (file-hash* temp)))))
-                        `((method url-fetch)
-                          (uri ,(composer-source-url source))
-                          (sha256 (base32 ,(guix-hash-url temp)))))))
-               (build-system composer-build-system)
-               ,@(if (null? dependencies)
-                     '()
-                     `((inputs
-                        (list ,@(map string->symbol dependencies)))))
-               ,@(if (null? dev-dependencies)
-                     '()
-                     `((native-inputs
-                        (list ,@(map string->symbol dev-dependencies)))))
-               (synopsis "")
-               (description ,(composer-package-description composer-package))
-               (home-page ,(composer-package-homepage composer-package))
-               (license ,(or (composer-package-license composer-package)
-                             'unknown-license!))))))))
+                                (composer-package-dev-require composer-package))))
+    `(package
+       (name ,(composer-package-name composer-package))
+       (version ,(composer-package-version composer-package))
+       (source
+        ,(if (string= (composer-source-type source) "git")
+             (git->origin (composer-source-url source)
+                          `(tag-or-commit . ,(composer-source-reference source)))
+             (let* ((source (composer-source-url source))
+                    (tarball (with-store store (download-to-store store source))))
+               `(origin
+                  (method url-fetch)
+                  (uri ,source)
+                  (sha256 (base32 ,(guix-hash-url tarball)))))))
+       (build-system composer-build-system)
+       ,@(if (null? dependencies)
+             '()
+             `((inputs
+                (list ,@(map string->symbol dependencies)))))
+       ,@(if (null? dev-dependencies)
+             '()
+             `((native-inputs
+                (list ,@(map string->symbol dev-dependencies)))))
+       (synopsis "")
+       (description ,(composer-package-description composer-package))
+       (home-page ,(composer-package-homepage composer-package))
+       (license ,(or (composer-package-license composer-package)
+                     'unknown-license!)))))
 
 (define composer->guix-package
   (memoize
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 46b6dc98a2..a755387242 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.
 ;;;
@@ -208,11 +209,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."
@@ -232,29 +228,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)))
-       (file-name (git-file-name name version))
-       (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
@@ -265,9 +247,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 dd9298808d..6e2ce2ed00 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -514,49 +515,24 @@ (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)))))
+;; 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))))
 
-  ;; 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)))
-
-(define (vcs->origin vcs-type vcs-repo-url version)
+(define* (vcs->origin vcs-type vcs-repo-url version
+                      #:key (transform-version #f))
   "Generate the `origin' block of a package depending on what type of source
-control system is being used."
+control system is being used. Optionally use the function TRANSFORM-VERSION
+which takes version as an input."
   (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)
+                  #:ref->commit transform-version))
     ((hg)
      `(origin
         (method hg-fetch)
@@ -649,7 +625,8 @@ (define* (go-module->guix-package module-path #:key
         (name ,guix-name)
         (version ,(strip-v-prefix version*))
         (source
-         ,(vcs->origin vcs-type vcs-repo-url version*))
+         ,(vcs->origin vcs-type vcs-repo-url version*
+                       #:transform-version transform-version))
         (build-system go-build-system)
         (arguments
          (list ,@(if (version>? min-go-version (package-version (go-package)))
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index 5ea6e023ce..65ef242431 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.
 ;;;
@@ -32,7 +33,6 @@ (define-module (guix import minetest)
   #:use-module (guix import utils)
   #:use-module (guix import json)
   #:use-module (json)
-  #:use-module (guix base32)
   #:use-module (guix git)
   #:use-module ((guix git-download) #:prefix download:)
   #:use-module (guix hash)
@@ -277,12 +277,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)
@@ -293,24 +287,8 @@ (define (make-minetest-sexp author/name version repository commit
      (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))))
+      ,(git->origin
+        repository `(tag-or-commit . ,commit) #:ref->commit #t))
      (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 b7756fcc40..8512e0d64c 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.
 ;;;
@@ -39,6 +40,8 @@ (define-module (guix import utils)
   #:use-module (guix packages)
   #:use-module (guix discovery)
   #:use-module (guix build-system)
+  #: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
@@ -161,6 +165,41 @@ (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 #:key (ref->commit #f))
+  "Returns a generated `origin' block of a package depending on the git source
+control system, and the directory in the store where the package has been
+downloaded, in case further processing is necessary.  REPO-URL or REF can be
+null. REF->COMMIT can be a function or #t, in which case the commit matching
+ref is used. If REF->COMMIT is not used, the value inside REF is used."
+  (let* ((version (and (pair? ref) (cdr ref)))
+         (directory commit
+                    (if version
+                        (with-store store
+                          (latest-repository-commit store repo-url
+                                                    #:ref (if version ref '())))
+                        (values #f #f)))
+         (vcommit (match ref->commit
+                    (#t    commit)
+                    (#f    version)
+                    ((? procedure?) (ref->commit version))
+                    (_     #f))))
+    (values
+     `(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
+          ,(and version  ; Version or commit is not always available.
+                (bytevector->nix-base32-string
+                 (file-hash* directory
+                             ;; 'git-fetch' already filtered out '.git'.
+                             #:select? (const #true)
+                             #:recursive? #true))))))
+     directory)))
+
 (define %spdx-license-identifiers
   ;; https://spdx.org/licenses/
   ;; The gfl1.0, nmap, repoze
diff --git a/tests/go.scm b/tests/go.scm
index f925c485c1..8402f3e978 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,7 +25,6 @@ (define-module (tests-import-go)
   #:use-module (guix base32)
   #:use-module (guix build-system go)
   #:use-module (guix import go)
-  #:use-module (guix base32)
   #:use-module ((guix utils) #:select (call-with-temporary-directory))
   #:use-module (guix tests)
   #:use-module (ice-9 match)
@@ -403,13 +403,26 @@ (define (mock-http-get testcase)
             (mock-http-get fixtures-go-check-test))
          (mock ((guix http-client) http-fetch
                 (mock-http-fetch fixtures-go-check-test))
-             (mock ((guix git) update-cached-checkout
-                    (lambda* (url #:key ref)
-                      ;; Return an empty directory and its hash.
-                      (values checkout
-                              (nix-base32-string->bytevector
-                               "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
-                              #f)))
+             (mock ((guix import utils) git->origin
+                    ;; Mock an empty directory by replacing hash.
+                    (lambda* (repo-url ref #:key (ref->commit #f))
+                      (let* ((version (if (pair? ref)
+                                          (cdr ref)
+                                          #f))
+                             (vcommit (match ref->commit
+                                        (#t    commit)
+                                        (#f    version)
+                                        ((? procedure?) (ref->commit version))
+                                        (_     #f))))
+                        `(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
+                             "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"))))))
                  (go-module->guix-package* "github.com/go-check/check")))))))
 
 (test-end "go")
diff --git a/tests/minetest.scm b/tests/minetest.scm
index bf1313ee22..94e93c64bf 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)
@@ -419,8 +412,8 @@ (define* (example-package #:key
            (uri (git-reference
                  (url repo)
                  (commit commit #;"808f9ffbd3106da4c92d2367b118b98196c9e81e")))
-           (sha256 #f) ; not important for the following tests
-           (file-name (git-file-name name version)))
+           (file-name (git-file-name name version))
+           (sha256 #f)) ; not important for the following tests
          source))
     (build-system minetest-mod-build-system)
     (license #f)
-- 
2.46.0

[bug#73833] [PATCH v2 1/5] guix: import: utils: Add function git->origin.

[Ludovic Courtès]

Hi,

Nice patch series!

Nicolas Graves <ngraves@ngraves.fr> skribis:

> * guix/import/utils.scm: (git->origin): Add function.
>
> * guix/import/elpa.scm
> (download-git-repository): Remove function download-git-repository.
> (git-repository->origin): Remove function git-repository->origin.
> (ref): Add function ref.
> (melpa-recipe->origin): Use functions git->origin and ref.
>
> * guix/import/go.scm
> (git-checkout-hash): Remove function git-checkout-hash.
> (transform-version): Add function transform-version.
> (vcs->origin): Use functions git->origin and transform-version. Add
> optional argument transform-version.
>
> * tests/import/go.scm
> (go-module->guix-package): Adapt test case to changes in guix/import/go.scm.
>
> * guix/import/minetest.scm
> (download-git-repository): Remove function download-git-repository.
> (make-minetest-sexp): Use function git->origin.
>
> * tests/minetest.scm
> (make-package-sexp): Use function git->origin.
> (example-package): Adapt test-case to git->origin.
>
> * guix/import/composer.scm
> (make-php-sexp): Use function git->origin.
>
> Change-Id: Ied05a63bdd60fbafe26fbbb4e115ff6f0bb9db3c

[…]

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

More like: "Return a value suitable for the 'update-cached-checkout'
#:ref argument corresponding to RECIPE, a MELPA recipe alist."

> +;; 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)

Please add a docstring.

> -  ;; 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

Looks like this bit and its rationale in (guix import go) gets lost
here: ‘git->origin’ unconditionally uses ~/.cache, which means that
‘guix import go -r …’ would fill that directory.

Could we restore that behavior, probably as an option to ‘git->origin’?

> +control system is being used. Optionally use the function TRANSFORM-VERSION
> +which takes version as an input."

Two spaces after end-of-sentence period please.  :-)

“Call TRANSFORM-VERSION with VERSION as an argument to compute the
downstream version number.”

You can have #:key (transform-version identity) and call it
unconditionally (that is, it would always be a procedure, never #f).

> +(define* (git->origin repo-url ref #:key (ref->commit #f))
> +  "Returns a generated `origin' block of a package depending on the git source
> +control system, and the directory in the store where the package has been
> +downloaded, in case further processing is necessary.  REPO-URL or REF can be
> +null. REF->COMMIT can be a function or #t, in which case the commit matching
> +ref is used. If REF->COMMIT is not used, the value inside REF is used."

s/function/procedure/

> +  (let* ((version (and (pair? ref) (cdr ref)))
> +         (directory commit
> +                    (if version
> +                        (with-store store
> +                          (latest-repository-commit store repo-url
> +                                                    #:ref (if version ref '())))
> +                        (values #f #f)))
> +         (vcommit (match ref->commit
> +                    (#t    commit)
> +                    (#f    version)
> +                    ((? procedure?) (ref->commit version))
> +                    (_     #f))))

Weird semantics for ‘ref->commit’.  Could it not always be a procedure?

Also, s/vcommit/commit-string/ or something.  See the coding style
regarding identifiers (info "(guix) Formatting Code").

Likewise, could you remove uses of car/cdr in this patch set, at least
for new code (info "(guix) Data Types and Pattern Matching")?

Ludo’.

[bug#73833] [PATCH v2 1/5] guix: import: utils: Add function git->origin.

[Nicolas Graves via Guix-patches via]

On 2024-11-06 16:16, Ludovic Courtès wrote:

> Hi,
>
> Nice patch series!
>
> Nicolas Graves <ngraves@ngraves.fr> skribis:

[...] 

>> -  ;; 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
>
> Looks like this bit and its rationale in (guix import go) gets lost
> here: ‘git->origin’ unconditionally uses ~/.cache, which means that
> ‘guix import go -r …’ would fill that directory.
>
> Could we restore that behavior, probably as an option to
> ‘git->origin’?

Yes, we can.  However, IIRC my rationale was that the alternative used in
every other import module was to use the store (and not ~/.cache IIRC,
since it uses latest-repository-commit instead of
update-cached-checkout) as a cache.  Since we often import/update to
build after that, it seemed quite natural to let the store handle the
cache instead of managing a custom cache for that.

So yes, we loose a bit of functionality, but I think it's more
maintainable this way, if the original author doesn't disagree too much
on that.  WDYT?

[...]

>> +  (let* ((version (and (pair? ref) (cdr ref)))
>> +         (directory commit
>> +                    (if version
>> +                        (with-store store
>> +                          (latest-repository-commit store repo-url
>> +                                                    #:ref (if version ref '())))
>> +                        (values #f #f)))
>> +         (vcommit (match ref->commit
>> +                    (#t    commit)
>> +                    (#f    version)
>> +                    ((? procedure?) (ref->commit version))
>> +                    (_     #f))))
>
> Weird semantics for ‘ref->commit’.  Could it not always be a
> procedure?

I'll try. 
>
-- 
Best regards,
Nicolas Graves

[bug#73833] [PATCH v2 2/5] tests: go: Add mock-git->origin function.

[Nicolas Graves via Guix-patches via]

* tests/go.scm
(mock-git->origin): Add function.
(go-module->guix-package test): Use mock-git->origin.
---
 tests/go.scm | 41 +++++++++++++++++++++--------------------
 1 file changed, 21 insertions(+), 20 deletions(-)

diff --git a/tests/go.scm b/tests/go.scm
index 8402f3e978..c08a73a850 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -371,6 +371,26 @@ (define (mock-http-get testcase)
           (values response-header body)
           (error "mocked http-get Unexpected URL: " url)))))
 
+;; Mock an empty directory by replacing hash.
+(define* (mock-git->origin repo-url ref #:key (ref->commit #f))
+  (let* ((version (if (pair? ref)
+                      (cdr ref)
+                      #f))
+         (vcommit (match ref->commit
+                    (#t    commit)
+                    (#f    version)
+                    ((? procedure?) (ref->commit version))
+                    (_     #f))))
+    `(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
+         "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")))))
+
 (test-equal "go-module->guix-package"
   '(package
      (name "go-github-com-go-check-check")
@@ -403,26 +423,7 @@ (define (mock-http-get testcase)
             (mock-http-get fixtures-go-check-test))
          (mock ((guix http-client) http-fetch
                 (mock-http-fetch fixtures-go-check-test))
-             (mock ((guix import utils) git->origin
-                    ;; Mock an empty directory by replacing hash.
-                    (lambda* (repo-url ref #:key (ref->commit #f))
-                      (let* ((version (if (pair? ref)
-                                          (cdr ref)
-                                          #f))
-                             (vcommit (match ref->commit
-                                        (#t    commit)
-                                        (#f    version)
-                                        ((? procedure?) (ref->commit version))
-                                        (_     #f))))
-                        `(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
-                             "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"))))))
+             (mock ((guix import utils) git->origin mock-git->origin)
                  (go-module->guix-package* "github.com/go-check/check")))))))
 
 (test-end "go")
-- 
2.46.0

[bug#73833] [PATCH v2 3/5] guix: import: composer: Improve importer.

[Nicolas Graves via Guix-patches via]

* guix/import/composer.scm
(%composer-base-url): Move from here...
(%packagist-base-url): ...to here.
(requirements->prefixes): Add variable to read and take advantage of
version info in composer package requirements and...
(json->require): ...use it here. Rewrite of the function.
(composer-source): Add a sanitizer for composer-source-url.
(select-version): Add variable to select the most recent availble
version that is above to a given min-version and...
(composer-fetch): ...use it here. Improve the function.
(make-php-sexp, composer->guix-package): Adapt to requirements being
alists now.
(php-package?): Handle the particular phpunit case.
(dependency->input): Add min-version and max-version information. This
is currently limited to the first dependency suggested by
requirements.
(import-release): Fix git urls case. This is better but still a bit
buggy (refreshing can replace the version by a commit).

* tests/composer.scm
(%composer-base-url): Move from here...
(%packagist-base-url): ...to here.
---
 guix/import/composer.scm | 151 +++++++++++++++++++++++++++------------
 tests/composer.scm       |   2 +-
 2 files changed, 105 insertions(+), 48 deletions(-)

diff --git a/guix/import/composer.scm b/guix/import/composer.scm
index a6a482021f..d6af50da8c 100644
--- a/guix/import/composer.scm
+++ b/guix/import/composer.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
+;;; Copyright © 2023, 2024 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,8 @@ (define-module (guix import composer)
   #:use-module (json)
   #:use-module (guix build-system composer)
   #:use-module ((guix diagnostics) #:select (warning))
+  #:use-module ((guix import git) #:select (latest-git-tag-version))
+  #:use-module ((guix git-download) #:select (git-reference))
   #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix hash)
   #:use-module (guix i18n)
@@ -34,13 +37,14 @@ (define-module (guix import composer)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:export (composer->guix-package
             %composer-updater
             composer-recursive-import
 
-            %composer-base-url))
+            %packagist-base-url))
 
-(define %composer-base-url
+(define %packagist-base-url
   (make-parameter "https://repo.packagist.org"))
 
 (define (fix-version version)
@@ -54,26 +58,40 @@ (define (fix-version version)
      (substring version 1))
     (else version)))
 
-(define (latest-version versions)
-  (fold (lambda (a b) (if (version>? (fix-version a) (fix-version b)) a b))
-        (car versions) versions))
+(define (requirements->prefixes str)
+  (let* ((processed-str (string-replace-substring str " || " "|"))
+         (prefix-strs (string-split processed-str #\|)))
+    (filter-map (match-lambda
+                  ;; SemVer: ^ indicates major+minor match, not a whole match.
+                  ((? (cut string-prefix? "^" <>) prefix)
+                   (let ((pfx (string-drop prefix 1)))
+                     (if (eq? 2 (string-count prefix #\.))
+                         (string-take pfx (string-rindex pfx #\.))
+                         pfx)))
+                  ((? (cut string-suffix? ".*" <>) prefix)
+                   (string-drop-right prefix 2))
+                  (_ #f))
+         prefix-strs)))
 
 (define (json->require dict)
-  (if dict
-      (let loop ((result '()) (require dict))
-        (match require
-          (() result)
-          ((((? (cut string-contains <> "/") name) . _)
-             require ...)
-           (loop (cons name result) require))
-          ((_ require ...) (loop result require))
-          (_ result)))
+  (if (and dict (not (unspecified? dict)))
+      (filter-map
+       (match-lambda
+         (((? (cut string-contains <> "/") name) . requirements)
+          (list name (requirements->prefixes requirements)))
+         (_
+          #f))
+       dict)
       '()))
 
 (define-json-mapping <composer-source> make-composer-source composer-source?
   json->composer-source
   (type      composer-source-type)
-  (url       composer-source-url)
+  (url       composer-source-url "url"
+             (lambda (uri)
+               (if (string-suffix? ".git" uri)
+                   (string-drop-right uri 4)
+                   uri)))
   (reference composer-source-reference))
 
 (define-json-mapping <composer-package> make-composer-package composer-package?
@@ -98,31 +116,44 @@ (define (valid-version? v)
          (not (string-contains d "beta"))
          (not (string-contains d "rc")))))
 
+(define* (select-version packages #:key (min-version #f))
+  "Select the most recent available version in the PACKAGES list
+that is above or equal to MIN-VERSION. MIN-VERSION can be incomplete
+(e.g. version-major only)."
+  (let* ((points (and min-version (string-count min-version #\.)))
+         (min-prefix (and min-version
+                          (match points
+                            ((or 0 1) (fix-version min-version))
+                            (_ #f)))))
+    (cdr
+     (fold
+      (lambda (new cur-max)
+        (match new
+          (((? valid-version? version) . tail)
+           (let ((valid-version (fix-version version)))
+             (if (and (version>? valid-version (fix-version (car cur-max)))
+                      (or (not min-prefix)
+                          (version-prefix? min-prefix valid-version)))
+                 (cons* version tail)
+                 cur-max)))
+          (_ cur-max)))
+      (cons* "0.0.0" #f)
+      packages))))
+
 (define* (composer-fetch name #:key (version #f))
   "Return a composer-package representation of the Composer metadata for the
 package NAME with optional VERSION, or #f on failure."
-  (let* ((url (string-append (%composer-base-url) "/p/" name ".json"))
+  (let* ((url (string-append (%packagist-base-url) "/p/" name ".json"))
          (packages (and=> (json-fetch url)
                           (lambda (pkg)
                             (let ((pkgs (assoc-ref pkg "packages")))
                               (or (assoc-ref pkgs name) pkg))))))
-    (if packages
-        (json->composer-package
-         (if version
-             (assoc-ref packages version)
-             (cdr
-              (fold
-               (lambda (new cur-max)
-                 (match new
-                   (((? valid-version? version) . tail)
-                    (if (version>? (fix-version version)
-                                   (fix-version (car cur-max)))
-                        (cons* version tail)
-                        cur-max))
-                   (_ cur-max)))
-               (cons* "0.0.0" #f)
-               packages))))
-        #f)))
+    (and packages
+        (let ((v (assoc-ref packages version)))
+          (and=>
+           (or (and v (not (unspecified? v)) v)
+               (select-version packages #:min-version version))
+         json->composer-package)))))
 
 (define (php-package-name name)
   "Given the NAME of a package on Packagist, return a Guix-compliant name for
@@ -136,9 +167,9 @@ (define (make-php-sexp composer-package)
   "Return the `package' s-expression for a PHP package for the given
 COMPOSER-PACKAGE."
   (let* ((source (composer-package-source composer-package))
-         (dependencies (map php-package-name
+         (dependencies (map (compose php-package-name car)
                             (composer-package-require composer-package)))
-         (dev-dependencies (map php-package-name
+         (dev-dependencies (map (compose php-package-name car)
                                 (composer-package-dev-require composer-package))))
     `(package
        (name ,(composer-package-name composer-package))
@@ -176,10 +207,14 @@ (define composer->guix-package
 dependencies, or #f and the empty list on failure."
      (let ((package (composer-fetch package-name #:version version)))
        (if package
-           (let* ((dependencies-names (composer-package-require package))
-                  (dev-dependencies-names (composer-package-dev-require package)))
-             (values (make-php-sexp package)
-                     (append dependencies-names dev-dependencies-names)))
+           (values (make-php-sexp package)
+                   (append-map
+                    (match-lambda
+                      ((head . tail)
+                       (cons head (car tail)))
+                      (_ #f))
+                    (list (composer-package-require package)
+                          (composer-package-dev-require package))))
            (values #f '()))))))
 
 (define (guix-name->composer-name name)
@@ -213,24 +248,46 @@ (define (php-package? package)
   "Return true if PACKAGE is a PHP package from Packagist."
   (and
    (eq? (package-build-system package) composer-build-system)
-   (string-prefix? "php-" (package-name package))))
+   (or (string-prefix? "php-" (package-name package))
+       (string=? "phpunit" (package-name package)))))
 
 (define (dependency->input dependency type)
-  (upstream-input
-   (name dependency)
-   (downstream-name (php-package-name dependency))
-   (type type)))
+  (let* ((version (fix-version (caadr dependency)))
+         (points (and version (string-count version #\.)))
+         (max "99"))
+    (upstream-input
+     (name (car dependency))
+     (downstream-name (php-package-name (car dependency)))
+     (type type)
+     (min-version (match points
+                    (0 (string-append version ".0.0"))
+                    (1 (string-append version ".0"))
+                    (2 version)
+                    (_ 'any)))
+     (max-version (match points
+                    (0 (string-append version "." max "." max))
+                    (1 (string-append version "." max))
+                    (2 version)
+                    (_ 'any))))))
 
 (define* (import-release package #:key (version #f))
   "Return an <upstream-source> for VERSION or the latest release of PACKAGE."
   (let* ((php-name (guix-package->composer-name package))
-         (composer-package (composer-fetch php-name #:version version)))
+         (composer-package (composer-fetch php-name #:version version))
+         (new-version new-version-tag
+                      (latest-git-tag-version package #:version version)))
     (if composer-package
         (upstream-source
          (package (composer-package-name composer-package))
          (version (composer-package-version composer-package))
-         (urls (list (composer-source-url
-                      (composer-package-source composer-package))))
+         (urls
+          (let ((source (composer-package-source composer-package)))
+            (if (string=? (composer-source-type source) "git")
+                (git-reference
+                 (url (composer-source-url source))
+                 (commit (or new-version-tag
+                             (composer-source-reference source))))
+                (list (composer-source-url source)))))
          (inputs (append
                   (map (cut dependency->input <> 'regular)
                        (composer-package-require composer-package))
diff --git a/tests/composer.scm b/tests/composer.scm
index 9114fef19e..355ebab67c 100644
--- a/tests/composer.scm
+++ b/tests/composer.scm
@@ -61,7 +61,7 @@ (define test-source
   ;; Replace network resources with sample data.
   (with-http-server `((200 ,test-json)
                       (200 ,test-source))
-    (parameterize ((%composer-base-url (%local-url))
+    (parameterize ((%packagist-base-url (%local-url))
                    (current-http-proxy (%local-url)))
       (match (composer->guix-package "foo/bar")
         (`(package
-- 
2.46.0

[bug#73833] [PATCH v2 3/5] guix: import: composer: Improve importer.

[Ludovic Courtès]

Nicolas Graves <ngraves@ngraves.fr> skribis:

> * guix/import/composer.scm
> (%composer-base-url): Move from here...
> (%packagist-base-url): ...to here.
> (requirements->prefixes): Add variable to read and take advantage of
> version info in composer package requirements and...
> (json->require): ...use it here. Rewrite of the function.
> (composer-source): Add a sanitizer for composer-source-url.
> (select-version): Add variable to select the most recent availble
> version that is above to a given min-version and...
> (composer-fetch): ...use it here. Improve the function.
> (make-php-sexp, composer->guix-package): Adapt to requirements being
> alists now.
> (php-package?): Handle the particular phpunit case.
> (dependency->input): Add min-version and max-version information. This
> is currently limited to the first dependency suggested by
> requirements.
> (import-release): Fix git urls case. This is better but still a bit
> buggy (refreshing can replace the version by a commit).
>
> * tests/composer.scm
> (%composer-base-url): Move from here...
> (%packagist-base-url): ...to here.

[...]

> -(define %composer-base-url
> +(define %packagist-base-url
>    (make-parameter "https://repo.packagist.org"))

It would be best to have this in a separate patch.

> +(define (requirements->prefixes str)
> +  (let* ((processed-str (string-replace-substring str " || " "|"))
> +         (prefix-strs (string-split processed-str #\|)))
> +    (filter-map (match-lambda
> +                  ;; SemVer: ^ indicates major+minor match, not a whole match.
> +                  ((? (cut string-prefix? "^" <>) prefix)
> +                   (let ((pfx (string-drop prefix 1)))
> +                     (if (eq? 2 (string-count prefix #\.))
> +                         (string-take pfx (string-rindex pfx #\.))
> +                         pfx)))
> +                  ((? (cut string-suffix? ".*" <>) prefix)
> +                   (string-drop-right prefix 2))
> +                  (_ #f))
> +         prefix-strs)))

Please add a docstring and following the coding style for identifiers.

>  (define-json-mapping <composer-source> make-composer-source composer-source?
>    json->composer-source
>    (type      composer-source-type)
> -  (url       composer-source-url)
> +  (url       composer-source-url "url"
> +             (lambda (uri)
> +               (if (string-suffix? ".git" uri)
> +                   (string-drop-right uri 4)
> +                   uri)))

Is it the right place to change things?  I would keep <composer-source>
identical to the information available at packagist.org, and
post-process the URL only where it’s needed.

> +(define* (select-version packages #:key (min-version #f))
> +  "Select the most recent available version in the PACKAGES list
> +that is above or equal to MIN-VERSION. MIN-VERSION can be incomplete
> +(e.g. version-major only)."
> +  (let* ((points (and min-version (string-count min-version #\.)))
> +         (min-prefix (and min-version
> +                          (match points
> +                            ((or 0 1) (fix-version min-version))
> +                            (_ #f)))))
> +    (cdr
> +     (fold
> +      (lambda (new cur-max)
> +        (match new
> +          (((? valid-version? version) . tail)
> +           (let ((valid-version (fix-version version)))
> +             (if (and (version>? valid-version (fix-version (car cur-max)))
> +                      (or (not min-prefix)
> +                          (version-prefix? min-prefix valid-version)))
> +                 (cons* version tail)
> +                 cur-max)))
> +          (_ cur-max)))

No car/cdr please, especially since it’s already using ‘match’.

> +  (let* ((version (fix-version (caadr dependency)))
> +         (points (and version (string-count version #\.)))
> +         (max "99"))
> +    (upstream-input
> +     (name (car dependency))
> +     (downstream-name (php-package-name (car dependency)))
> +     (type type)
> +     (min-version (match points
> +                    (0 (string-append version ".0.0"))
> +                    (1 (string-append version ".0"))
> +                    (2 version)
> +                    (_ 'any)))
> +     (max-version (match points
> +                    (0 (string-append version "." max "." max))
> +                    (1 (string-append version "." max))
> +                    (2 version)
> +                    (_ 'any))))))

This thing with ‘points’ is kinda weird: ‘version>?’ works fine even
when there’s a different number of points in the arguments.

>  (define* (import-release package #:key (version #f))
>    "Return an <upstream-source> for VERSION or the latest release of PACKAGE."
>    (let* ((php-name (guix-package->composer-name package))
> -         (composer-package (composer-fetch php-name #:version version)))
> +         (composer-package (composer-fetch php-name #:version version))
> +         (new-version new-version-tag
> +                      (latest-git-tag-version package #:version version)))
>      (if composer-package
>          (upstream-source
>           (package (composer-package-name composer-package))
>           (version (composer-package-version composer-package))
> -         (urls (list (composer-source-url
> -                      (composer-package-source composer-package))))
> +         (urls
> +          (let ((source (composer-package-source composer-package)))
> +            (if (string=? (composer-source-type source) "git")
> +                (git-reference
> +                 (url (composer-source-url source))
> +                 (commit (or new-version-tag
> +                             (composer-source-reference source))))
> +                (list (composer-source-url source)))))

This seems to be an unrelated change (supporting fetching source from
Git).  Could it be separated out?

Could you add tests for the new functionality?

It’s important to have good test coverage to help maintain importers in
the long run.

Thanks,
Ludo’.

[bug#73833] [PATCH v2 4/5] guix: refresh: Keep the version field of each update specification.

[Nicolas Graves via Guix-patches via]

* guix/scripts/refresh.scm (options->update-specs)[update-specs]: Keep
the version field of each update specification.  This is done using a
variable to cache package names and then filter out unwanted candidates.
---
 guix/scripts/refresh.scm | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index ec7d38c22a..810c33c786 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -310,12 +310,23 @@ (define update-specs
        some)))
 
   (if (assoc-ref opts 'recursive?)
-      (mlet* %store-monad ((edges (node-edges %bag-node-type (all-packages)))
-                           (packages -> (node-transitive-edges
-                                         (map update-spec-package update-specs)
-                                         edges)))
-        ;; FIXME: The 'version' field of each update spec is lost.
-        (return (map update-spec packages)))
+      (mlet* %store-monad
+          ((edges (node-edges %bag-node-type (all-packages)))
+           (strict-spec-pkgs -> (map update-spec-package update-specs))
+           (strict-spec-pkg-names -> (map package-name strict-spec-pkgs))
+           (packages -> (node-transitive-edges strict-spec-pkgs edges))
+           (transitive-specs -> (map update-spec packages)))
+        (return (append update-specs
+                        (filter-map (match-lambda
+                                      ((? update? spec)
+                                       (if (member (package-name
+                                                    (update-spec-package spec))
+                                                   strict-spec-pkg-names)
+                                           spec
+                                           #f))
+                                      (_
+                                       #f))
+                                    transitive-specs))))
       (with-monad %store-monad
         (return update-specs))))
 
-- 
2.46.0

[bug#73833] [PATCH v2 4/5] guix: refresh: Keep the version field of each update specification.

[Ludovic Courtès]

Nicolas Graves <ngraves@ngraves.fr> skribis:

> * guix/scripts/refresh.scm (options->update-specs)[update-specs]: Keep
> the version field of each update specification.  This is done using a
> variable to cache package names and then filter out unwanted candidates.
> ---
>  guix/scripts/refresh.scm | 23 +++++++++++++++++------
>  1 file changed, 17 insertions(+), 6 deletions(-)
>
> diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
> index ec7d38c22a..810c33c786 100644
> --- a/guix/scripts/refresh.scm
> +++ b/guix/scripts/refresh.scm
> @@ -310,12 +310,23 @@ (define update-specs
>         some)))
>  
>    (if (assoc-ref opts 'recursive?)
> -      (mlet* %store-monad ((edges (node-edges %bag-node-type (all-packages)))
> -                           (packages -> (node-transitive-edges
> -                                         (map update-spec-package update-specs)
> -                                         edges)))
> -        ;; FIXME: The 'version' field of each update spec is lost.
> -        (return (map update-spec packages)))
> +      (mlet* %store-monad
> +          ((edges (node-edges %bag-node-type (all-packages)))
> +           (strict-spec-pkgs -> (map update-spec-package update-specs))
> +           (strict-spec-pkg-names -> (map package-name strict-spec-pkgs))
> +           (packages -> (node-transitive-edges strict-spec-pkgs edges))
> +           (transitive-specs -> (map update-spec packages)))
> +        (return (append update-specs
> +                        (filter-map (match-lambda
> +                                      ((? update? spec)
> +                                       (if (member (package-name
> +                                                    (update-spec-package spec))
> +                                                   strict-spec-pkg-names)
> +                                           spec
> +                                           #f))
> +                                      (_
> +                                       #f))
> +                                    transitive-specs))))

Or just:

  (filter (lambda (spec)
            (member (package-name (update-spec-package spec))
                    package-names))
          transitive-specs)

(IIUC.)

Maybe add a comment explaining that this is to retain the ‘version’
field of UPDATE-SPECS?

Also, check out the guidelines for identifiers.

Thanks,
Ludo’.

[bug#73833] [PATCH v2 5/5] guix: refresh: Implement basic upstream-source-inputs rich updates.

[Nicolas Graves via Guix-patches via]

* guix/scripts/refresh.scm (options->user-updaters): Add variable.
(options->update-specs)[input->update-spec]: Restrained default where
the min-version and max-version have the same major+minor version.
[update-specs]: Adapt user-specified packages to be aware of
upstream-source-inputs version in this restrained default.

This should allow to update dependent packages to the right version
as opposed to the latest version. Tested in some capacity, but very
alpha.

This also implies that the upstream-updater-import is able to provide
versions on top of packages, that the updater is able to read
incomplete semver versions (such as 3.2 instead of 3.2.1), and that
the upstream-inputs have their min-version and max-version set.
---
 guix/scripts/refresh.scm | 36 ++++++++++++++++++++++++++++++------
 1 file changed, 30 insertions(+), 6 deletions(-)

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 810c33c786..70685ddbc1 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -229,6 +229,14 @@ (define (update-specification->update-spec spec fallback-version)
     (idx (update-spec (specification->package (substring spec 0 idx))
                       (substring spec (1+ idx))))))
 
+(define (options->user-updaters opts)
+  ;; Return the list of user-specified updaters.
+  (filter-map (match-lambda
+                (('updaters . names)
+                 (map lookup-updater-by-name names))
+                (_ #f))
+              opts))
+
 (define (options->update-specs opts)
   "Return the list of <update-spec> records requested by OPTS, honoring
 options like '--recursive'."
@@ -269,6 +277,14 @@ (define (keep-newest package lst)
         (_
          (cons package lst)))))
 
+  (define (input->update-spec input)
+    (%update-spec
+     (specification->package (upstream-input-downstream-name input))
+     (if (string=? (version-major+minor (upstream-input-max-version input))
+                   (version-major+minor (upstream-input-min-version input)))
+         (version-major+minor (upstream-input-max-version input))
+         #f)))
+
   (define update-specs
     ;; Update specs explicitly passed as command-line arguments.
     (match (append-map (match-lambda
@@ -307,7 +323,19 @@ (define update-specs
                              '()
                              modules))))
       (some                                       ;user-specified packages
-       some)))
+       ;; When the user specifies updaters, and these updaters support
+       ;; min/max versions, updates specs so that they account for this
+       ;; updater.
+       (let ((user-updaters (options->user-updaters opts)))
+         (if (and user-updaters (not (unspecified? user-updaters))
+                  (not (null? user-updaters)))
+             (let* ((import (upstream-updater-import (caar user-updaters)))
+                    (package (update-spec-package (car some)))
+                    (version (update-spec-version (car some)))
+                    (source (import package #:version version))
+                    (upstream-inputs (upstream-source-inputs source)))
+               (append some (map input->update-spec upstream-inputs)))
+             some)))))
 
   (if (assoc-ref opts 'recursive?)
       (mlet* %store-monad
@@ -571,11 +599,7 @@ (define (parse-options)
 
   (define (options->updaters opts)
     ;; Return the list of updaters to use.
-    (match (filter-map (match-lambda
-                         (('updaters . names)
-                          (map lookup-updater-by-name names))
-                         (_ #f))
-                       opts)
+    (match (options->user-updaters opts)
       (()
        ;; Use the default updaters.
        (force %updaters))
-- 
2.46.0

[bug#73833] [Nicolas Graves via Guix-patches via] [bug#73833] [PATCH v2 5/5] guix: refresh: Implement basic upstream-source-inputs rich updates.

[Nicolas Graves via Guix-patches via]

On 2024-11-06 17:11, Nicolas Graves wrote:

> Thanks for your review, I'll update the patch series.  Just to let you
> know I've also implemented a more elaborated input->update-spec when
> working on hackage import with versions. Don't bother reviewing this 5/5
> one, I'll update it too which welcome changes from there.

Actually I have some questions about this before reworking further on
that.  As I said, I have also worked on the hackage one, and I come to
think that a single min-version and max-version is probably not the best
way to tackle this.

The reason behind this is that most other package managers are relying
on either semver with carets or >/>=/</<=/==/||/&& operators to resolve
the requirements.  The problem with min-version or max-version currently
is (IIRC) that when we define them, we don't necessarily have an
overview of available versions, and, because of that, it's really
difficult down the line in input->update-spec to properly select a
(targeted!) version. (especially if < or > is used).

Instead we could keep a requirements field, and have a function
(resolve available-versions requirements) that returns the valid
versions among available-versions.  Otherwise I have the impression I'm
playing with hacks just to comply with the min-version and max-version
fields.

WDYT ?

-- 
Best regards,
Nicolas Graves

[bug#73833] [Nicolas Graves via Guix-patches via] [bug#73833] [PATCH v2 5/5] guix: refresh: Implement basic upstream-source-inputs rich updates.

[Nicolas Graves via Guix-patches via]

On 2024-11-07 09:58, Nicolas Graves via Guix-patches via wrote:

> On 2024-11-06 17:11, Nicolas Graves wrote:
>
>> Thanks for your review, I'll update the patch series.  Just to let you
>> know I've also implemented a more elaborated input->update-spec when
>> working on hackage import with versions. Don't bother reviewing this 5/5
>> one, I'll update it too which welcome changes from there.
>
> Actually I have some questions about this before reworking further on
> that.  As I said, I have also worked on the hackage one, and I come to
> think that a single min-version and max-version is probably not the best
> way to tackle this.
>
> The reason behind this is that most other package managers are relying
> on either semver with carets or >/>=/</<=/==/||/&& operators to resolve
> the requirements.  The problem with min-version or max-version currently
> is (IIRC) that when we define them, we don't necessarily have an
> overview of available versions, and, because of that, it's really
> difficult down the line in input->update-spec to properly select a
> (targeted!) version. (especially if < or > is used).
>
> Instead we could keep a requirements field, and have a function
> (resolve available-versions requirements) that returns the valid

Actually now that I dig in cve.scm, I see that we already have a rich
logic defined for such version management, and that we can probably have
for every importer a converter to the >/>=/</<=/==/or/and requirements
logic in cve.scm and use the version-matches? function there.

Will have to try that, but I think it's a rather good direction to dig
in.  The only thing is that when we call input->update-spec, we probably
don't know which versions are available, though we could also
provide a way to fetch that properly for most if not all importers.

> versions among available-versions.  Otherwise I have the impression I'm
> playing with hacks just to comply with the min-version and max-version
> fields.
>
> WDYT ?

-- 
Best regards,
Nicolas Graves