03/07: profiles: Add fast path for 'xdg-mime-database' hook.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 76ea70bd70aeb76570445c11cea2f98139192b54
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Nov 2 14:25:15 2020 +0100

    profiles: Add fast path for 'xdg-mime-database' hook.
    
    Partly fixes <https://bugs.gnu.org/44053>.
    Reported by Joshua Branson <jbranso@dismail.de>
    and Maxim Cournoyer <maxim.cournoyer@gmail.com>.
    
    * guix/profiles.scm (xdg-mime-database): When PKGDIRS contains only one
    element, symlink directly to it.  Invoke 'update-mime-database' only
    when PKGDIRS contains two or more elements, which is less frequent.
---
 guix/profiles.scm | 42 +++++++++++++++++++++++++++---------------
 1 file changed, 27 insertions(+), 15 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 856a05e..1b15257 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1301,31 +1301,43 @@ entries.  It's used to query the MIME type of a given 
file."
   (define shared-mime-info  ; lazy reference
     (module-ref (resolve-interface '(gnu packages gnome)) 'shared-mime-info))
 
-  (mlet %store-monad ((glib
-                       (manifest-lookup-package
-                        manifest "glib")))
+  (mlet %store-monad ((glib (manifest-lookup-package manifest "glib")))
     (define build
       (with-imported-modules  '((guix build utils)
                                 (guix build union))
         #~(begin
-            (use-modules (srfi srfi-26)
-                         (guix build utils)
-                         (guix build union))
+            (use-modules (guix build utils)
+                         (guix build union)
+                         (srfi srfi-26)
+                         (ice-9 match))
+
             (let* ((datadir (string-append #$output "/share"))
                    (destdir (string-append datadir "/mime"))
                    (pkgdirs (filter file-exists?
                                     (map (cut string-append <>
                                               "/share/mime/packages")
                                          (cons #+shared-mime-info
-                                               '#$(manifest-inputs 
manifest)))))
-                   (update-mime-database (string-append
-                                          #+shared-mime-info
-                                          "/bin/update-mime-database")))
-              (mkdir-p destdir)
-              (union-build (string-append destdir "/packages") pkgdirs
-                           #:log-port (%make-void-port "w"))
-              (setenv "XDG_DATA_HOME" datadir)
-              (exit (zero? (system* update-mime-database destdir)))))))
+                                               '#$(manifest-inputs 
manifest))))))
+
+              (match pkgdirs
+                ((shared-mime-info)
+                 ;; PKGDIRS contains nothing but 'shared-mime-info', which
+                 ;; already contains its database, so nothing to do.
+                 (mkdir-p datadir)
+                 (symlink #$(file-append shared-mime-info "/share/mime")
+                          destdir))
+                (_
+                 ;; PKGDIRS contains additional packages providing
+                 ;; 'share/mime/packages' (very few packages do so) so rebuild
+                 ;; the database.  TODO: Find a way to avoid reprocessing
+                 ;; 'shared-mime-info', which is the most expensive one.
+                 (mkdir-p destdir)
+                 (union-build (string-append destdir "/packages") pkgdirs
+                              #:log-port (%make-void-port "w"))
+                 (setenv "XDG_DATA_HOME" datadir)
+                 (invoke #+(file-append shared-mime-info
+                                        "/bin/update-mime-database")
+                         destdir)))))))
 
     ;; Don't run the hook when there are no GLib based applications.
     (if glib