propagate-some-package.scm 2.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. (use-modules (gnu packages)
  2. (guix packages)
  3. (ice-9 match)
  4. (srfi srfi-1)
  5. (srfi srfi-26))
  6. ;;; Find which packages propagate a specific package
  7. (define* (package->inputs package #:key transitive?
  8. (types '(native normal propagated)))
  9. "Find the inputs of PACKAGE. Types is a list that can contain one
  10. or more of the 'native, 'normal or 'propagated symbols. Origin
  11. objects are removed from the results."
  12. (define-syntax-rule (and/null expr ...)
  13. "Like and, but returns '() upon encountering #f."
  14. (or (and expr ...)
  15. '()))
  16. (define* (package->inputs* package)
  17. "Return a procedure that returns the inputs TYPES of PACKAGE."
  18. (append-map (lambda (proc)
  19. (proc package))
  20. (if transitive?
  21. `(,@(and/null (member 'normal types)
  22. (list package-transitive-inputs))
  23. ,@(and/null (member 'native types)
  24. (list package-transitive-native-inputs))
  25. ,@(and/null (member 'propagated types)
  26. (list package-transitive-propagated-inputs)))
  27. `(,@(and/null (member 'normal types)
  28. (list package-inputs))
  29. ,@(and/null (member 'native types)
  30. (list package-native-inputs))
  31. ,@(and/null (member 'propagated types)
  32. (list package-propagated-inputs))))))
  33. (filter package? ;eliminate origin objects
  34. (map (match-lambda
  35. ((name package output ...)
  36. package))
  37. (delete-duplicates (remove null? (package->inputs* package))))))
  38. (define* (has-input? package input #:key (transitive? #t)
  39. (types '(native normal propagated)))
  40. "True if PACKAGE has INPUT among its inputs. By default, all types
  41. of packages are considered transitively, but this can be adjusted via
  42. the TRANSITIVE? and TYPES parameters."
  43. (member input (package->inputs package #:transitive? transitive?
  44. #:types types)))
  45. (define (run-example)
  46. ;; Find all the packages propagating gdk-pixbuf.
  47. (let ((gdk-pixbuf (specification->package "gdk-pixbuf")))
  48. (fold-packages (lambda (package result)
  49. (if (has-input? package gdk-pixbuf
  50. #:transitive? #f
  51. #:types '(propagated))
  52. (cons package result)
  53. result))
  54. '())))