X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/c9384945984c393ef1a15efb5c07e272a27a2215..refs/heads/wip-bees:/gnu.scm diff --git a/gnu.scm b/gnu.scm index e573de6531..f139531ef3 100644 --- a/gnu.scm +++ b/gnu.scm @@ -1,5 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès +;;; Copyright © 2015 Joshua S. Grant +;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; @@ -16,7 +18,18 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . -(define-module (gnu)) +(define-module (gnu) + #:use-module (guix i18n) + #:use-module (guix diagnostics) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) + #:use-module (guix packages) + #:use-module (gnu packages) + #:use-module (gnu services) + #:export (use-package-modules + use-service-modules + use-system-modules)) ;;; Commentary: ;;; @@ -28,19 +41,115 @@ (begin (define %public-modules '((gnu system) + (gnu system mapped-devices) (gnu system file-systems) - (gnu system grub) ; 'grub-configuration' - (gnu system linux) ; 'base-pam-services' + (gnu bootloader) + (gnu bootloader grub) + (gnu system keyboard) + (gnu system pam) (gnu system shadow) ; 'user-account' (gnu system linux-initrd) + (gnu system nss) (gnu services) (gnu services base) (gnu packages) - (gnu packages base))) + (gnu packages base) + (guix gexp))) ; so gexps can be used (for-each (let ((i (module-public-interface (current-module)))) (lambda (m) (module-use! i (resolve-interface m)))) %public-modules))) +(define (%try-use-modules modules location make-hint) + "Attempt to load all of MODULES. Report errors as coming from LOCATION, a + record, and use MAKE-HINT to produce a fix hint." + (define (location->string loc) + (match loc + (#f "") + (($ file line column) + (format #f "~a:~a:~a: " file line column)))) + + (for-each (lambda (module) + (catch 'misc-error + (lambda () + (process-use-modules `((,module)))) + (lambda _ + (raise + (apply + make-compound-condition + (formatted-message (G_ "module ~a not found") + module) + (condition + (&error-location (location location))) + (or (and=> (make-hint module) list) + '())))))) + modules)) + +(define (package-module-hint module) + (define last-name + (match module + ((_ ... last) + (symbol->string last)))) + + (match (find-packages-by-name last-name) + (() + (condition + (&fix-hint + (hint (G_ "\ +You may use @command{guix package --show=foo | grep location} to search +for the location of package @code{foo}. +If you get the line @code{location: gnu/packages/bar.scm:174:2}, +add @code{bar} to the @code{use-package-modules} form."))))) + ((package _ ...) + (condition + (&fix-hint + (hint (format #f (G_ "\ +Try adding @code{(use-package-modules ~a)}.") + (basename (location-file (package-location package)) + ".scm")))))))) + +(define (service-module-hint module) + (define last-name + (match module + ((_ ... last) + last))) + + (match (lookup-service-types last-name) + (() + (condition + (&fix-hint + (hint (format #f (G_ "\ +You may use @command{guix system search ~a} to search for a service +matching @code{~a}. +If you get the line @code{location: gnu/services/foo.scm:188:2}, +add @code{foo} to the @code{use-service-modules} form.") + last-name last-name))))) + ((package _ ...) + (condition + (&fix-hint + (hint (format #f (G_ "\ +Try adding @code{(use-service-modules ~a)}.") + (basename (location-file (service-type-location package)) + ".scm")))))))) + +(define-syntax-rule (try-use-modules hint modules ...) + (eval-when (expand load eval) + (%try-use-modules '(modules ...) + (source-properties->location + (current-source-location)) + hint))) + +(define-syntax-rule (use-package-modules module ...) + (try-use-modules package-module-hint + (gnu packages module) ...)) + +(define-syntax-rule (use-service-modules module ...) + (try-use-modules service-module-hint + (gnu services module) ...)) + +(define-syntax-rule (use-system-modules module ...) + (try-use-modules (const #f) ;no hint + (gnu system module) ...)) + ;;; gnu.scm ends here