refresh: Use (guix discovery).

* guix/scripts/refresh.scm (maybe-updater, list-updaters): Remove.
(importer-modules): New procedure.
(%updaters): Define using 'fold-module-public-variables'.  Turn into a
promise and adjust users.
This commit is contained in:
Ludovic Courtès 2017-05-03 23:21:06 +02:00
parent cd903ef787
commit 634088a565
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 59 deletions

View File

@ -28,18 +28,10 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix discovery)
#:use-module (guix graph) #:use-module (guix graph)
#:use-module (guix scripts graph) #:use-module (guix scripts graph)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module ((guix gnu-maintenance)
#:select (%gnu-updater
%gnome-updater
%kde-updater
%xorg-updater
%kernel.org-updater))
#:use-module (guix import elpa)
#:use-module (guix import cran)
#:use-module (guix import hackage)
#:use-module (guix gnupg) #:use-module (guix gnupg)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module ((gnu packages commencement) #:select (%final-inputs)) #:use-module ((gnu packages commencement) #:select (%final-inputs))
@ -163,61 +155,27 @@ specified with `--select'.\n"))
;;; Updates. ;;; Updates.
;;; ;;;
(define-syntax maybe-updater (define (importer-modules)
;; Helper macro for 'list-updaters'. "Return the list of importer modules."
(syntax-rules (=>) (cons (resolve-interface '(guix gnu-maintenance))
((_ ((module => updater) rest ...) result) (all-modules (map (lambda (entry)
(maybe-updater (rest ...) `(,entry . "guix/import"))
(let ((iface (false-if-exception %load-path))))
(resolve-interface 'module)))
(tail result))
(if iface
(cons (module-ref iface 'updater) tail)
tail))))
((_ (updater rest ...) result)
(maybe-updater (rest ...)
(cons updater result)))
((_ () result)
(reverse result))))
(define-syntax-rule (list-updaters updaters ...)
"Expand to '(list UPDATERS ...)' but only the subset of UPDATERS that are
either unconditional, or have their requirement met.
A conditional updater has this form:
((SOME MODULE) => UPDATER)
meaning that UPDATER is added to the list if and only if (SOME MODULE) could
be resolved at run time.
This is a way to discard at macro expansion time updaters that depend on
unavailable optional dependencies such as Guile-JSON."
(maybe-updater (updaters ...) '()))
(define %updaters (define %updaters
;; List of "updaters" used by default. They are consulted in this order. ;; The list of publically-known updaters.
(list-updaters %gnu-updater (delay (fold-module-public-variables (lambda (obj result)
%gnome-updater (if (upstream-updater? obj)
%kde-updater (cons obj result)
%xorg-updater result))
%kernel.org-updater '()
%elpa-updater (importer-modules))))
%cran-updater
%bioconductor-updater
((guix import stackage) => %stackage-updater)
%hackage-updater
((guix import cpan) => %cpan-updater)
((guix import pypi) => %pypi-updater)
((guix import gem) => %gem-updater)
((guix import github) => %github-updater)
((guix import crate) => %crate-updater)))
(define (lookup-updater-by-name name) (define (lookup-updater-by-name name)
"Return the updater called NAME." "Return the updater called NAME."
(or (find (lambda (updater) (or (find (lambda (updater)
(eq? name (upstream-updater-name updater))) (eq? name (upstream-updater-name updater)))
%updaters) (force %updaters))
(leave (G_ "~a: no such updater~%") name))) (leave (G_ "~a: no such updater~%") name)))
(define (list-updaters-and-exit) (define (list-updaters-and-exit)
@ -240,7 +198,7 @@ unavailable optional dependencies such as Guile-JSON."
(* 100. (/ matches total))) (* 100. (/ matches total)))
(+ covered matches))) (+ covered matches)))
0 0
%updaters)) (force %updaters)))
(newline) (newline)
(format #t (G_ "~2,1f% of the packages are covered by these updaters.~%") (format #t (G_ "~2,1f% of the packages are covered by these updaters.~%")
@ -372,7 +330,7 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
opts) opts)
(() (()
;; Use the default updaters. ;; Use the default updaters.
%updaters) (force %updaters))
(lists (lists
(concatenate lists)))) (concatenate lists))))