12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061 |
- (use-modules (gnu packages)
- (guix packages)
- (ice-9 match)
- (srfi srfi-1)
- (srfi srfi-26))
- ;;; Find which packages propagate a specific package
- (define* (package->inputs package #:key transitive?
- (types '(native normal propagated)))
- "Find the inputs of PACKAGE. Types is a list that can contain one
- or more of the 'native, 'normal or 'propagated symbols. Origin
- objects are removed from the results."
- (define-syntax-rule (and/null expr ...)
- "Like and, but returns '() upon encountering #f."
- (or (and expr ...)
- '()))
- (define* (package->inputs* package)
- "Return a procedure that returns the inputs TYPES of PACKAGE."
- (append-map (lambda (proc)
- (proc package))
- (if transitive?
- `(,@(and/null (member 'normal types)
- (list package-transitive-inputs))
- ,@(and/null (member 'native types)
- (list package-transitive-native-inputs))
- ,@(and/null (member 'propagated types)
- (list package-transitive-propagated-inputs)))
- `(,@(and/null (member 'normal types)
- (list package-inputs))
- ,@(and/null (member 'native types)
- (list package-native-inputs))
- ,@(and/null (member 'propagated types)
- (list package-propagated-inputs))))))
- (filter package? ;eliminate origin objects
- (map (match-lambda
- ((name package output ...)
- package))
- (delete-duplicates (remove null? (package->inputs* package))))))
- (define* (has-input? package input #:key (transitive? #t)
- (types '(native normal propagated)))
- "True if PACKAGE has INPUT among its inputs. By default, all types
- of packages are considered transitively, but this can be adjusted via
- the TRANSITIVE? and TYPES parameters."
- (member input (package->inputs package #:transitive? transitive?
- #:types types)))
- (define (run-example)
- ;; Find all the packages propagating gdk-pixbuf.
- (let ((gdk-pixbuf (specification->package "gdk-pixbuf")))
- (fold-packages (lambda (package result)
- (if (has-input? package gdk-pixbuf
- #:transitive? #f
- #:types '(propagated))
- (cons package result)
- result))
- '())))
|