gnu.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io>
   4 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
   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 utils) #:select (&fix-hint))
  24   #:use-module (guix diagnostics)
  25   #:use-module (srfi srfi-34)
  26   #:use-module (srfi srfi-35)
  27   #:use-module (ice-9 match)
  28   #:use-module (guix packages)
  29   #:use-module (gnu packages)
  30   #:use-module (gnu services)
  31   #:export (use-package-modules
  32             use-service-modules
  33             use-system-modules))
  34
  35 ;;; Commentary:
  36 ;;;
  37 ;;; This composite module re-exports core parts the (gnu …) public modules.
  38 ;;;
  39 ;;; Code:
  40
  41 (eval-when (eval load compile)
  42   (begin
  43     (define %public-modules
  44       '((gnu system)
  45         (gnu system mapped-devices)
  46         (gnu system file-systems)
  47         (gnu bootloader)
  48         (gnu bootloader grub)
  49         (gnu system keyboard)
  50         (gnu system pam)
  51         (gnu system shadow)                       ; 'user-account'
  52         (gnu system linux-initrd)
  53         (gnu system nss)
  54         (gnu services)
  55         (gnu services base)
  56         (gnu packages)
  57         (gnu packages base)
  58         (guix gexp)))                             ; so gexps can be used
  59
  60     (for-each (let ((i (module-public-interface (current-module))))
  61                 (lambda (m)
  62                   (module-use! i (resolve-interface m))))
  63               %public-modules)))
  64
  65 (define (%try-use-modules modules location make-hint)
  66   "Attempt to load all of MODULES.  Report errors as coming from LOCATION, a
  67 <location> record, and use MAKE-HINT to produce a fix hint."
  68   (define (location->string loc)
  69     (match loc
  70       (#f "")
  71       (($ <location> file line column)
  72        (format #f "~a:~a:~a: " file line column))))
  73
  74   (for-each (lambda (module)
  75               (catch 'misc-error
  76                 (lambda ()
  77                   (process-use-modules `((,module))))
  78                 (lambda _
  79                   (raise
  80                    (apply
  81                     make-compound-condition
  82                     (condition
  83                      (&message
  84                       (message (format #f (G_ "module ~a not found")
  85                                        module))))
  86                     (condition
  87                      (&error-location (location location)))
  88                     (or (and=> (make-hint module) list)
  89                         '()))))))
  90             modules))
  91
  92 (define (package-module-hint module)
  93   (define last-name
  94     (match module
  95       ((_ ... last)
  96        (symbol->string last))))
  97
  98   (match (find-packages-by-name last-name)
  99     (()
 100      (condition
 101       (&fix-hint
 102        (hint (G_ "\
 103 You may use @command{guix package --show=foo | grep location} to search
 104 for the location of package @code{foo}.
 105 If you get the line @code{location: gnu/packages/bar.scm:174:2},
 106 add @code{bar} to the @code{use-package-modules} form.")))))
 107     ((package _ ...)
 108      (condition
 109       (&fix-hint
 110        (hint (format #f (G_ "\
 111 Try adding @code{(use-package-modules ~a)}.")
 112                      (basename (location-file (package-location package))
 113                                ".scm"))))))))
 114
 115 (define (service-module-hint module)
 116   (define last-name
 117     (match module
 118       ((_ ... last)
 119        last)))
 120
 121   (match (lookup-service-types last-name)
 122     (()
 123      (condition
 124       (&fix-hint
 125        (hint (format #f (G_ "\
 126 You may use @command{guix system search ~a} to search for a service
 127 matching @code{~a}.
 128 If you get the line @code{location: gnu/services/foo.scm:188:2},
 129 add @code{foo} to the @code{use-service-modules} form.")
 130                      last-name last-name)))))
 131     ((package _ ...)
 132      (condition
 133       (&fix-hint
 134        (hint (format #f (G_ "\
 135 Try adding @code{(use-service-modules ~a)}.")
 136                      (basename (location-file (service-type-location package))
 137                                ".scm"))))))))
 138
 139 (define-syntax-rule (try-use-modules hint modules ...)
 140   (eval-when (expand load eval)
 141     (%try-use-modules '(modules ...)
 142                       (source-properties->location
 143                        (current-source-location))
 144                       hint)))
 145
 146 (define-syntax-rule (use-package-modules module ...)
 147   (try-use-modules package-module-hint
 148                    (gnu packages module) ...))
 149
 150 (define-syntax-rule (use-service-modules module ...)
 151   (try-use-modules service-module-hint
 152                    (gnu services module) ...))
 153
 154 (define-syntax-rule (use-system-modules module ...)
 155   (try-use-modules (const #f)                     ;no hint
 156                    (gnu system module) ...))
 157
 158 ;;; gnu.scm ends here