autorecommended.lsp

   1 #!/usr/bin/newlisp
   2
   3 ; Strip away arch tail if any
   4 (define (noarch X) (if (find ":" X) (0 $it X) X))
   5
   6 ; Strip away all version specs from a dependency line
   7 (define (noversions X)
   8   (replace " \\([^)]*\\)" (copy X) "" 0))
   9
  10 ; Return list of "manually installed"
  11 (define (manual) (map noarch (exec "apt-mark showmanual")))
  12
  13 ; Return list of "all installed"
  14 (define (installed) (map noarch (exec "apt-mark showinstall")))
  15
  16 ; Return the provided package, if any, of a given package, or nil
  17 (define (provides P)
  18   (if (exec (format "dpkg-query -W -f '${Provides}' %s" P)) ($it 0) nil))
  19
  20 ; Return the "raw dependency line" for a package
  21 (define (raw-depends P)
  22   (exec (format "dpkg-query -W -f '${Pre-Depends} ${Depends}' %s" P)))
  23
  24 ; Set up hash table of provided packages by currently installed. This
  25 ; is needed for following up dependencies, which for an option
  26 ; dependency only automatically resolves the first of options.
  27 (define PROV:PROV nil)
  28 (write 2 "Initializing ")
  29 (dolist (P (installed))
  30   (let ((PV (provides P)))
  31     (if (= (% (inc COUNT) 100)) (write 2 "."))
  32     (if (PROV P) (push P (PROV P)) (PROV P (list P)))
  33     (if (PROV PV) (push P (PROV PV)) (PROV PV (list P)))))
  34 (dolist (P (PROV))
  35   (PROV (P 0) (sort (unique (P 1)))))
  36 (write-line 2 " done")
  37
  38 ; Look up the list of packages that providing the P package
  39 (define (provided P) (PROV P))
  40
  41 ; Return the "depends choice" of autmatically dependent package
  42 ; considering the options of providing that package as currently
  43 ; installed. Only the first of providers is an automatic dependency.
  44 ; Thus, return a) the depedent package itself if it's the first of its
  45 ; providers, or b) that first of providers if the dependent package is
  46 ; not among the providers (a fully virtual package), or c) nil if the
  47 ; depedent package is a provider but not the first.
  48 (define (depends-choice P)
  49   (let ((Y (if (PROV P) (first $it) nil)))
  50     (if (null? Y) nil (member P (PROV P)) (and (= P Y) P) Y)))
  51
  52 ; Resolve a depedency item with respect to package provisions, where
  53 ; an option depedency only automatically pulls in its first option.
  54 ; May return null
  55 (define (depends-choices X)
  56   (depends-choice (trim (first (parse (noversions X) "|")))))
  57
  58 ; Fix up a dependency line into list of packages, after cleanup
  59 (define (depends-fix X)
  60   (clean null? (map depends-choices (clean empty? (map trim (parse X ","))))))
  61
  62 ; Return dependencies of a package, with caching.
  63 (define DEP:DEP nil)
  64 (define (depends X)
  65   (if (DEP X) $it (DEP X (flat (map depends-fix (raw-depends X))))))
  66
  67 ; Expand a list of packages to include the closure of dependencies
  68 (define (closure L)
  69   (let ((X (sort L)))
  70     (write-line 2 (format "checking %d manual packages" (length X)))
  71     (while (!= X (setf L (sort (union X (apply union (map depends X))))))
  72       (setf X L)
  73       (write-line 2 (format " %d manual+dependent packages so far" (length X)))
  74       )
  75     X))
  76
  77 ## main: report the set difference between "all installed" and the
  78 ## dependency closure of "manually installed"
  79
  80 (let ((X (installed)) (Y nil))
  81   (write-line 2 (format "There are %d installed packages" (length X)))
  82   (setf Y (difference (installed) (closure (manual))))
  83   (write-line 2 (format "=> %d automatic recommended packages" (length Y)))
  84   (map println Y))
  85
  86 (exit 0)