diff mbox series

[bug#39258,v2,2/3] gnu: Generate Xapian package search index.

Message ID 20200307133116.11443-3-arunisaac@systemreboot.net
State Work in progress
Headers show
Series Xapian for Guix package search | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job

Commit Message

Arun Isaac March 7, 2020, 1:31 p.m. UTC
* guix/ui.scm: Export %package-metrics.
* gnu/packages.scm (%package-search-index): New variable.
(generate-package-search-index): New function.
* guix/channels.scm (package-search-index): New function.
(%channel-profile-hooks): Add package-search-index.
---
 gnu/packages.scm  | 42 +++++++++++++++++++++++++++++++++++++++++-
 guix/channels.scm | 34 +++++++++++++++++++++++++++++++++-
 guix/ui.scm       |  2 ++
 3 files changed, 76 insertions(+), 2 deletions(-)

Comments

Simon Tournier March 9, 2020, 6:19 p.m. UTC | #1
On Sat, 7 Mar 2020 at 14:31, Arun Isaac <arunisaac@systemreboot.net> wrote:

> diff --git a/gnu/packages.scm b/gnu/packages.scm
> index d22c992bb1..c8e221de68 100644
> --- a/gnu/packages.scm
> +++ b/gnu/packages.scm

[...]

> @@ -426,6 +429,43 @@ reducing the memory footprint."
>                                 #:opts '(#:to-file? #t)))))
>    cache-file)
>
> +(define %package-search-index
> +  ;; Location of the package search-index
> +  "/lib/guix/package-search.index")
> +
> +(define (generate-package-search-index directory)
> +  "Generate under DIRECTORY a Xapian index of all the available packages."
> +  (define db-path
> +    (string-append directory %package-search-index))
> +
> +  (mkdir-p (dirname db-path))
> +  (call-with-writable-database db-path
> +    (lambda (db)
> +      (fold-packages (lambda (package _)
> +                       (let* ((idterm (string-append "Q" (package-name package)))
> +                              (doc (make-document #:data (string-trim-right
> +                                                          (call-with-output-string
> +                                                            (cut package->recutils package <>))
> +                                                          #\newline)
> +                                                  #:terms `((,idterm . 0))))
> +                              (term-generator (make-term-generator #:stem (make-stem "en")
> +                                                                   #:document doc)))
> +                         (for-each (match-lambda
> +                                     ((field . weight)
> +                                      (match (field package)
> +                                        ((? string? str)
> +                                         (index-text! term-generator str
> +                                                      #:wdf-increment weight))
> +                                        ((lst ...)
> +                                         (for-each (cut index-text! term-generator <>
> +                                                        #:wdf-increment weight)
> +                                                   lst)))
> +                                      (replace-document! db idterm doc)))
> +                                   %package-metrics)))
> +                     #f)))
> +
> +  db-path)

If I understand correctly, the index is stored with a weight coming
from '%package-metrics', right? Well, I am not convinced it is the
correct way but I have not tried by myself yet. :-)
diff mbox series

Patch

diff --git a/gnu/packages.scm b/gnu/packages.scm
index d22c992bb1..c8e221de68 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -4,6 +4,7 @@ 
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,6 +44,7 @@ 
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-39)
+  #:use-module (xapian xapian)
   #:export (search-patch
             search-patches
             search-auxiliary-file
@@ -64,7 +66,8 @@ 
             specification->location
             specifications->manifest
 
-            generate-package-cache))
+            generate-package-cache
+            generate-package-search-index))
 
 ;;; Commentary:
 ;;;
@@ -426,6 +429,43 @@  reducing the memory footprint."
                                #:opts '(#:to-file? #t)))))
   cache-file)
 
+(define %package-search-index
+  ;; Location of the package search-index
+  "/lib/guix/package-search.index")
+
+(define (generate-package-search-index directory)
+  "Generate under DIRECTORY a Xapian index of all the available packages."
+  (define db-path
+    (string-append directory %package-search-index))
+
+  (mkdir-p (dirname db-path))
+  (call-with-writable-database db-path
+    (lambda (db)
+      (fold-packages (lambda (package _)
+                       (let* ((idterm (string-append "Q" (package-name package)))
+                              (doc (make-document #:data (string-trim-right
+                                                          (call-with-output-string
+                                                            (cut package->recutils package <>))
+                                                          #\newline)
+                                                  #:terms `((,idterm . 0))))
+                              (term-generator (make-term-generator #:stem (make-stem "en")
+                                                                   #:document doc)))
+                         (for-each (match-lambda
+                                     ((field . weight)
+                                      (match (field package)
+                                        ((? string? str)
+                                         (index-text! term-generator str
+                                                      #:wdf-increment weight))
+                                        ((lst ...)
+                                         (for-each (cut index-text! term-generator <>
+                                                        #:wdf-increment weight)
+                                                   lst)))
+                                      (replace-document! db idterm doc)))
+                                   %package-metrics)))
+                     #f)))
+
+  db-path)
+
 
 (define %sigint-prompt
   ;; The prompt to jump to upon SIGINT.
diff --git a/guix/channels.scm b/guix/channels.scm
index f0261dc2da..c70c70938c 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -2,6 +2,7 @@ 
 ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -581,9 +582,40 @@  be used as a profile hook."
                                                  (hook . package-cache))
                                   #:local-build? #t)))
 
+(define (package-search-index manifest)
+  "Build a package search index for the instance in MANIFEST.  This is meant
+to be used as a profile hook."
+  (mlet %store-monad ((profile (profile-derivation manifest
+                                                   #:hooks '())))
+
+    (define build
+      #~(begin
+          (use-modules (gnu packages))
+
+          (if (defined? 'generate-package-search-index)
+              (begin
+                ;; Delegate package search index generation to the inferior.
+                (format (current-error-port)
+                        "Generating package search index for '~a'...~%"
+                        #$profile)
+                (generate-package-search-index #$output))
+              (mkdir #$output))))
+
+    (gexp->derivation-in-inferior "guix-package-search-index" build
+                                  profile
+
+                                  ;; If the Guix in PROFILE is too old and
+                                  ;; lacks 'guix repl', don't build the cache
+                                  ;; instead of failing.
+                                  #:silent-failure? #t
+
+                                  #:properties '((type . profile-hook)
+                                                 (hook . package-search-index))
+                                  #:local-build? #t)))
+
 (define %channel-profile-hooks
   ;; The default channel profile hooks.
-  (cons package-cache-file %default-profile-hooks))
+  (cons* package-cache-file package-search-index %default-profile-hooks))
 
 (define (channel-instances->derivation instances)
   "Return the derivation of the profile containing INSTANCES, a list of
diff --git a/guix/ui.scm b/guix/ui.scm
index fbe2b70485..3bc82111a5 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -14,6 +14,7 @@ 
 ;;; Copyright © 2019 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -120,6 +121,7 @@ 
             relevance
             package-relevance
             display-search-results
+            %package-metrics
 
             with-profile-lock
             string->generations