#!/usr/bin/newlisp

; Strip away arch tail if any
(define (noarch X) (if (find ":" X) (0 $it X) X))

; Strip away all version specs from a dependency line
(define (noversions X)
  (replace " \\([^)]*\\)" (copy X) "" 0))

; Return list of "manually installed"
(define (manual) (map noarch (exec "apt-mark showmanual")))

; Return list of "all installed"
(define (installed) (map noarch (exec "apt-mark showinstall")))

; Return the provided package, if any, of a given package, or nil
(define (provides P)
  (if (exec (format "dpkg-query -W -f '${Provides}' %s" P)) ($it 0) nil))

; Return the "raw dependency line" for a package
(define (raw-depends P)
  (exec (format "dpkg-query -W -f '${Pre-Depends} ${Depends}' %s" P)))

; Set up hash table of provided packages by currently installed. This
; is needed for following up dependencies, which for an option
; dependency only automatically resolves the first of options.
(define PROV:PROV nil)
(write 2 "Initializing ")
(dolist (P (installed))
  (let ((PV (provides P)))
    (if (= (% (inc COUNT) 100)) (write 2 "."))
    (if (PROV P) (push P (PROV P)) (PROV P (list P)))
    (if (PROV PV) (push P (PROV PV)) (PROV PV (list P)))))
(dolist (P (PROV))
  (PROV (P 0) (sort (unique (P 1)))))
(write-line 2 " done")

; Look up the list of packages that providing the P package
(define (provided P) (PROV P))

; Return the "depends choice" of autmatically dependent package
; considering the options of providing that package as currently
; installed. Only the first of providers is an automatic dependency.
; Thus, return a) the depedent package itself if it's the first of its
; providers, or b) that first of providers if the dependent package is
; not among the providers (a fully virtual package), or c) nil if the
; depedent package is a provider but not the first.
(define (depends-choice P)
  (let ((Y (if (PROV P) (first $it) nil)))
    (if (null? Y) nil (member P (PROV P)) (and (= P Y) P) Y)))

; Resolve a depedency item with respect to package provisions, where
; an option depedency only automatically pulls in its first option.
; May return null
(define (depends-choices X)
  (depends-choice (trim (first (parse (noversions X) "|")))))

; Fix up a dependency line into list of packages, after cleanup
(define (depends-fix X)
  (clean null? (map depends-choices (clean empty? (map trim (parse X ","))))))

; Return dependencies of a package, with caching.
(define DEP:DEP nil)
(define (depends X)
  (if (DEP X) $it (DEP X (flat (map depends-fix (raw-depends X))))))

; Expand a list of packages to include the closure of dependencies
(define (closure L)
  (let ((X (sort L)))
    (write-line 2 (format "checking %d manual packages" (length X)))
    (while (!= X (setf L (sort (union X (apply union (map depends X))))))
      (setf X L)
      (write-line 2 (format " %d manual+dependent packages so far" (length X)))
      )
    X))

## main: report the set difference between "all installed" and the
## dependency closure of "manually installed"

(let ((X (installed)) (Y nil))
  (write-line 2 (format "There are %d installed packages" (length X)))
  (setf Y (difference (installed) (closure (manual))))
  (write-line 2 (format "=> %d automatic recommended packages" (length Y)))
  (map println Y))

(exit 0)