me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2020-11-02 14:25:15 +01:00
parent e1bd62eb5c
commit 76ea70bd70
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 27 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
guix/profiles.scm
View File

@ -1301,31 +1301,43 @@ entries. It's used to query the MIME type of a given file."
(define shared-mime-info ; lazy reference (define shared-mime-info ; lazy reference
(module-ref (resolve-interface '(gnu packages gnome)) 'shared-mime-info)) (module-ref (resolve-interface '(gnu packages gnome)) 'shared-mime-info))
(mlet %store-monad ((glib (mlet %store-monad ((glib (manifest-lookup-package manifest "glib")))
(manifest-lookup-package
manifest "glib")))
(define build (define build
(with-imported-modules '((guix build utils) (with-imported-modules '((guix build utils)
(guix build union)) (guix build union))
#~(begin #~(begin
(use-modules (srfi srfi-26) (use-modules (guix build utils)
(guix build utils) (guix build union)
(guix build union)) (srfi srfi-26)
(ice-9 match))
(let* ((datadir (string-append #$output "/share")) (let* ((datadir (string-append #$output "/share"))
(destdir (string-append datadir "/mime")) (destdir (string-append datadir "/mime"))
(pkgdirs (filter file-exists? (pkgdirs (filter file-exists?
(map (cut string-append <> (map (cut string-append <>
"/share/mime/packages") "/share/mime/packages")
(cons #+shared-mime-info (cons #+shared-mime-info
'#$(manifest-inputs manifest))))) '#$(manifest-inputs manifest))))))
(update-mime-database (string-append
#+shared-mime-info (match pkgdirs
"/bin/update-mime-database"))) ((shared-mime-info)
(mkdir-p destdir) ;; PKGDIRS contains nothing but 'shared-mime-info', which
(union-build (string-append destdir "/packages") pkgdirs ;; already contains its database, so nothing to do.
#:log-port (%make-void-port "w")) (mkdir-p datadir)
(setenv "XDG_DATA_HOME" datadir) (symlink #$(file-append shared-mime-info "/share/mime")
(exit (zero? (system* update-mime-database destdir))))))) 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. ;; Don't run the hook when there are no GLib based applications.
(if glib (if glib