Working with links in collection testing

original commit: 3312a8064d
This commit is contained in:
Jay McCarthy 2013-01-10 10:45:46 -07:00
parent 22acfa3cba
commit c13876971b

View File

@ -32,21 +32,52 @@
[(not (file-exists? p)) [(not (file-exists? p))
(error 'test "Given path ~e does not exist" p)])])) (error 'test "Given path ~e does not exist" p)])]))
;; XXX This should be in Racket somewhere and return all the paths, (module paths racket/base
;; including the ones from the user and system collection links files (the system one is not specified in the docs, so I can't actually implement it correctly) (require setup/link
(define (all-library-collection-paths) racket/list)
(find-library-collection-paths))
;; XXX This should be in Racket somewhere and return all the (struct col (name path) #:transparent)
;; collection paths, rather than just the first as collection-path
;; does. (define (get-linked user? version?)
;; (define version-re
;; This implementation is wrong, btw, because it would ignore (and version?
;; collect-only links (regexp-quote (version))))
(append
(for/list ([c+p (in-list (links #:user? user? #:version-regexp version-re #:with-path? #t))])
(col (car c+p)
(cdr c+p)))
(for/list ([cp (in-list (links #:root? #t #:user? user? #:version-regexp version-re))]
#:when (directory-exists? cp)
[collection (directory-list cp)]
#:when (directory-exists? (build-path cp collection)))
(col (path->string collection)
(build-path cp collection)))))
;; A list of `col's, where each collection may be represented
;; by multiple elements of the list, each with its own path.
(define (all-collections)
(remove-duplicates
(append*
(for/list ([cp (current-library-collection-paths)]
#:when (directory-exists? cp)
[collection (directory-list cp)]
#:when (directory-exists? (build-path cp collection)))
(col (path->string collection)
(build-path cp collection)))
(for*/list ([user? (in-list '(#t #f))]
[version? (in-list '(#t #f))])
(get-linked user? version?)))))
;; This should be in Racket somewhere and return all the collection
;; paths, rather than just the first as collection-path does.
(define (collection-paths c) (define (collection-paths c)
(for/list ([r (all-library-collection-paths)] (for/list ([col (all-collections)]
#:when (directory-exists? (build-path r c))) #:when (string=? c (col-name col)))
(build-path r c))) (col-path col)))
(provide collection-paths))
(require (submod "." paths))
(define collections? #f) (define collections? #f)
(define packages? #f) (define packages? #f)