projects/guix·blob guix-extension-channels · refs

155 lines · 5.2 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <[email protected]>
3;;; Copyright © 2015 Joshua S. Grant <[email protected]>
4;;; Copyright © 2017 Mathieu Othacehe <[email protected]>
5;;;
6;;; This file is part of GNU Guix.
7;;;
8;;; GNU Guix is free software; you can redistribute it and/or modify it
9;;; under the terms of the GNU General Public License as published by
10;;; the Free Software Foundation; either version 3 of the License, or (at
11;;; your option) any later version.
12;;;
13;;; GNU Guix is distributed in the hope that it will be useful, but
14;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;;; GNU General Public License for more details.
17;;;
18;;; You should have received a copy of the GNU General Public License
19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20
21(define-module (gnu)
22 #:use-module (guix i18n)
23 #:use-module (guix diagnostics)
24 #:use-module (srfi srfi-34)
25 #:use-module (srfi srfi-35)
26 #:use-module (ice-9 match)
27 #:use-module (guix packages)
28 #:use-module (gnu packages)
29 #:use-module (gnu services)
30 #:export (use-package-modules
31 use-service-modules
32 use-system-modules))
33
34;;; Commentary:
35;;;
36;;; This composite module re-exports core parts the (gnu …) public modules.
37;;;
38;;; Code:
39
40(eval-when (eval load compile)
41 (begin
42 (define %public-modules
43 '((gnu system)
44 (gnu system mapped-devices)
45 (gnu system file-systems)
46 (gnu bootloader)
47 (gnu bootloader grub)
48 (gnu system keyboard)
49 (gnu system pam)
50 (gnu system shadow) ; 'user-account'
51 (gnu system linux-initrd)
52 (gnu system nss)
53 (gnu services)
54 (gnu services base)
55 (gnu packages)
56 (gnu packages base)
57 (guix gexp))) ; so gexps can be used
58
59 (for-each (let ((i (module-public-interface (current-module))))
60 (lambda (m)
61 (module-use! i (resolve-interface m))))
62 %public-modules)))
63
64(define (%try-use-modules modules location make-hint)
65 "Attempt to load all of MODULES. Report errors as coming from LOCATION, a
66<location> record, and use MAKE-HINT to produce a fix hint."
67 (define (location->string loc)
68 (match loc
69 (#f "")
70 (($ <location> file line column)
71 (format #f "~a:~a:~a: " file line column))))
72
73 (for-each (lambda (module)
74 (catch 'misc-error
75 (lambda ()
76 (process-use-modules `((,module))))
77 (lambda _
78 (raise
79 (apply
80 make-compound-condition
81 (formatted-message (G_ "module ~a not found")
82 module)
83 (condition
84 (&error-location (location location)))
85 (or (and=> (make-hint module) list)
86 '()))))))
87 modules))
88
89(define (package-module-hint module)
90 (define last-name
91 (match module
92 ((_ ... last)
93 (symbol->string last))))
94
95 (match (find-packages-by-name last-name)
96 (()
97 (condition
98 (&fix-hint
99 (hint (G_ "\
100You may use @command{guix package --show=foo | grep location} to search
101for the location of package @code{foo}.
102If you get the line @code{location: gnu/packages/bar.scm:174:2},
103add @code{bar} to the @code{use-package-modules} form.")))))
104 ((package _ ...)
105 (condition
106 (&fix-hint
107 (hint (format #f (G_ "\
108Try adding @code{(use-package-modules ~a)}.")
109 (basename (location-file (package-location package))
110 ".scm"))))))))
111
112(define (service-module-hint module)
113 (define last-name
114 (match module
115 ((_ ... last)
116 last)))
117
118 (match (lookup-service-types last-name)
119 (()
120 (condition
121 (&fix-hint
122 (hint (format #f (G_ "\
123You may use @command{guix system search ~a} to search for a service
124matching @code{~a}.
125If you get the line @code{location: gnu/services/foo.scm:188:2},
126add @code{foo} to the @code{use-service-modules} form.")
127 last-name last-name)))))
128 ((package _ ...)
129 (condition
130 (&fix-hint
131 (hint (format #f (G_ "\
132Try adding @code{(use-service-modules ~a)}.")
133 (basename (location-file (service-type-location package))
134 ".scm"))))))))
135
136(define-syntax-rule (try-use-modules hint modules ...)
137 (eval-when (expand load eval)
138 (%try-use-modules '(modules ...)
139 (source-properties->location
140 (current-source-location))
141 hint)))
142
143(define-syntax-rule (use-package-modules module ...)
144 (try-use-modules package-module-hint
145 (gnu packages module) ...))
146
147(define-syntax-rule (use-service-modules module ...)
148 (try-use-modules service-module-hint
149 (gnu services module) ...))
150
151(define-syntax-rule (use-system-modules module ...)
152 (try-use-modules (const #f) ;no hint
153 (gnu system module) ...))
154
155;;; gnu.scm ends here