[PATCH] profiles: Generate database file for manpages

[Maxim Cournoyer]

Hello Guix!

I've managed to finalize a profile hooks which takes care of generating
the manpages database file. This file is used by apropos or man -k to
provide results.

Thanks to Ludovic for providing me with a patch I could start from, this
greetly speeded things up!

I've tested and found it to be working for the regular user profile. To
try it, apply the patch and use a guix command that causes a new profile
generation.

For example: guix package -r git -i git
Then: "apropos git" should return plenty of results.

It requires extra processing time to do the work since the complete
database (on my system, there are thousands or manpages being indexed)
is recreated everytime a new profile is generated.

For now it doesn't work for guix environments (yet), but this should be
easy to fix (it seems the $GUIX_ENVIRONMENT/share/man should be merged
with $HOME/.guix-profile/share/man, but I need to look at it more
carefully).

Maxim

From dbbe6894919164cd34572a28bfbbf6d4d681e35b Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <address@hidden>
Date: Tue, 28 Mar 2017 09:25:21 -0700
Subject: [PATCH] profiles: Generate database file for manpages
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The mandb database file (index.db) is used by the "apropos" (whatis) or
"man -k" commands. This change introduces a profile hook to generate
such database file.

Co-authored by Ludovic Courtès

* guix/profiles.scm (manual-database): New procedure.
(%default-profile-hooks): Add it.
---
 guix/profiles.scm | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 76 insertions(+)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 795c9447fe..eb746c125a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2016 Ricardo Wurmus <address@hidden>
 ;;; Copyright © 2016 Chris Marusich <address@hidden>
 ;;; Copyright © 2017 Huang Ying <address@hidden>
+;;; Copyright © 2017 Maxim Cournoyer <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -946,10 +947,85 @@ files for the fonts of the @var{manifest} entries."
                     #:local-build? #t
                     #:substitutable? #f))
 
+(define (manual-database manifest)
+  (define man-db                        ;lazy reference
+    (module-ref (resolve-interface '(gnu packages man)) 'man-db))
+
+  (define build
+    #~(begin
+        (use-modules (guix build utils)
+                     (srfi srfi-1))
+
+        (define entries
+          (filter-map (lambda (directory)
+                        (let ((man (string-append directory "/share/man")))
+                          (and (directory-exists? man)
+                               man)))
+                      '#$(manifest-inputs manifest)))
+
+        (define manpages-collection-dir
+          (string-append (getenv "PWD") "/manpages-collection"))
+
+        (define man-directory
+          (string-append #$output "/share/man"))
+
+        (define man-db-config-orig
+          (string-append #+man-db "/etc/man_db.conf"))
+
+        (define man-db-config
+          (string-append (getenv "PWD") "/man_db.conf"))
+
+        (define (get-manpage-tail-path manpage-path)
+          (let ((index (string-contains manpage-path "/share/man/")))
+            (substring manpage-path (+ index (string-length "/share/man/")))))
+
+        (define (populate-manpages-collection-dir entries)
+          (let ((manpages (append-map (lambda (manpath)
+                                        (find-files manpath))
+                                      entries)))
+            (for-each (lambda (manpage)
+                        (let* ((dest-path (string-append
+                                           manpages-collection-dir "/"
+                                           (get-manpage-tail-path manpage)))
+                               (dest-dir (dirname dest-path)))
+                          (unless (file-exists? dest-dir)
+                            (mkdir-p dest-dir))
+                          (catch 'system-error
+                            (lambda ()
+                              (symlink manpage dest-path))
+                            (lambda args
+                              ;; Different packages may contain the same
+                              ;; manpage. Simply ignore the symlink error.
+                              #t))))
+                      manpages)))
+
+        (mkdir-p manpages-collection-dir)
+        (populate-manpages-collection-dir entries)
+
+        ;; Create a mandb config file which contains a custom made
+        ;; manpath. The associated catpath is the location where the database
+        ;; gets generated.
+        (copy-file man-db-config-orig man-db-config)
+        (substitute* man-db-config
+          (("MANDB_MAP /usr/man                /var/cache/man/fsstnd")
+           (string-append "MANDB_MAP " manpages-collection-dir " "
+                          man-directory)))
+
+        (mkdir-p man-directory)
+        (setenv "MANPATH" (string-join entries ":"))
+        (zero? (system* (string-append #+man-db "/bin/mandb")
+                        "--quiet" "--create"
+                        "-C" man-db-config))))
+
+  (gexp->derivation "manual-database" build
+                    #:modules '((guix build utils))
+                    #:local-build? #t))
+
 (define %default-profile-hooks
   ;; This is the list of derivation-returning procedures that are called by
   ;; default when making a non-empty profile.
   (list info-dir-file
+        manual-database
         fonts-dir-file
         ghc-package-cache-file
         ca-certificate-bundle
-- 
2.12.0

signature.asc
Description: PGP signature