From 91d06d8950e700a8a3c3479c3613b579c53411c9 Mon Sep 17 00:00:00 2001
From: Chris Marusich <address@hidden>
Date: Mon, 6 May 2019 01:51:30 -0700
Subject: [PATCH] ui: Make package outputs searchable.

* guix/ui.scm (relevance): Expect the "field" procedure to always return
a (possibly empty) list of strings, thereby eliminating the case in
which (before this commit) "field" might return #f.  Add up the score of
each string in the list, and use that as the overall score when folding
over the metrics.  Update docstring.
(%package-metrics): Return a list in every case.
* guix/scripts/system/search.scm (process-query)
<%service-type-metrics>: Return a list in every case.
* guix/scripts/package.scm (find-packages-by-description): Update
docstring.
---
 guix/scripts/package.scm       |  6 ++---
 guix/scripts/system/search.scm | 17 +++++++++++----
 guix/ui.scm                    | 40 ++++++++++++++++++++++++----------
 3 files changed, 44 insertions(+), 19 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index aa27984ea2..06e4cf5b9c 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -180,9 +180,9 @@ hooks\" run when building the profile."
 ;;;
 
 (define (find-packages-by-description regexps)
-  "Return two values: the list of packages whose name, synopsis, or
-description matches at least one of REGEXPS sorted by relevance, and the list
-of relevance scores."
+  "Return two values: the list of packages whose name, synopsis, description,
+or output matches at least one of REGEXPS sorted by relevance, and the list of
+relevance scores."
   (let ((matches (fold-packages (lambda (package result)
                                   (if (package-superseded package)
                                       result
diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index 955cdd1e95..733fa22614 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2018 Clément Lassieur <address@hidden>
+;;; Copyright © 2019 Chris Marusich <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -128,14 +129,22 @@ columns."
 
 (define %service-type-metrics
   ;; Metrics used to estimate the relevance of a search result.
-  `((,service-type-name* . 3)
-    (,service-type-description-string . 2)
+  `((,(lambda (type)
+        (match (service-type-name* type)
+          (#f '())
+          (name (list name))))
+     . 3)
+    (,(lambda (type)
+        (match (service-type-description-string type)
+          (#f '())
+          (description (list description))))
+     . 2)
     (,(lambda (type)
         (match (and=> (service-type-location type) location-file)
           ((? string? file)
-           (basename file ".scm"))
+           (list (basename file ".scm")))
           (#f
-           "")))
+           '())))
      . 1)))
 
 (define (find-service-types regexps)
diff --git a/guix/ui.scm b/guix/ui.scm
index 92c845e944..9121e3daee 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2016 Benz Schenk <address@hidden>
 ;;; Copyright © 2018 Kyle Meyer <address@hidden>
 ;;; Copyright © 2018 Ricardo Wurmus <address@hidden>
+;;; Copyright © 2019 Chris Marusich <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1370,7 +1371,7 @@ WIDTH columns.  EXTRA-FIELDS is a list of symbol/value pairs to emit."
 (define (relevance obj regexps metrics)
   "Compute a \"relevance score\" for OBJ as a function of its number of
 matches of REGEXPS and accordingly to METRICS.  METRICS is list of
-field/weight pairs, where FIELD is a procedure that returns a string
+field/weight pairs, where FIELD is a procedure that returns a list of strings
 describing OBJ, and WEIGHT is a positive integer denoting the weight of this
 field in the final score.
 
@@ -1392,29 +1393,44 @@ score, the more relevant OBJ is to REGEXPS."
   (fold (lambda (metric relevance)
           (match metric
             ((field . weight)
-             (match (field obj)
-               (#f  relevance)
-               (str (+ relevance
-                       (* (score str) weight)))))))
+             (let ((strings (field obj)))
+               (+ relevance
+                  (* weight
+                     ;; Evaluates to 0 when strings is the empty list.
+                     (apply + (map score strings))))))))
         0
         metrics))
 
 (define %package-metrics
   ;; Metrics used to compute the "relevance score" of a package against a set
   ;; of regexps.
-  `((,package-name . 4)
-
+  `((,(lambda (package)
+        (list (package-name package)))
+     . 4)
+    ;; Match against uncommon outputs.
+    (,(lambda (package)
+        (filter (lambda (output)
+                  (not (member output
+                               ;; Some common outpus shared by many packages.
+                               '("out" "debug" "doc" "static"))))
+                (package-outputs package)))
+     . 1)
     ;; Match regexps on the raw Texinfo since formatting it is quite expensive
     ;; and doesn't have much of an effect on search results.
     (,(lambda (package)
-        (and=> (package-synopsis package) P_)) . 3)
+        (match (and=> (package-synopsis package) P_)
+          (#f '())
+          (synopsis (list synopsis))))
+     . 3)
     (,(lambda (package)
-        (and=> (package-description package) P_)) . 2)
-
+        (match (and=> (package-description package) P_)
+          (#f '())
+          (description (list description))))
+     . 2)
     (,(lambda (type)
         (match (and=> (package-location type) location-file)
-          ((? string? file) (basename file ".scm"))
-          (#f "")))
+          ((? string? file) (list (basename file ".scm")))
+          (#f '())))
      . 1)))
 
 (define (package-relevance package regexps)
-- 
2.20.1