summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--emacs/guix-base.el12
-rw-r--r--emacs/guix-info.el3
-rw-r--r--emacs/guix-main.scm882
3 files changed, 555 insertions, 342 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index d4ac643ceb..049d976912 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -323,8 +323,8 @@ following keywords are available:
 Call an appropriate scheme function and return a list of the
 form of `guix-entries'.
 
-ENTRY-TYPE should be one of the following symbols: `package' or
-`generation'.
+ENTRY-TYPE should be one of the following symbols: `package',
+`output' or `generation'.
 
 SEARCH-TYPE may be one of the following symbols:
 
@@ -337,7 +337,7 @@ SEARCH-TYPE may be one of the following symbols:
 PARAMS is a list of parameters for receiving.  If nil, get
 information with all available parameters."
   (guix-eval-read (guix-make-guile-expression
-                   'get-entries
+                   'entries
                    guix-current-profile params
                    entry-type search-type search-vals)))
 
@@ -563,9 +563,9 @@ See `guix-process-package-actions' for details."
   (or (null guix-operation-confirm)
       (let* ((entries (guix-get-entries
                        'package 'id
-                       (list (append (mapcar #'car install)
-                                     (mapcar #'car upgrade)
-                                     (mapcar #'car remove)))
+                       (append (mapcar #'car install)
+                               (mapcar #'car upgrade)
+                               (mapcar #'car remove))
                        '(id name version location)))
              (install-strings (guix-get-package-strings install entries))
              (upgrade-strings (guix-get-package-strings upgrade entries))
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index e7fc7f0f92..05281e7be7 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -512,7 +512,8 @@ ENTRY is an alist with package info."
                     (button-get btn 'output)))))
      (concat type-str " '" full-name "'")
      'action-type type
-     'id (guix-get-key-val entry 'id)
+     'id (or (guix-get-key-val entry 'package-id)
+             (guix-get-key-val entry 'id))
      'output output)))
 
 (defun guix-package-info-insert-output-path (path &optional _)
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 1383d08830..273a360dfc 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -20,17 +20,9 @@
 
 ;; Information about packages and generations is passed to the elisp
 ;; side in the form of alists of parameters (such as ‘name’ or
-;; ‘version’) and their values.  These alists are called "entries" in
-;; this code.  So to distinguish, just "package" in the name of a
-;; function means a guile object ("package" record) while
-;; "package entry" means alist of package parameters and values (see
-;; ‘package-param-alist’).
-;;
-;; "Entry" is probably not the best name for such alists, because there
-;; already exists "manifest-entry" which has nothing to do with the
-;; "entry" described above.  Do not be confused :)
+;; ‘version’) and their values.
 
-;; ‘get-entries’ function is the “entry point” for the elisp side to get
+;; ‘entries’ procedure is the “entry point” for the elisp side to get
 ;; information about packages and generations.
 
 ;; Since name/version pair is not necessarily unique, we use
@@ -43,10 +35,6 @@
 ;; Important: as object addresses live only during guile session, elisp
 ;; part should take care about updating information after "Guix REPL" is
 ;; restarted (TODO!)
-;;
-;; ‘installed’ parameter of a package entry contains information about
-;; installed outputs.  It is a list of "installed entries" (see
-;; ‘package-installed-param-alist’).
 
 ;; To speed-up the process of getting information, the following
 ;; auxiliary variables are used:
@@ -55,10 +43,6 @@
 ;;
 ;; - `%package-table' - Hash table of
 ;;   "name+version key"/"list of packages" pairs.
-;;
-;; - `%current-manifest-entries-table' - Hash table of
-;;   "name+version key"/"list of manifest entries" pairs.  This variable
-;;   is set by `set-current-manifest-maybe!' when it is needed.
 
 ;;; Code:
 
@@ -82,6 +66,9 @@
   (and (not (null? lst))
        (first lst)))
 
+(define (list-maybe obj)
+  (if (list? obj) obj (list obj)))
+
 (define full-name->name+version package-name->name+version)
 (define (name+version->full-name name version)
   (string-append name "-" version))
@@ -97,9 +84,6 @@
 (define name+version->key cons)
 (define key->name+version car+cdr)
 
