guix/deprecation.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix deprecation)
  20   #:use-module (guix i18n)
  21   #:use-module (guix diagnostics)
  22   #:autoload   (guix utils) (source-properties->location)
  23   #:export (define-deprecated
  24             define-deprecated/alias
  25             warn-about-deprecation))
  26
  27 ;;; Commentary:
  28 ;;;
  29 ;;; Provide a mechanism to mark bindings as deprecated.
  30 ;;;
  31 ;;; Code:
  32
  33 (define* (warn-about-deprecation variable properties
  34                                  #:key replacement)
  35   (let ((location (and properties (source-properties->location properties))))
  36     (if replacement
  37         (warning location (G_ "'~a' is deprecated, use '~a' instead~%")
  38                  variable replacement)
  39         (warning location (G_ "'~a' is deprecated~%")
  40                  variable))))
  41
  42 (define-syntax define-deprecated
  43   (lambda (s)
  44     "Define a deprecated variable or procedure, along these lines:
  45
  46   (define-deprecated foo bar 42)
  47   (define-deprecated old new)
  48   (define-deprecated (baz x y) qux (qux y x))
  49
  50 This will write a deprecation warning to GUIX-WARNING-PORT."
  51     (syntax-case s ()
  52       ((_ (proc formals ...) replacement body ...)
  53        #'(define-deprecated proc replacement
  54            (lambda* (formals ...) body ...)))
  55       ((_ variable replacement exp)
  56        (identifier? #'variable)
  57        (with-syntax ((real (datum->syntax
  58                             #'variable
  59                             (symbol-append '%
  60                                            (syntax->datum #'variable)
  61                                            '/deprecated))))
  62          #`(begin
  63              (define real
  64                (begin
  65                  (lambda () replacement)          ;just to ensure it's bound
  66                  exp))
  67
  68              (define-syntax variable
  69                (lambda (s)
  70                  (warn-about-deprecation 'variable (syntax-source s)
  71                                          #:replacement 'replacement)
  72                  (syntax-case s ()
  73                    ((_ args (... ...))
  74                     #'(real args (... ...)))
  75                    (id
  76                     (identifier? #'id)
  77                     #'real)))))))
  78       ((_ variable alias)
  79        (identifier? #'alias)
  80        #'(define-deprecated variable alias alias)))))
  81
  82 (define-syntax-rule (define-deprecated/alias deprecated replacement)
  83   "Define as an alias a deprecated variable, procedure, or macro, along
  84 these lines:
  85
  86   (define-deprecated/alias nix-server? store-connection?)
  87
  88 where 'nix-server?' is the deprecated name for 'store-connection?'.
  89
  90 This will write a deprecation warning to GUIX-WARNING-PORT."
  91   (define-syntax deprecated
  92     (lambda (s)
  93       (warn-about-deprecation 'deprecated (syntax-source s)
  94                               #:replacement 'replacement)
  95       (syntax-case s ()
  96         ((_ args (... ...))
  97          #'(replacement args (... ...)))
  98         (id
  99          (identifier? #'id)
 100          #'replacement)))))