TakeV/guix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

guix: import: simplify recursive import

Browse source 
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 (recursive-import): Simplify.

Signed-off-by: Oleg Pykhalov <go.wigust@gmail.com>
This commit is contained in:
Robert Vollmert 2019-05-27 22:07:31 +02:00 committed by Oleg Pykhalov
parent aa901521e4
commit 5b315f3ea9
No known key found for this signature in database
GPG key ID: 167F8EA5001AFA9C
1 changed files with 32 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
guix/import/utils.scm
View file

@ -4,6 +4,7 @@
;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -378,57 +379,35 @@ (define* (recursive-import package-name repo
#:allow-other-keys) #:allow-other-keys)
"Generate a stream of package expressions for PACKAGE-NAME and all its "Generate a stream of package expressions for PACKAGE-NAME and all its
dependencies." dependencies."
(receive (package . dependencies) (define (exists? dependency)
(repo->guix-package package-name repo) (not (null? (find-packages-by-name (guix-name dependency)))))
(if (not package) (define initial-state (list #f (list package-name) (list)))
stream-null (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 ;; Generate a lazy stream of package expressions for all unknown
;; dependencies in the graph. ;; dependencies in the graph.
(let* ((make-state (lambda (queue done) (stream-unfold
(cons queue done))) ;; map: produce a stream element
(next (match-lambda (match-lambda ((latest queue done) latest))
(((next . rest) . done) next))) ;; predicate
(imported (match-lambda (match-lambda ((latest queue done) latest))
((queue . done) done))) ;; generator: update the queue
(done? (match-lambda step
((queue . done) ;; initial state
(zero? (length queue))))) (step initial-state)))
(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))))))))