-(define %current-manifest #f)
-(define %current-manifest-entries-table #f)
-
 (define %packages
   (fold-packages (lambda (pkg res)
                    (vhash-consq (object-address pkg) pkg res))
@@ -119,139 +103,113 @@
      %packages)
     table))
 
-;; FIXME get rid of this function!
-(define (set-current-manifest-maybe! profile)
-  (define (manifest-entries->hash-table entries)
-    (let ((entries-table (make-hash-table (length entries))))
-      (for-each (lambda (entry)
-                  (let* ((key (name+version->key
-                               (manifest-entry-name entry)
-                               (manifest-entry-version entry)))
-                         (ref (hash-ref entries-table key)))
-                    (hash-set! entries-table key
-                               (if ref (cons entry ref) (list entry)))))
-                entries)
-      entries-table))
-
-  (when profile
-    (let ((manifest (profile-manifest profile)))
-      (unless (and (manifest? %current-manifest)
-                   (equal? manifest %current-manifest))
-        (set! %current-manifest manifest)
-        (set! %current-manifest-entries-table
-              (manifest-entries->hash-table
-               (manifest-entries manifest)))))))
-
-(define (manifest-entries-by-name+version name version)
-  (or (hash-ref %current-manifest-entries-table
-                (name+version->key name version))
-      '()))
-
-(define (packages-by-name+version name version)
-  (or (hash-ref %package-table
-                (name+version->key name version))
-      '()))
-
-(define (packages-by-full-name full-name)
-  (call-with-values
-      (lambda () (full-name->name+version full-name))
-    packages-by-name+version))
-
-(define (package-by-address address)
-  (and=> (vhash-assq address %packages)
-         cdr))
-
-(define (packages-by-id id)
-  (if (integer? id)
-      (let ((pkg (package-by-address id)))
-        (if pkg (list pkg) '()))
-      (packages-by-full-name id)))
-
-(define (package-by-id id)
-  (first-or-false (packages-by-id id)))
-
-(define (newest-package-by-id id)
-  (and=> (id->name+version id)
-         (lambda (name)
-           (first-or-false (find-best-packages-by-name name #f)))))
-
-(define (id->name+version id)
-  (if (integer? id)
-      (and=> (package-by-address id)
-             (lambda (pkg)
-               (values (package-name pkg)
-                       (package-version pkg))))
-      (full-name->name+version id)))
+(define (manifest-entry->name+version+output entry)
+  (values
+   (manifest-entry-name    entry)
+   (manifest-entry-version entry)
+   (manifest-entry-output  entry)))
+
+(define (manifest-entries->hash-table entries)
+  "Return a hash table of name keys and lists of matching manifest ENTRIES."
+  (let ((table (make-hash-table (length entries))))
+    (for-each (lambda (entry)
+                (let* ((key (manifest-entry-name entry))
+                       (ref (hash-ref table key)))
+                  (hash-set! table key
+                             (if ref (cons entry ref) (list entry)))))
+              entries)
+    table))
 
-(define (fold-manifest-entries proc init)
-  "Fold over `%current-manifest-entries-table'.
-Call (PROC NAME VERSION ENTRIES RESULT) for each element of the hash
-table, using INIT as the initial value of RESULT."
-  (hash-fold (lambda (key entries res)
-               (let-values (((name version) (key->name+version key)))
-                 (proc name version entries res)))
+(define (manifest=? m1 m2)
+  (or (eq? m1 m2)
+      (equal? m1 m2)))
+
+(define manifest->hash-table
+  (let ((current-manifest #f)
+        (current-table #f))
+    (lambda (manifest)
+      "Return a hash table of name keys and matching MANIFEST entries."
+      (unless (manifest=? manifest current-manifest)
+        (set! current-manifest manifest)
+        (set! current-table (manifest-entries->hash-table
+                             (manifest-entries manifest))))
+      current-table)))
+
+(define* (manifest-entries-by-name manifest name #:optional version output)
+  "Return a list of MANIFEST entries matching NAME, VERSION and OUTPUT."
+  (let ((entries (or (hash-ref (manifest->hash-table manifest) name)
+                     '())))
+    (if (or version output)
+        (filter (lambda (entry)
+                  (and (or (not version)
+                           (equal? version (manifest-entry-version entry)))
+                       (or (not output)
+                           (equal? output  (manifest-entry-output entry)))))
+                entries)
+        entries)))
+
+(define (manifest-entry-by-output entries output)
+  "Return a manifest entry from ENTRIES matching OUTPUT."
+  (find (lambda (entry)
+          (string= output (manifest-entry-output entry)))
+        entries))
+
+(define (fold-manifest-by-name manifest proc init)
+  "Fold over MANIFEST entries.
+Call (PROC NAME VERSION ENTRIES RESULT), using INIT as the initial value
+of RESULT.  ENTRIES is a list of manifest entries with NAME/VERSION."
+  (hash-fold (lambda (name entries res)
+               (proc name (manifest-entry-version (car entries))
+                     entries res))
              init
-             %current-manifest-entries-table))
-
-(define (fold-object proc init obj)
-  (fold proc init
-        (if (list? obj) obj (list obj))))
+             (manifest->hash-table manifest)))
 
 (define* (object-transformer param-alist #:optional (params '()))
-  "Return function for transforming an object into alist of parameters/values.
+  "Return procedure transforming objects into alist of parameter/value pairs.
 
-PARAM-ALIST is alist of available object parameters (symbols) and functions
-returning values of these parameters.  Each function is called with object as
-a single argument.
+PARAM-ALIST is alist of available parameters (symbols) and procedures
+returning values of these parameters.  Each procedure is applied to
+objects.
 
-PARAMS is list of parameters from PARAM-ALIST that should be returned by a
-resulting function.  If PARAMS is not specified or is an empty list, use all
-available parameters.
+PARAMS is list of parameters from PARAM-ALIST that should be returned by
+a resulting procedure.  If PARAMS is not specified or is an empty list,
+use all available parameters.
 
 Example:
 
-  (let ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>))))
-        (number->alist (object-transformer alist '(plus1 mul2))))
+  (let* ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>))))
+         (number->alist (object-transformer alist '(plus1 mul2))))
     (number->alist 8))
   =>
   ((plus1 . 9) (mul2 . 16))
 "
-  (let ((alist (let ((use-all-params (null? params)))
-                 (filter-map (match-lambda
-                              ((param . fun)
-                               (and (or use-all-params
-                                        (memq param params))
-                                    (cons param fun)))
-                              (_ #f))
-                             param-alist))))
-    (lambda (object)
+  (let* ((use-all-params (null? params))
+         (alist (filter-map (match-lambda
+                             ((param . proc)
+                              (and (or use-all-params
+                                       (memq param params))
+                                   (cons param proc)))
+                             (_ #f))
+                            param-alist)))
+    (lambda objects
       (map (match-lambda
-            ((param . fun)
-             (cons param (fun object))))
+            ((param . proc)
+             (cons param (apply proc objects))))
            alist))))
 
-(define package-installed-param-alist
-  (list
-   (cons 'output       manifest-entry-output)
-   (cons 'path         manifest-entry-item)
-   (cons 'dependencies manifest-entry-dependencies)))
-
-(define manifest-entry->installed-entry
-  (object-transformer package-installed-param-alist))
+(define %manifest-entry-param-alist
+  `((output       . ,manifest-entry-output)
+    (path         . ,manifest-entry-item)
+    (dependencies . ,manifest-entry-dependencies)))
 
-(define (manifest-entries->installed-entries entries)
-  (map manifest-entry->installed-entry entries))
+(define manifest-entry->sexp
+  (object-transformer %manifest-entry-param-alist))
 
-(define (installed-entries-by-name+version name version)
-  (manifest-entries->installed-entries
-   (manifest-entries-by-name+version name version)))
-
-(define (installed-entries-by-package package)
-  (installed-entries-by-name+version (package-name package)
-                                     (package-version package)))
+(define (manifest-entries->sexps entries)
+  (map manifest-entry->sexp entries))
 
 (define (package-inputs-names inputs)
-  "Return list of full names of the packages from package INPUTS."
+  "Return a list of full names of the packages from package INPUTS."
   (filter-map (match-lambda
                ((_ (? package? package))
                 (package-full-name package))
@@ -259,90 +217,113 @@ Example:
               inputs))
 
 (define (package-license-names package)
-  "Return list of license names of the PACKAGE."
-  (fold-object (lambda (license res)
-                 (if (license? license)
-                     (cons (license-name license) res)
-                     res))
-               '()
-               (package-license package)))
+  "Return a list of license names of the PACKAGE."
+  (filter-map (lambda (license)
+                (and (license? license)
+                     (license-name license)))
+              (list-maybe (package-license package))))
 
 (define (package-unique? package)
   "Return #t if PACKAGE is a single package with such name/version."
-  (null? (cdr (packages-by-name+version (package-name package)
-                                        (package-version package)))))
-
-(define package-param-alist
-  (list
-   (cons 'id                object-address)
-   (cons 'name              package-name)
-   (cons 'version           package-version)
-   (cons 'license           package-license-names)
-   (cons 'synopsis          package-synopsis)
-   (cons 'description       package-description)
-   (cons 'home-url          package-home-page)
-   (cons 'outputs           package-outputs)
-   (cons 'non-unique        (negate package-unique?))
-   (cons 'inputs            (lambda (pkg) (package-inputs-names
-                                      (package-inputs pkg))))
-   (cons 'native-inputs     (lambda (pkg) (package-inputs-names
-                                      (package-native-inputs pkg))))
-   (cons 'propagated-inputs (lambda (pkg) (package-inputs-names
-                                      (package-propagated-inputs pkg))))
-   (cons 'location          (lambda (pkg) (location->string
-                                      (package-location pkg))))
-   (cons 'installed         installed-entries-by-package)))
+  (null? (cdr (packages-by-name (package-name package)
+                                (package-version package)))))
+
+(define %package-param-alist
+  `((id                . ,object-address)
+    (package-id        . ,object-address)
+    (name              . ,package-name)
+    (version           . ,package-version)
+    (license           . ,package-license-names)
+    (synopsis          . ,package-synopsis)
+    (description       . ,package-description)
+    (home-url          . ,package-home-page)
+    (outputs           . ,package-outputs)
+    (non-unique        . ,(negate package-unique?))
+    (inputs            . ,(lambda (pkg)
+                            (package-inputs-names
+                             (package-inputs pkg))))
+    (native-inputs     . ,(lambda (pkg)
+                            (package-inputs-names
+                             (package-native-inputs pkg))))
+    (propagated-inputs . ,(lambda (pkg)
+                            (package-inputs-names
+                             (package-propagated-inputs pkg))))
+    (location          . ,(lambda (pkg)
+                            (location->string (package-location pkg))))))
 
 (define (package-param package param)
-  "Return the value of a PACKAGE PARAM."
-  (define (accessor param)
-    (and=> (assq param package-param-alist)
-           cdr))
-  (and=> (accessor param)
+  "Return a value of a PACKAGE PARAM."
+  (and=> (assq-ref %package-param-alist param)
          (cut <> package)))
 
-(define (matching-package-entries ->entry predicate)
-  "Return list of package entries for the matching packages.
-PREDICATE is called on each package."
+
+;;; Finding packages.
+
+(define (package-by-address address)
+  (and=> (vhash-assq address %packages)
+         cdr))
+
+(define (packages-by-name+version name version)
+  (or (hash-ref %package-table
+                (name+version->key name version))
+      '()))
+
+(define (packages-by-full-name full-name)
+  (call-with-values
+      (lambda () (full-name->name+version full-name))
+    packages-by-name+version))
+
+(define (packages-by-id id)
+  (if (integer? id)
+      (let ((pkg (package-by-address id)))
+        (if pkg (list pkg) '()))
+      (packages-by-full-name id)))
+
+(define (id->name+version id)
+  (if (integer? id)
+      (and=> (package-by-address id)
+             (lambda (pkg)
+               (values (package-name pkg)
+                       (package-version pkg))))
+      (full-name->name+version id)))
+
+(define (package-by-id id)
+  (first-or-false (packages-by-id id)))
+
+(define (newest-package-by-id id)
+  (and=> (id->name+version id)
+         (lambda (name)
+           (first-or-false (find-best-packages-by-name name #f)))))
+
+(define (matching-packages predicate)
   (fold-packages (lambda (pkg res)
                    (if (predicate pkg)
-                       (cons (->entry pkg) res)
+                       (cons pkg res)
                        res))
                  '()))
 
-(define (make-obsolete-package-entry name version entries)
-  "Return package entry for an obsolete package with NAME and VERSION.
-ENTRIES is a list of manifest entries used to get installed info."
-  `((id        . ,(name+version->full-name name version))
-    (name      . ,name)
-    (version   . ,version)
-    (outputs   . ,(map manifest-entry-output entries))
-    (obsolete  . #t)
-    (installed . ,(manifest-entries->installed-entries entries))))
-
-(define (package-entries-by-name+version ->entry name version)
-  "Return list of package entries for packages with NAME and VERSION."
-  (let ((packages (packages-by-name+version name version)))
-    (if (null? packages)
-        (let ((entries (manifest-entries-by-name+version name version)))
-          (if (null? entries)
-              '()
-              (list (make-obsolete-package-entry name version entries))))
-        (map ->entry packages))))
+(define (filter-packages-by-output packages output)
+  (filter (lambda (package)
+            (member output (package-outputs package)))
+          packages))
+
+(define* (packages-by-name name #:optional version output)
+  "Return a list of packages matching NAME, VERSION and OUTPUT."
+  (let ((packages (if version
+                      (packages-by-name+version name version)
+                      (matching-packages
+                       (lambda (pkg) (string=? name (package-name pkg)))))))
+    (if output
+        (filter-packages-by-output packages output)
+        packages)))
 
-(define (package-entries-by-spec profile ->entry spec)
-  "Return list of package entries for packages with name specification SPEC."
-  (set-current-manifest-maybe! profile)
-  (let-values (((name version)
-                (full-name->name+version spec)))
-    (if version
-        (package-entries-by-name+version ->entry name version)
-        (matching-package-entries
-         ->entry
-         (lambda (pkg) (string=? name (package-name pkg)))))))
+(define (manifest-entry->packages entry)
+  (call-with-values
+      (lambda () (manifest-entry->name+version+output entry))
+    packages-by-name))
 
-(define (package-entries-by-regexp profile ->entry regexp match-params)
-  "Return list of package entries for packages matching REGEXP string.
+(define (packages-by-regexp regexp match-params)
+  "Return a list of packages matching REGEXP string.
 MATCH-PARAMS is a list of parameters that REGEXP can match."
   (define (package-match? package regexp)
     (any (lambda (param)
@@ -350,88 +331,311 @@ MATCH-PARAMS is a list of parameters that REGEXP can match."
              (and (string? val) (regexp-exec regexp val))))
          match-params))
 
-  (set-current-manifest-maybe! profile)
   (let ((re (make-regexp regexp regexp/icase)))
-    (matching-package-entries ->entry (cut package-match? <> re))))
-
-(define (package-entries-by-ids profile ->entry ids)
-  "Return list of package entries for packages matching KEYS.
-IDS may be an object-address, a full-name or a list of such elements."
-  (set-current-manifest-maybe! profile)
-  (fold-object
-   (lambda (id res)
-     (if (integer? id)
-         (let ((pkg (package-by-address id)))
-           (if pkg
-               (cons (->entry pkg) res)
-               res))
-         (let ((entries (package-entries-by-spec #f ->entry id)))
-           (if (null? entries)
-               res
-               (append res entries)))))
-   '()
-   ids))
-
-(define (newest-available-package-entries profile ->entry)
-  "Return list of package entries for the newest available packages."
-  (set-current-manifest-maybe! profile)
+    (matching-packages (cut package-match? <> re))))
+
+(define (all-available-packages)
+  "Return a list of all available packages."
+  (matching-packages (const #t)))
+
+(define (newest-available-packages)
+  "Return a list of the newest available packages."
   (vhash-fold (lambda (name elem res)
                 (match elem
-                  ((version newest pkgs ...)
-                   (cons (->entry newest) res))))
+                  ((_ newest pkgs ...)
+                   (cons newest res))))
               '()
               (find-newest-available-packages)))
 
-(define (all-available-package-entries profile ->entry)
-  "Return list of package entries for all available packages."
-  (set-current-manifest-maybe! profile)
-  (matching-package-entries ->entry (const #t)))
+
+;;; Making package/output patterns.
+
+(define (specification->package-pattern specification)
+  (call-with-values
+      (lambda ()
+        (full-name->name+version specification))
+    list))
 
-(define (manifest-package-entries ->entry)
-  "Return list of package entries for the current manifest."
-  (fold-manifest-entries
-   (lambda (name version entries res)
-     ;; We don't care about duplicates for the list of
-     ;; installed packages, so just take any package (car)
-     ;; matching name+version
-     (cons (car (package-entries-by-name+version ->entry name version))
-           res))
-   '()))
+(define (specification->output-pattern specification)
+  (call-with-values
+      (lambda ()
+        (package-specification->name+version+output specification #f))
+    list))
 
-(define (installed-package-entries profile ->entry)
-  "Return list of package entries for all installed packages."
-  (set-current-manifest-maybe! profile)
-  (manifest-package-entries ->entry))
-
-(define (generation-package-entries profile ->entry generation)
-  "Return list of package entries for packages from GENERATION."
-  (set-current-manifest-maybe!
-   (generation-file-name profile generation))
-  (manifest-package-entries ->entry))
-
-(define (obsolete-package-entries profile _)
-  "Return list of package entries for obsolete packages."
-  (set-current-manifest-maybe! profile)
-  (fold-manifest-entries
+(define (id->package-pattern id)
+  (if (integer? id)
+      (package-by-address id)
+      (specification->package-pattern id)))
+
+(define (id->output-pattern id)
+  "Return an output pattern by output ID.
+ID should be '<package-address>:<output>' or '<name>-<version>:<output>'."
+  (let-values (((name version output)
+                (package-specification->name+version+output id)))
+    (if version
+        (list name version output)
+        (list (package-by-address (string->number name))
+              output))))
+
+(define (specifications->package-patterns . specifications)
+  (map specification->package-pattern specifications))
+
+(define (specifications->output-patterns . specifications)
+  (map specification->output-pattern specifications))
+
+(define (ids->package-patterns . ids)
+  (map id->package-pattern ids))
+
+(define (ids->output-patterns . ids)
+  (map id->output-pattern ids))
+
+(define* (manifest-patterns-result packages res obsolete-pattern
+                                   #:optional installed-pattern)
+  "Auxiliary procedure for 'manifest-package-patterns' and
+'manifest-output-patterns'."
+  (if (null? packages)
+      (cons (obsolete-pattern) res)
+      (if installed-pattern
+          ;; We don't need duplicates for a list of installed packages,
+          ;; so just take any (car) package.
+          (cons (installed-pattern (car packages)) res)
+          res)))
+
+(define* (manifest-package-patterns manifest #:optional obsolete-only?)
+  "Return a list of package patterns for MANIFEST entries.
+If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only
+for obsolete packages."
+  (fold-manifest-by-name
+   manifest
    (lambda (name version entries res)
-     (let ((packages (packages-by-name+version name version)))
-       (if (null? packages)
-           (cons (make-obsolete-package-entry name version entries) res)
-           res)))
+     (manifest-patterns-result (packages-by-name name version)
+                               res
+                               (lambda () (list name version entries))
+                               (and (not obsolete-only?)
+                                    (cut list <> entries))))
    '()))
 
+(define* (manifest-output-patterns manifest #:optional obsolete-only?)
+  "Return a list of output patterns for MANIFEST entries.
+If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only
+for obsolete packages."
+  (fold (lambda (entry res)
+          (manifest-patterns-result (manifest-entry->packages entry)
+                                    res
+                                    (lambda () entry)
+                                    (and (not obsolete-only?)
+                                         (cut list <> entry))))
+        '()
+        (manifest-entries manifest)))
+
+(define (obsolete-package-patterns manifest)
+  (manifest-package-patterns manifest #t))
+
+(define (obsolete-output-patterns manifest)
+  (manifest-output-patterns manifest #t))
+
 
-;;; Generation entries
+;;; Transforming package/output patterns into alists.
 
-(define (profile-generations profile)
-  "Return list of generations for PROFILE."
-  (let ((generations (generation-numbers profile)))
-    (if (equal? generations '(0))
-        '()
-        generations)))
+(define (obsolete-package-sexp name version entries)
+  "Return an alist with information about obsolete package.
+ENTRIES is a list of installed manifest entries."
+  `((id        . ,(name+version->full-name name version))
+    (name      . ,name)
+    (version   . ,version)
+    (outputs   . ,(map manifest-entry-output entries))
+    (obsolete  . #t)
+    (installed . ,(manifest-entries->sexps entries))))
+
+(define (package-pattern-transformer manifest params)
+  "Return 'package-pattern->package-sexps' procedure."
+  (define package->sexp
+    (object-transformer %package-param-alist params))
+
+  (define* (sexp-by-package package #:optional
+                            (entries (manifest-entries-by-name
+                                      manifest
+                                      (package-name package)
+                                      (package-version package))))
+    (cons (cons 'installed (manifest-entries->sexps entries))
+          (package->sexp package)))
+
+  (define (->sexps pattern)
+    (match pattern
+      ((? package? package)
+       (list (sexp-by-package package)))
+      (((? package? package) entries)
+       (list (sexp-by-package package entries)))
+      ((name version entries)
+       (list (obsolete-package-sexp
+              name version entries)))
+      ((name version)
+       (let ((packages (packages-by-name name version)))
+         (if (null? packages)
+             (let ((entries (manifest-entries-by-name
+                             manifest name version)))
+               (if (null? entries)
+                   '()
+                   (list (obsolete-package-sexp
+                          name version entries))))
+             (map sexp-by-package packages))))))
+
+  ->sexps)
+
+(define (output-pattern-transformer manifest params)
+  "Return 'output-pattern->output-sexps' procedure."
+  (define package->sexp
+    (object-transformer (alist-delete 'id %package-param-alist)
+                        params))
+
+  (define manifest-entry->sexp
+    (object-transformer (alist-delete 'output %manifest-entry-param-alist)
+                        params))
+
+  (define* (output-sexp pkg-alist pkg-address output
+                        #:optional entry)
+    (let ((entry-alist (if entry
+                           (manifest-entry->sexp entry)
+                           '()))
+          (base `((id        . ,(string-append
+                                 (number->string pkg-address)
+                                 ":" output))
+                  (output    . ,output)
+                  (installed . ,(->bool entry)))))
+      (append entry-alist base pkg-alist)))
+
+  (define (obsolete-output-sexp entry)
+    (let-values (((name version output)
+                  (manifest-entry->name+version+output entry)))
+      (let ((base `((id         . ,(make-package-specification
+                                    name version output))
+                    (package-id . ,(name+version->full-name name version))
+                    (name       . ,name)
+                    (version    . ,version)
+                    (output     . ,output)
+                    (obsolete   . #t)
+                    (installed  . #t))))
+        (append (manifest-entry->sexp entry) base))))
+
+  (define* (sexps-by-package package #:optional output
+                             (entries (manifest-entries-by-name
+                                       manifest
+                                       (package-name package)
+                                       (package-version package))))
+    ;; Assuming that PACKAGE has this OUTPUT.
+    (let ((pkg-alist (package->sexp package))
+          (address (object-address package))
+          (outputs (if output
+                       (list output)
+                       (package-outputs package))))
+      (map (lambda (output)
+             (output-sexp pkg-alist address output
+                          (manifest-entry-by-output entries output)))
+           outputs)))
+
+  (define* (sexps-by-manifest-entry entry #:optional
+                                    (packages (manifest-entry->packages
+                                               entry)))
+    (if (null? packages)
+        (list (obsolete-output-sexp entry))
+        (map (lambda (package)
+               (output-sexp (package->sexp package)
+                            (object-address package)
+                            (manifest-entry-output entry)
+                            entry))
+             packages)))
+
+  (define (->sexps pattern)
+    (match pattern
+      ((? package? package)
+       (sexps-by-package package))
+      ((package (? string? output))
+       (sexps-by-package package output))
+      ((? manifest-entry? entry)
+       (list (obsolete-output-sexp entry)))
+      ((package entry)
+       (sexps-by-manifest-entry entry (list package)))
+      ((name version output)
+       (let ((packages (packages-by-name name version output)))
+         (if (null? packages)
+             (let ((entries (manifest-entries-by-name
+                             manifest name version output)))
+               (append-map (cut sexps-by-manifest-entry <>)
+                           entries))
+             (append-map (cut sexps-by-package <> output)
+                         packages))))))
+
+  ->sexps)
+
+(define (entry-type-error entry-type)
+  (error (format #f "Wrong entry-type '~a'" entry-type)))
+
+(define (search-type-error entry-type search-type)
+  (error (format #f "Wrong search type '~a' for entry-type '~a'"
+                 search-type entry-type)))
+
+(define %pattern-transformers
+  `((package . ,package-pattern-transformer)
+    (output  . ,output-pattern-transformer)))
+
+(define (pattern-transformer entry-type)
+  (assq-ref %pattern-transformers entry-type))
+
+;; All procedures from inner alists are called with (MANIFEST . SEARCH-VALS)
+;; as arguments; see `package/output-sexps'.
+(define %patterns-makers
+  (let* ((apply-to-rest         (lambda (proc)
+                                  (lambda (_ . rest) (apply proc rest))))
+         (apply-to-first        (lambda (proc)
+                                  (lambda (first . _) (proc first))))
+         (manifest-package-proc (apply-to-first manifest-package-patterns))
+         (manifest-output-proc  (apply-to-first manifest-output-patterns))
+         (regexp-proc           (lambda (_ regexp params . __)
+                                  (packages-by-regexp regexp params)))
+         (all-proc              (lambda _ (all-available-packages)))
+         (newest-proc           (lambda _ (newest-available-packages))))
+    `((package
+       (id               . ,(apply-to-rest ids->package-patterns))
+       (name             . ,(apply-to-rest specifications->package-patterns))
+       (installed        . ,manifest-package-proc)
+       (generation       . ,manifest-package-proc)
+       (obsolete         . ,(apply-to-first obsolete-package-patterns))
+       (regexp           . ,regexp-proc)
+       (all-available    . ,all-proc)
+       (newest-available . ,newest-proc))
+      (output
+       (id               . ,(apply-to-rest ids->output-patterns))
+       (name             . ,(apply-to-rest specifications->output-patterns))
+       (installed        . ,manifest-output-proc)
+       (generation       . ,manifest-output-proc)
+       (obsolete         . ,(apply-to-first obsolete-output-patterns))
+       (regexp           . ,regexp-proc)
+       (all-available    . ,all-proc)
+       (newest-available . ,newest-proc)))))
+
+(define (patterns-maker entry-type search-type)
+  (or (and=> (assq-ref %patterns-makers entry-type)
+             (cut assq-ref <> search-type))
+      (search-type-error entry-type search-type)))
+
+(define (package/output-sexps profile params entry-type
+                              search-type search-vals)
+  "Return information about packages or package outputs.
+See 'entry-sexps' for details."
+  (let* ((profile (if (eq? search-type 'generation)
+                      (generation-file-name profile (car search-vals))
+                      profile))
+         (manifest (profile-manifest profile))
+         (patterns (apply (patterns-maker entry-type search-type)
+                          manifest search-vals))
+         (->sexps ((pattern-transformer entry-type) manifest params)))
+    (append-map ->sexps patterns)))
+
+
+;;; Getting information about generations.
 
 (define (generation-param-alist profile)
-  "Return alist of generation parameters and functions for PROFILE."
+  "Return an alist of generation parameters and procedures for PROFILE."
   (list
    (cons 'id          identity)
    (cons 'number      identity)
@@ -440,77 +644,86 @@ IDS may be an object-address, a full-name or a list of such elements."
    (cons 'time        (lambda (gen)
                         (time-second (generation-time profile gen))))))
 
-(define (matching-generation-entries profile ->entry predicate)
-  "Return list of generation entries for the matching generations.
-PREDICATE is called on each generation."
-  (filter-map (lambda (gen)
-                (and (predicate gen) (->entry gen)))
-              (profile-generations profile)))
+(define (matching-generations profile predicate)
+  "Return a list of PROFILE generations matching PREDICATE."
+  (filter predicate (profile-generations profile)))
 
-(define (last-generation-entries profile ->entry number)
-  "Return list of last NUMBER generation entries.
-If NUMBER is 0 or less, return all generation entries."
+(define (last-generations profile number)
+  "Return a list of last NUMBER generations.
+If NUMBER is 0 or less, return all generations."
   (let ((generations (profile-generations profile))
         (number (if (<= number 0) +inf.0 number)))
-    (map ->entry
-         (if (> (length generations) number)
-             (list-head  (reverse generations) number)
-             generations))))
-
-(define (all-generation-entries profile ->entry)
-  "Return list of all generation entries."
-  (last-generation-entries profile ->entry +inf.0))
+    (if (> (length generations) number)
+        (list-head  (reverse generations) number)
+        generations)))
 
-(define (generation-entries-by-ids profile ->entry ids)
-  "Return list of generation entries for generations matching IDS.
-IDS is a list of generation numbers."
-  (matching-generation-entries profile ->entry (cut memq <> ids)))
+(define (find-generations profile search-type search-vals)
+  "Find PROFILE's generations matching SEARCH-TYPE and SEARCH-VALS."
+  (case search-type
+    ((id)
+     (matching-generations profile (cut memq <> (car search-vals))))
+    ((last)
+     (last-generations profile (car search-vals)))
+    ((all)
+     (last-generations profile +inf.0))
+    (else (search-type-error "generation" search-type))))
+
+(define (generation-sexps profile params search-type search-vals)
+  "Return information about generations.
+See 'entry-sexps' for details."
+  (let ((generations (find-generations profile search-type search-vals))
+        (->sexp (object-transformer (generation-param-alist profile)
+                                    params)))
+    (map ->sexp generations)))
 
 
-;;; Getting package/generation entries
-
-(define %package-entries-functions
-  (alist->vhash
-   `((id               . ,package-entries-by-ids)
-     (name             . ,package-entries-by-spec)
-     (regexp           . ,package-entries-by-regexp)
-     (all-available    . ,all-available-package-entries)
-     (newest-available . ,newest-available-package-entries)
-     (installed        . ,installed-package-entries)
-     (obsolete         . ,obsolete-package-entries)
-     (generation       . ,generation-package-entries))
-   hashq))
-
-(define %generation-entries-functions
-  (alist->vhash
-   `((id   . ,generation-entries-by-ids)
-     (last . ,last-generation-entries)
-     (all  . ,all-generation-entries))
-   hashq))
-
-(define (get-entries profile params entry-type search-type search-vals)
-  "Return list of entries.
-ENTRY-TYPE and SEARCH-TYPE define a search function that should be
-applied to PARAMS and VALS."
-  (let-values (((vhash ->entry)
-                (case entry-type
-                  ((package)
-                   (values %package-entries-functions
-                           (object-transformer
-                            package-param-alist params)))
-                  ((generation)
-                   (values %generation-entries-functions
-                           (object-transformer
-                            (generation-param-alist profile) params)))
-                  (else (format (current-error-port)
-                                "Wrong entry type '~a'" entry-type)))))
-    (match (vhash-assq search-type vhash)
-      ((key . fun)
-       (apply fun profile ->entry search-vals))
-      (_ '()))))
+;;; Getting package/output/generation entries (alists).
+
+(define (entries profile params entry-type search-type search-vals)
+  "Return information about entries.
+
+ENTRY-TYPE is a symbol defining a type of returning information.  Should
+be: 'package', 'output' or 'generation'.
+
+SEARCH-TYPE and SEARCH-VALS define how to get the information.
+SEARCH-TYPE should be one of the following symbols:
+
+- If ENTRY-TYPE is 'package' or 'output':
+  'id', 'name', 'regexp', 'all-available', 'newest-available',
+  'installed', 'obsolete', 'generation'.
+
+- If ENTRY-TYPE is 'generation':
+  'id', 'last', 'all'.
+
+PARAMS is a list of parameters for receiving.  If it is an empty list,
+get information with all available parameters, which are:
+
+- If ENTRY-TYPE is 'package':
+  'id', 'name', 'version', 'outputs', 'license', 'synopsis',
+  'description', 'home-url', 'inputs', 'native-inputs',
+  'propagated-inputs', 'location', 'installed'.
+
+- If ENTRY-TYPE is 'output':
+  'id', 'package-id', 'name', 'version', 'output', 'license',
+  'synopsis', 'description', 'home-url', 'inputs', 'native-inputs',
+  'propagated-inputs', 'location', 'installed', 'path', 'dependencies'.
+
+- If ENTRY-TYPE is 'generation':
+  'id', 'number', 'prev-number', 'path', 'time'.
+
+Returning value is a list of alists.  Each alist consists of
+parameter/value pairs."
+  (case entry-type
+    ((package output)
+     (package/output-sexps profile params entry-type
+                           search-type search-vals))
+    ((generation)
+     (generation-sexps profile params
+                       search-type search-vals))
+    (else (entry-type-error entry-type))))
 
 
-;;; Actions
+;;; Package actions.
 
 (define* (package->manifest-entry* package #:optional output)
   (and package
@@ -600,4 +813,3 @@ OUTPUTS is a list of package outputs (may be an empty list)."
                                   "~a packages in profile~%"
                                   count)
                            count)))))))))
-