bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

store: Add #:cut? parameter to 'topologically-sorted'.

Browse source 
* guix/store.scm (topologically-sorted): Add #:cut? and honor it.
* tests/store.scm ("topologically-sorted, one item, cutting"): New
test.
This commit is contained in:
Ludovic Courtès 2019-12-12 12:55:42 +01:00
parent 22a9dc1b79
commit 947c4a1689
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 27 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
guix/store.scm
View file

@ -1378,9 +1378,10 @@ SEED."
its references, recursively)."
(fold-path store cons '() paths))
(define (topologically-sorted store paths)
(define* (topologically-sorted store paths #:key (cut? (const #f)))
"Return a list containing PATHS and all their references sorted in
topological order."
topological order. Skip store items that match CUT? as well as their
dependencies."
(define (traverse)
;; Do a simple depth-first traversal of all of PATHS.
(let loop ((paths paths)
@ -1394,17 +1395,20 @@ topological order."
(match paths
((head tail ...)
(if (visited? head)
(loop tail visited result)
(call-with-values
(lambda ()
(loop (references store head)
(visit head)
result))
(lambda (visited result)
(loop tail
visited
(cons head result))))))
(cond ((visited? head)
(loop tail visited result))
((cut? head)
(loop tail visited result))
(else
(call-with-values
(lambda ()
(loop (references store head)
(visit head)
result))
(lambda (visited result)
(loop tail
visited
(cons head result)))))))
(()
(values visited result)))))

10
tests/store.scm
View file

@ -388,6 +388,16 @@
(s (topologically-sorted %store (list d))))
(equal? s (list a b c d))))
(test-assert "topologically-sorted, one item, cutting"
(let* ((a (add-text-to-store %store "a" "a"))
(b (add-text-to-store %store "b" "b" (list a)))
(c (add-text-to-store %store "c" "c" (list b)))
(d (add-text-to-store %store "d" "d" (list c)))
(s (topologically-sorted %store (list d)
#:cut?
(cut string-suffix? "-b" <>))))
(equal? s (list c d))))
(test-assert "topologically-sorted, several items"
(let* ((a (add-text-to-store %store "a" "a"))
(b (add-text-to-store %store "b" "b" (list a)))