aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-20 18:45:40 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-20 18:45:40 +0100
commitf58f676b12254cdf5adb453798917b06ac6609a6 (patch)
tree9c44ed893b75568c0636c5818eccc4888805fd6f
parentab6025b52cec792312d465107e9b86d7900c5f93 (diff)
downloadpatches-f58f676b12254cdf5adb453798917b06ac6609a6.tar
patches-f58f676b12254cdf5adb453798917b06ac6609a6.tar.gz
channels: Use 'fold2'.
* guix/channels.scm (latest-channel-instances): Use 'fold2' instead of 'fold'.
-rw-r--r--guix/channels.scm72
1 files changed, 36 insertions, 36 deletions
diff --git a/guix/channels.scm b/guix/channels.scm
index e588d86b4b..10345c1ce5 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -26,6 +26,7 @@
#:use-module (guix monads)
#:use-module (guix profiles)
#:use-module (guix derivations)
+ #:use-module (guix combinators)
#:use-module (guix store)
#:use-module (guix i18n)
#:use-module ((guix utils)
@@ -162,44 +163,43 @@ of previously processed channels."
(or (channel-commit b)
(not (or (channel-commit a)
(channel-commit b))))))))
+
;; Accumulate a list of instances. A list of processed channels is also
;; accumulated to decide on duplicate channel specifications.
- (match (fold (lambda (channel acc)
- (match acc
- ((#:channels previous-channels #:instances instances)
- (if (ignore? channel previous-channels)
- acc
- (begin
- (format (current-error-port)
- (G_ "Updating channel '~a' from Git repository at '~a'...~%")
- (channel-name channel)
- (channel-url channel))
- (let-values (((checkout commit)
- (latest-repository-commit store (channel-url channel)
- #:ref (channel-reference
- channel))))
- (let ((instance (channel-instance channel commit checkout)))
- (let-values (((new-instances new-channels)
- (latest-channel-instances
- store
- (channel-instance-dependencies instance)
- previous-channels)))
- `(#:channels
- ,(append (cons channel new-channels)
- previous-channels)
- #:instances
- ,(append (cons instance new-instances)
- instances))))))))))
- `(#:channels ,previous-channels #:instances ())
- channels)
- ((#:channels channels #:instances instances)
- (let ((instance-name (compose channel-name channel-instance-channel)))
- ;; Remove all earlier channel specifications if they are followed by a
- ;; more specific one.
- (values (delete-duplicates instances
- (lambda (a b)
- (eq? (instance-name a) (instance-name b))))
- channels)))))
+ (define-values (resulting-channels instances)
+ (fold2 (lambda (channel previous-channels instances)
+ (if (ignore? channel previous-channels)
+ (values previous-channels instances)
+ (begin
+ (format (current-error-port)
+ (G_ "Updating channel '~a' from Git repository at '~a'...~%")
+ (channel-name channel)
+ (channel-url channel))
+ (let-values (((checkout commit)
+ (latest-repository-commit store (channel-url channel)
+ #:ref (channel-reference
+ channel))))
+ (let ((instance (channel-instance channel commit checkout)))
+ (let-values (((new-instances new-channels)
+ (latest-channel-instances
+ store
+ (channel-instance-dependencies instance)
+ previous-channels)))
+ (values (append (cons channel new-channels)
+ previous-channels)
+ (append (cons instance new-instances)
+ instances))))))))
+ previous-channels
+ '() ;instances
+ channels))
+
+ (let ((instance-name (compose channel-name channel-instance-channel)))
+ ;; Remove all earlier channel specifications if they are followed by a
+ ;; more specific one.
+ (values (delete-duplicates instances
+ (lambda (a b)
+ (eq? (instance-name a) (instance-name b))))
+ resulting-channels)))
(define* (checkout->channel-instance checkout
#:key commit