#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do debian-package-downstream)' -s $0 "$@" # -*- scheme -*-
!#
;;; debian-package-downstream --- show what each package supports

;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2009, 2010,
;;   2011 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation; either version 3, or (at your option) any later
;; version.  There is NO WARRANTY.  See file COPYING for details.

;;; Commentary:

;; Usage: debian-package-downstream [[--recurse] PKG ...]
;;
;; Find the downstream packages for each installed package (as determined by
;; "dpkg --get-selections" whose last token on the line is "install"), that
;; are themselves installed, and display a summary line:
;;
;; * installed downstream count
;;   The number of packages downstream from this one that are actually
;;   installed on the system.
;;
;; * total downstream count
;;   The total number of packages downstream from this one, including
;;   those that may not actually be installed on the system.
;;
;; * package name
;;   A single symbol.
;;
;; * installed downstream
;;   List of symbols: (PKG1 PKG2 ...), possibly empty: ().
;;   Strictly speaking, the first field is redundant due to this one, but
;;   we include both anyway since it makes for easier reading by humans.
;;
;; If PKG is specified, only do analysis for those PKGs named
;; (still against the entire list of installed packages, however).
;;
;; When PKG is specified, option ‘--recurse’ (or ‘-r’ for short)
;; recurses into the downstreams of each PKG specified.

;;; Code:

(define-module (ttn-do debian-package-downstream)
  #:export (main)
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((srfi srfi-1) #:select (fold))
  #:use-module ((srfi srfi-13) #:select (string-prefix?
                                         substring/shared))
  #:use-module ((ice-9 popen) #:select (open-input-pipe close-pipe))
  #:use-module ((ice-9 rdelim) #:select (read-line))
  #:use-module ((ice-9 common-list) #:select (intersection
                                              uniq))
  #:use-module ((ttn-do zzz 0gx forms-from) #:select (forms<-port))
  #:use-module ((ttn-do zzz personally) #:select (accumulator
                                                  FE fs fso)))

(define (installed)
  (let ((acc (accumulator)))
    ;; The input is (PACKAGE STATE [PACKAGE STATE ...]).
    ;; This stashes the PACKAGE in ‘seen’ for "even" elements,
    ;; and applies ‘install’ filtering on the "odd" elements.
    (fold (lambda (x seen)
            (cond (seen (and (eq? 'install x) (acc seen))
                        #f)
                  (else x)))
          #f
          (forms<-port (open-input-pipe "dpkg --get-selections")))
    (uniq (acc))))

(define (downstream package)
  (let ((p (open-input-pipe (fs "apt-cache rdepends ~A" package))))
    (let loop ((acc '()))
      (let ((line (read-line p)))
        (cond ((eof-object? line)
               (close-pipe p)
               (reverse! acc))          ; rv
              ((and (< 3 (string-length line))
                    (char=? #\space (string-ref line 0))
                    (not (char=? #\space (string-ref line 3))))
               (let ((sym (string->symbol (substring/shared line 2))))
                 (loop (if (memq sym acc)
                           acc
                           (cons sym acc)))))
              (else
               (loop acc)))))))

(define (list-leaf-debian-packages recurse? specifically)
  (let ((all (installed))
        (seen (make-object-property)))

    (define (spew package all-down relevant)
      (fso "~A\t~A\t~A\t\t~A~%"
           (length relevant)
           (length all-down)
           package
           relevant))

    (define (visit package)
      (let* ((all-down (downstream package))
             (relevant (intersection all-down all)))
        (spew package all-down relevant)))

    (define (visit-deeply package)
      (or (seen package)
          (let* ((all-down (downstream package))
                 (relevant (intersection all-down all)))
            (set! (seen package) #t)
            (spew package all-down relevant)
            (FE relevant visit-deeply))))

    (if (null? specifically)
        (FE all visit)
        (FE (map string->symbol specifically)
            (if recurse?
                visit-deeply
                visit)))))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   ;; 1.0 -- no command-line processing
                   ;; 1.1 -- only analyze packages specified on command-line
                   ;; 1.2 -- add option --recurse
                   ;; 1.3 -- bugfix: delete duplicates
                   (version . "1.3")
                   (help . commentary)))
  (let ((qop (qop<-args args '((recurse (single-char #\r))))))
    (list-leaf-debian-packages (qop 'recurse) (qop '()))
    #t))

;;; debian-package-downstream ends here