unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Robert Vollmert <rob@vllmrt.net>
To: 35884@debbugs.gnu.org
Subject: [bug#35884] [PATCH] recursive import refactoring, and ignore option for hackage import
Date: Fri, 24 May 2019 17:09:05 +0200	[thread overview]
Message-ID: <790D25CC-533E-40B5-8346-E07AB8137A2C@vllmrt.net> (raw)

[-- Attachment #1: Type: text/plain, Size: 71 bytes --]

This is on top of https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35859


[-- Attachment #2: 0011-guix-build-download-Don-t-log-start-of-each-download.patch --]
[-- Type: application/octet-stream, Size: 1011 bytes --]

From 00e150fcb49f2d5e075cd7a16ddf3d56f321a629 Mon Sep 17 00:00:00 2001
From: Robert Vollmert <rob@vllmrt.net>
Date: Fri, 24 May 2019 10:44:09 +0200
Subject: [PATCH 11/13] guix: build: download: Don't log start of each
 download.

Downloads are already logged through the progress-reporter. If
such debug output is desired, it should probably be handled at
the call site.

* guix/build/download.scm (url-fetch): Remove debug log.
---
 guix/build/download.scm | 2 --
 1 file changed, 2 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 0c9c61de4b..b5ff90b920 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -766,8 +766,6 @@ otherwise simply ignore them."
                   (_       (list (string->uri url))))))
 
   (define (fetch uri file)
-    (format #t "~%Starting download of ~a~%From ~a...~%"
-            file (uri->string uri))
     (case (uri-scheme uri)
       ((http https)
        (false-if-exception*
-- 
2.21.0


[-- Attachment #3: 0012-guix-import-simplify-recursive-import.patch --]
[-- Type: application/octet-stream, Size: 4685 bytes --]

From 00942eff44cc4e1fc7f7d97c1279c941937c1c6c Mon Sep 17 00:00:00 2001
From: Robert Vollmert <rob@vllmrt.net>
Date: Sat, 18 May 2019 03:37:53 +0200
Subject: [PATCH 12/13] guix: import: simplify recursive import

This simplifies the logic of recursive-import, intending no
major functional changes. The package import function is no
longer called twice per package. Failed imports now make it
to the package stream as '() instead of #f.

* guix/import/utils.scm: Simplify recursive-import.
---
 guix/import/utils.scm | 86 ++++++++++++++++---------------------------
 1 file changed, 32 insertions(+), 54 deletions(-)

diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 516c0cfaa2..ff548b809a 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -378,57 +378,35 @@ separated by PRED."
                            #:allow-other-keys)
   "Generate a stream of package expressions for PACKAGE-NAME and all its
 dependencies."
-  (receive (package . dependencies)
-      (repo->guix-package package-name repo)
-    (if (not package)
-        stream-null
-
-        ;; Generate a lazy stream of package expressions for all unknown
-        ;; dependencies in the graph.
-        (let* ((make-state (lambda (queue done)
-                             (cons queue done)))
-               (next       (match-lambda
-                             (((next . rest) . done) next)))
-               (imported   (match-lambda
-                             ((queue . done) done)))
-               (done?      (match-lambda
-                             ((queue . done)
-                              (zero? (length queue)))))
-               (unknown?   (lambda* (dependency #:optional (done '()))
-                             (and (not (member dependency
-                                               done))
-                                  (null? (find-packages-by-name
-                                          (guix-name dependency))))))
-               (update     (lambda (state new-queue)
-                             (match state
-                               (((head . tail) . done)
-                                (make-state (lset-difference
-                                             equal?
-                                             (lset-union equal? new-queue tail)
-                                             done)
-                                            (cons head done)))))))
-          (stream-cons
-           package
-           (stream-unfold
-            ;; map: produce a stream element
-            (lambda (state)
-              (repo->guix-package (next state) repo))
-
-            ;; predicate
-            (negate done?)
-
-            ;; generator: update the queue
-            (lambda (state)
-              (receive (package . dependencies)
-                  (repo->guix-package (next state) repo)
-                (if package
-                    (update state (filter (cut unknown? <>
-                                               (cons (next state)
-                                                     (imported state)))
-                                          (car dependencies)))
-                    ;; TODO: Try the other archives before giving up
-                    (update state (imported state)))))
-
-            ;; initial state
-            (make-state (filter unknown? (car dependencies))
-                        (list package-name))))))))
+  (define (exists? dependency)
+    (not (null? (find-packages-by-name (guix-name dependency)))))
+  (define initial-state (list #f (list package-name) (list)))
+  (define (step state)
+    (match state
+      ((prev (next . rest) done)
+       (define (handle? dep)
+         (and
+           (not (equal? dep next))
+           (not (member dep done))
+           (not (exists? dep))))
+       (receive (package . dependencies) (repo->guix-package next repo)
+         (list
+           (if package package '()) ;; default #f on failure would interrupt
+           (if package
+             (lset-union equal? rest (filter handle? (car dependencies)))
+             rest)
+           (cons next done))))
+      ((prev '() done)
+       (list #f '() done))))
+
+  ;; Generate a lazy stream of package expressions for all unknown
+  ;; dependencies in the graph.
+  (stream-unfold
+    ;; map: produce a stream element
+    (match-lambda ((latest queue done) latest))
+    ;; predicate
+    (match-lambda ((latest queue done) latest))
+    ;; generator: update the queue
+    step
+    ;; initial state
+    (step initial-state)))
-- 
2.21.0


[-- Attachment #4: 0013-guix-import-hackage-Add-flag-to-allow-bypassing-exis.patch --]
[-- Type: application/octet-stream, Size: 5467 bytes --]

From d06fcb46f34636a662467289f39fa28423f7b682 Mon Sep 17 00:00:00 2001
From: Robert Vollmert <rob@vllmrt.net>
Date: Fri, 24 May 2019 16:00:25 +0200
Subject: [PATCH 13/13] guix import hackage: Add flag to allow bypassing
 existing packages.

This adds a command line flag `-i` which causes recursive import
to reimport packages that are already part of guix, allowing a way
to easily define updated versions of stale packages.

* guix/import/utils.scm (recursive-import): Add keyword argument `#:ignore-existing?`.
* guix/import/hackage.scm (hackage-recursive-import): Add keyword argument `#:ignore-existing?`.
* guix/scripts/import/hackage.scm: Add flag -i/--ignore.
* doc/guix.tex (import hackage): Document flag -i/--ignore.
---
 doc/guix.texi                   |  4 ++++
 guix/import/hackage.scm         |  8 +++++---
 guix/import/utils.scm           |  5 +++--
 guix/scripts/import/hackage.scm | 11 ++++++++++-
 4 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ae9ad0739e..45f2f14fd8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8692,6 +8692,10 @@ associated with the keys @code{os}, @code{arch} and @code{impl} is
 Traverse the dependency graph of the given upstream package recursively
 and generate package expressions for all those packages that are not yet
 in Guix.
+@item --ignore
+@itemx -i
+When importing recursively, generate package expressions also for
+dependencies that are already in Guix.
 @end table
 
 The command below imports metadata for the latest version of the
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 405294d186..d6f5448cfc 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -308,7 +308,8 @@ the hash of the Cabal file."
   (lambda* (package-name #:key
                          (include-test-dependencies? #t)
                          (port #f)
-                         (cabal-environment '()))
+                         (cabal-environment '())
+                         #:allow-other-keys)
    "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
 called with keyword parameter PORT, from PORT.  Return the `package'
 S-expression corresponding to that package, or #f on failure.
@@ -337,11 +338,12 @@ respectively."
 (define hackage->guix-package
   (memoize hackage->guix-package-impl))
 
-(define* (hackage-recursive-import package-name . args)
+(define* (hackage-recursive-import package-name #:key ignore-existing? #:allow-other-keys #:rest args)
   (recursive-import package-name #f
                     #:repo->guix-package (lambda (name repo)
                                            (apply hackage->guix-package (cons name args)))
-                    #:guix-name hackage-name->package-name))
+                    #:guix-name hackage-name->package-name
+                    #:ignore-existing? ignore-existing?))
 
 (define (hackage-package? package)
   "Return #t if PACKAGE is a Haskell package from Hackage."
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index ff548b809a..3ae31e497c 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -374,12 +374,13 @@ separated by PRED."
                                     name)))
 
 (define* (recursive-import package-name repo
-                           #:key repo->guix-package guix-name
+                           #:key repo->guix-package guix-name ignore-existing?
                            #:allow-other-keys)
   "Generate a stream of package expressions for PACKAGE-NAME and all its
 dependencies."
   (define (exists? dependency)
-    (not (null? (find-packages-by-name (guix-name dependency)))))
+    (and (not ignore-existing?)
+         (not (null? (find-packages-by-name (guix-name dependency))))))
   (define initial-state (list #f (list package-name) (list)))
   (define (step state)
     (match state
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index f4aac61078..6574adf010 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -59,6 +59,8 @@ version.\n"))
   (display (G_ "
   -h, --help                   display this help and exit"))
   (display (G_ "
+  -i, --ignore                 ignore existing packages on recursive import"))
+  (display (G_ "
   -r, --recursive              import packages recursively"))
   (display (G_ "
   -s, --stdin                  read from standard input"))
@@ -96,6 +98,11 @@ version.\n"))
          (option '(#\r "recursive") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'recursive #t result)))
+
+         (option '(#\i "ignore") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'ignore-existing? #t result)))
+
          %standard-import-options))
 
 \f
@@ -122,7 +129,9 @@ version.\n"))
                                   (current-input-port)
                                   #f)
                        #:cabal-environment
-                       (assoc-ref opts 'cabal-environment)))
+                       (assoc-ref opts 'cabal-environment)
+                       #:ignore-existing?
+                       (assoc-ref opts 'ignore-existing?)))
            (sexp (if (assoc-ref opts 'recursive)
                      ;; Recursive import
                      (map (match-lambda
-- 
2.21.0


                 reply	other threads:[~2019-05-24 15:13 UTC|newest]

Thread overview: [no followups] expand[flat|nested]  mbox.gz  Atom feed

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=790D25CC-533E-40B5-8346-E07AB8137A2C@vllmrt.net \
    --to=rob@vllmrt.net \
    --cc=35884@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).