ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

channels: Use 'fold2'.

Browse source 
* guix/channels.scm (latest-channel-instances): Use 'fold2' instead of
'fold'.
This commit is contained in:
Ludovic Courtès 2019-01-20 18:45:40 +01:00
parent ab6025b52c
commit f58f676b12
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 36 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

72
guix/channels.scm
View file

@ -26,6 +26,7 @@ (define-module (guix channels)
#: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 @@ (define (ignore? channel others)
(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