module/scripts/api-diff.scm

   1 ;;; api-diff --- diff guile-api.alist files
   2
   3 ;;      Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc.
   4 ;;
   5 ;; This program is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the GNU Lesser General Public License
   7 ;; as published by the Free Software Foundation; either version 3, or
   8 ;; (at your option) any later version.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; Lesser General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU Lesser General Public
  16 ;; License along with this software; see the file COPYING.LESSER.  If
  17 ;; not, write to the Free Software Foundation, Inc., 51 Franklin
  18 ;; Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
  21
  22 ;;; Commentary:
  23
  24 ;; Usage: api-diff [-d GROUPS] ALIST-FILE-A ALIST-FILE-B
  25 ;;
  26 ;; Read in the alists from files ALIST-FILE-A and ALIST-FILE-B
  27 ;; and display a (count) summary of the groups defined therein.
  28 ;; Optional arg "--details" (or "-d") specifies a comma-separated
  29 ;; list of groups, in which case api-diff displays instead the
  30 ;; elements added and deleted for each of the specified groups.
  31 ;;
  32 ;; For scheme programming, this module exports the proc:
  33 ;;  (api-diff A-file B-file)
  34 ;;
  35 ;; Note that the convention is that the "older" alist/file is
  36 ;; specified first.
  37 ;;
  38 ;; TODO: Develop scheme interface.
  39
  40 ;;; Code:
  41
  42 (define-module (scripts api-diff)
  43   :use-module (ice-9 common-list)
  44   :use-module (ice-9 format)
  45   :use-module (ice-9 getopt-long)
  46   :autoload (srfi srfi-13) (string-tokenize)
  47   :export (api-diff))
  48
  49 (define %include-in-guild-list #f)
  50 (define %summary "Show differences between two scan-api files.")
  51
  52 (define (read-alist-file file)
  53   (with-input-from-file file
  54     (lambda () (read))))
  55
  56 (define put set-object-property!)
  57 (define get object-property)
  58
  59 (define (read-api-alist-file file)
  60   (let* ((alist (read-alist-file file))
  61          (meta (assq-ref alist 'meta))
  62          (interface (assq-ref alist 'interface)))
  63     (put interface 'meta meta)
  64     (put interface 'groups (let ((ht (make-hash-table 31)))
  65                              (for-each (lambda (group)
  66                                          (hashq-set! ht group '()))
  67                                        (assq-ref meta 'groups))
  68                              ht))
  69     interface))
  70
  71 (define (hang-by-the-roots interface)
  72   (let ((ht (get interface 'groups)))
  73     (for-each (lambda (x)
  74                 (for-each (lambda (group)
  75                             (hashq-set! ht group
  76                                         (cons (car x)
  77                                               (hashq-ref ht group))))
  78                           (assq-ref x 'groups)))
  79               interface))
  80   interface)
  81
  82 (define (diff? a b)
  83   (let ((result (set-difference a b)))
  84     (if (null? result)
  85         #f                              ; CL weenies bite me
  86         result)))
  87
  88 (define (diff+note! a b note-removals note-additions note-same)
  89   (let ((same? #t))
  90     (cond ((diff? a b) => (lambda (x) (note-removals x) (set! same? #f))))
  91     (cond ((diff? b a) => (lambda (x) (note-additions x) (set! same? #f))))
  92     (and same? (note-same))))
  93
  94 (define (group-diff i-old i-new . options)
  95   (let* ((i-old (hang-by-the-roots i-old))
  96          (g-old (hash-fold acons '() (get i-old 'groups)))
  97          (g-old-names (map car g-old))
  98          (i-new (hang-by-the-roots i-new))
  99          (g-new (hash-fold acons '() (get i-new 'groups)))
 100          (g-new-names (map car g-new)))
 101     (cond ((null? options)
 102            (diff+note! g-old-names g-new-names
 103                        (lambda (removals)
 104                          (format #t "groups-removed: ~A\n" removals))
 105                        (lambda (additions)
 106                          (format #t "groups-added: ~A\n" additions))
 107                        (lambda () #t))
 108            (for-each (lambda (group)
 109                        (let* ((old (assq-ref g-old group))
 110                               (new (assq-ref g-new group))
 111                               (old-count (and old (length old)))
 112                               (new-count (and new (length new)))
 113                               (delta (and old new (- new-count old-count))))
 114                          (format #t " ~5@A  ~5@A  :  "
 115                                  (or old-count "-")
 116                                  (or new-count "-"))
 117                          (cond ((and old new)
 118                                 (let ((add-count 0) (sub-count 0))
 119                                   (diff+note!
 120                                    old new
 121                                    (lambda (subs)
 122                                      (set! sub-count (length subs)))
 123                                    (lambda (adds)
 124                                      (set! add-count (length adds)))
 125                                    (lambda () #t))
 126                                   (format #t "~5@D ~5@D : ~5@D"
 127                                           add-count (- sub-count) delta)))
 128                                (else
 129                                 (format #t "~5@A ~5@A : ~5@A" "-" "-" "-")))
 130                          (format #t "     ~A\n" group)))
 131                      (sort (union g-old-names g-new-names)
 132                            (lambda (a b)
 133                              (string<? (symbol->string a)
 134                                        (symbol->string b))))))
 135           ((assq-ref options 'details)
 136            => (lambda (groups)
 137                 (for-each (lambda (group)
 138                             (let* ((old (or (assq-ref g-old group) '()))
 139                                    (new (or (assq-ref g-new group) '()))
 140                                    (>>! (lambda (label ls)
 141                                           (format #t "~A ~A:\n" group label)
 142                                           (for-each (lambda (x)
 143                                                       (format #t " ~A\n" x))
 144                                                     ls))))
 145                               (diff+note! old new
 146                                           (lambda (removals)
 147                                             (>>! 'removals removals))
 148                                           (lambda (additions)
 149                                             (>>! 'additions additions))
 150                                           (lambda ()
 151                                             (format #t "~A: no changes\n"
 152                                                     group)))))
 153                           groups)))
 154           (else
 155            (error "api-diff: group-diff: bad options")))))
 156
 157 (define (api-diff . args)
 158   (let* ((p (getopt-long (cons 'api-diff args)
 159                          '((details (single-char #\d)
 160                                     (value #t))
 161                            ;; Add options here.
 162                            )))
 163          (rest (option-ref p '() '("/dev/null" "/dev/null")))
 164          (i-old (read-api-alist-file (car rest)))
 165          (i-new (read-api-alist-file (cadr rest)))
 166          (options '()))
 167     (cond ((option-ref p 'details #f)
 168            => (lambda (groups)
 169                 (set! options (cons (cons 'details
 170                                           (map string->symbol
 171                                                (string-tokenize
 172                                                 groups
 173                                                 #\,)))
 174                                     options)))))
 175     (apply group-diff i-old i-new options)))
 176
 177 (define main api-diff)
 178
 179 ;;; api-diff ends here