+(define (group-diff i-old i-new . options)
+ (let* ((i-old (hang-by-the-roots i-old))
+ (g-old (hash-fold acons '() (get i-old 'groups)))
+ (g-old-names (map car g-old))
+ (i-new (hang-by-the-roots i-new))
+ (g-new (hash-fold acons '() (get i-new 'groups)))
+ (g-new-names (map car g-new)))
+ (cond ((null? options)
+ (diff+note! g-old-names g-new-names
+ (lambda (removals)
+ (format #t "groups-removed: ~A\n" removals))
+ (lambda (additions)
+ (format #t "groups-added: ~A\n" additions))
+ (lambda () #t))
+ (for-each (lambda (group)
+ (let* ((old (assq-ref g-old group))
+ (new (assq-ref g-new group))
+ (old-count (and old (length old)))
+ (new-count (and new (length new)))
+ (delta (and old new (- new-count old-count))))
+ (format #t " ~5@A ~5@A ~5@A ~A\n"
+ (or old-count "-")
+ (or new-count "-")
+ (or delta "-")
+ group)))
+ (sort (union g-old-names g-new-names)
+ (lambda (a b)
+ (string<? (symbol->string a)
+ (symbol->string b))))))
+ ((assq-ref options 'details)
+ => (lambda (groups)
+ (for-each (lambda (group)
+ (let* ((old (or (assq-ref g-old group) '()))
+ (new (or (assq-ref g-new group) '()))
+ (>>! (lambda (label ls)
+ (format #t "~A ~A:\n" group label)
+ (for-each (lambda (x)
+ (format #t " ~A\n" x))
+ ls))))
+ (diff+note! old new
+ (lambda (removals)
+ (>>! 'removals removals))
+ (lambda (additions)
+ (>>! 'additions additions))
+ (lambda ()
+ (format #t "~A: no changes\n"
+ group)))))
+ groups)))
+ (else
+ (error "api-diff: group-diff: bad options")))))