[PATCH 1/2] profiles: manifest-lookup-package: Optionally match version prefix.

[PATCH 1/2] profiles: manifest-lookup-package: Optionally match version prefix.

[Ricardo Wurmus]

* guix/profiles.scm (manifest-lookup-package): Optionally filter store
item matches by version prefix.
---
 guix/profiles.scm | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 4a2ba1c..78deeb7 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -472,21 +472,30 @@ replace it."
                 (cons (gexp-input thing output) deps)))
               (manifest-entries manifest)))
 
-(define (manifest-lookup-package manifest name)
+(define* (manifest-lookup-package manifest name #:optional version)
   "Return as a monadic value the first package or store path referenced by
-MANIFEST that named NAME, or #f if not found."
+MANIFEST that is named NAME and optionally has the given VERSION prefix, or #f
+if not found."
   ;; Return as a monadic value the package or store path referenced by the
   ;; manifest ENTRY, or #f if not referenced.
   (define (entry-lookup-package entry)
     (define (find-among-inputs inputs)
       (find (lambda (input)
               (and (package? input)
-                   (equal? name (package-name input))))
+                   (equal? name (package-name input))
+                   (if version
+                       (string-prefix? version (package-version input))
+                       #t)))
             inputs))
     (define (find-among-store-items items)
       (find (lambda (item)
-              (equal? name (package-name->name+version
-                            (store-path-package-name item))))
+              (let-values (((pkg-name pkg-version)
+                            (package-name->name+version
+                             (store-path-package-name item))))
+                (and (equal? name pkg-name)
+                     (if version
+                         (string-prefix? version pkg-version)
+                         #t))))
             items))
 
     ;; TODO: Factorize.
-- 
2.10.0

[PATCH 2/2] profiles: Build GTK+ input module cache.

[Ricardo Wurmus]

* guix/profiles.scm (gtk-im-modules): New procedure.
(%default-profile-hooks): Add it.
---
 guix/profiles.scm | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 78deeb7..1a522ae 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -723,6 +723,68 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
                           #:substitutable? #f)
         (return #f))))
 
+(define (gtk-im-modules manifest)
+  "Return a derivation that builds the cache files for input method modules
+for both major versions of GTK+."
+
+  (mlet %store-monad ((gtk+   (manifest-lookup-package manifest "gtk+" "3"))
+                      (gtk+-2 (manifest-lookup-package manifest "gtk+" "2")))
+
+    (define (build gtk gtk-version)
+      (let ((major (string-take gtk-version 1)))
+        (with-imported-modules '((guix build utils)
+                                 (guix build union)
+                                 (guix build profiles)
+                                 (guix search-paths)
+                                 (guix records))
+          #~(begin
+              (use-modules (guix build utils)
+                           (guix build union)
+                           (guix build profiles)
+                           (ice-9 popen)
+                           (srfi srfi-26))
+
+              (let* ((prefix  (string-append "/lib/gtk-" #$major ".0/"
+                                             #$gtk-version))
+                     (query   (string-append #$gtk "/bin/gtk-query-immodules-"
+                                             #$major ".0"))
+                     (destdir (string-append #$output prefix))
+                     (moddirs (cons (string-append #$gtk prefix "/immodules")
+                                    (filter file-exists?
+                                            (map (cut string-append <> prefix "/immodules")
+                                                 '#$(manifest-inputs manifest))))))
+
+                ;; Union all the gtk immodules directories.
+                (mkdir-p (string-append #$output "/lib/gtk-" #$major ".0"))
+                (union-build destdir moddirs #:log-port (%make-void-port "w"))
+
+                ;; Generate a new 'immodules.cache' file.
+                (let ((pipe    (apply open-pipe*
+                                      OPEN_READ query
+                                      (map readlink (find-files destdir "\\.so$"))))
+                      (outfile (string-append #$output prefix
+                                              "/immodules-gtk" #$major ".cache")))
+                  (dynamic-wind
+                    (const #t)
+                    (lambda ()
+                      (call-with-output-file outfile
+                        (lambda (out)
+                          (while (not (eof-object? (peek-char pipe)))
+                            (write-char (read-char pipe) out))))
+                      #t)
+                    (lambda ()
+                      (close-pipe pipe)))))))))
+
+    ;; Don't run the hook when there's nothing to do.
+    (let ((gexp #~(begin
+                    #$(if gtk+   (build gtk+   "3.0.0")  #t)
+                    #$(if gtk+-2 (build gtk+-2 "2.10.0") #t))))
+      (if (or gtk+ gtk+-2)
+          (gexp->derivation "gtk-im-modules" gexp
+                            #:local-build? #t
+                            #:substitutable? #f)
+          (return #f)))))
+
 (define (xdg-desktop-database manifest)
   "Return a derivation that builds the @file{mimeinfo.cache} database from
 desktop files.  It's used to query what applications can handle a given
@@ -844,6 +906,7 @@ files for the truetype fonts of the @var{manifest} entries."
         ghc-package-cache-file
         ca-certificate-bundle
         gtk-icon-themes
+        gtk-im-modules
         xdg-desktop-database
         xdg-mime-database))
 
-- 
2.10.0

Re: [PATCH 2/2] profiles: Build GTK+ input module cache.

[宋文武]

Ricardo Wurmus <rekado@elephly.net> writes:

> * guix/profiles.scm (gtk-im-modules): New procedure.
> (%default-profile-hooks): Add it.
> ---
>  guix/profiles.scm | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
>  1 file changed, 63 insertions(+)
>
> diff --git a/guix/profiles.scm b/guix/profiles.scm
> index 78deeb7..1a522ae 100644
> --- a/guix/profiles.scm
> +++ b/guix/profiles.scm
> @@ -723,6 +723,68 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
>                            #:substitutable? #f)
>          (return #f))))
>  
> +(define (gtk-im-modules manifest)
> +  "Return a derivation that builds the cache files for input method modules
> +for both major versions of GTK+."
> +
> +  (mlet %store-monad ((gtk+   (manifest-lookup-package manifest "gtk+" "3"))
> +                      (gtk+-2 (manifest-lookup-package manifest "gtk+" "2")))
> +
> +    (define (build gtk gtk-version)
> +      (let ((major (string-take gtk-version 1)))
> +        (with-imported-modules '((guix build utils)
> +                                 (guix build union)
> +                                 (guix build profiles)
> +                                 (guix search-paths)
> +                                 (guix records))
> +          #~(begin
> +              (use-modules (guix build utils)
> +                           (guix build union)
> +                           (guix build profiles)
> +                           (ice-9 popen)
> +                           (srfi srfi-26))
> +
> +              (let* ((prefix  (string-append "/lib/gtk-" #$major ".0/"
> +                                             #$gtk-version))
> +                     (query   (string-append #$gtk "/bin/gtk-query-immodules-"
> +                                             #$major ".0"))
> +                     (destdir (string-append #$output prefix))
> +                     (moddirs (cons (string-append #$gtk prefix "/immodules")
> +                                    (filter file-exists?
> +                                            (map (cut string-append <> prefix "/immodules")
> +                                                 '#$(manifest-inputs manifest))))))
> +
> +                ;; Union all the gtk immodules directories.
> +                (mkdir-p (string-append #$output "/lib/gtk-" #$major ".0"))
> +                (union-build destdir moddirs #:log-port
> (%make-void-port "w"))

I think there is no need to run `union-build'.  Other hooks use it
because they (eg: update-icon-cache, update-mime-databes) require input
and output files in a single directory.

> +
> +                ;; Generate a new 'immodules.cache' file.
> +                (let ((pipe    (apply open-pipe*
> +                                      OPEN_READ query
> +                                      (map readlink (find-files
> destdir "\\.so$"))))
and use 'moddirs' here should work.

Re: [PATCH 2/2] profiles: Build GTK+ input module cache.

[Ricardo Wurmus]

宋文武 <iyzsong@member.fsf.org> writes:

> Ricardo Wurmus <rekado@elephly.net> writes:
>
>> * guix/profiles.scm (gtk-im-modules): New procedure.
>> (%default-profile-hooks): Add it.
>> ---
>>  guix/profiles.scm | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
>>  1 file changed, 63 insertions(+)
>>
>> diff --git a/guix/profiles.scm b/guix/profiles.scm
>> index 78deeb7..1a522ae 100644
>> --- a/guix/profiles.scm
>> +++ b/guix/profiles.scm
>> @@ -723,6 +723,68 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
>>                            #:substitutable? #f)
>>          (return #f))))
>>  
>> +(define (gtk-im-modules manifest)
>> +  "Return a derivation that builds the cache files for input method modules
>> +for both major versions of GTK+."
>> +
>> +  (mlet %store-monad ((gtk+   (manifest-lookup-package manifest "gtk+" "3"))
>> +                      (gtk+-2 (manifest-lookup-package manifest "gtk+" "2")))
>> +
>> +    (define (build gtk gtk-version)
>> +      (let ((major (string-take gtk-version 1)))
>> +        (with-imported-modules '((guix build utils)
>> +                                 (guix build union)
>> +                                 (guix build profiles)
>> +                                 (guix search-paths)
>> +                                 (guix records))
>> +          #~(begin
>> +              (use-modules (guix build utils)
>> +                           (guix build union)
>> +                           (guix build profiles)
>> +                           (ice-9 popen)
>> +                           (srfi srfi-26))
>> +
>> +              (let* ((prefix  (string-append "/lib/gtk-" #$major ".0/"
>> +                                             #$gtk-version))
>> +                     (query   (string-append #$gtk "/bin/gtk-query-immodules-"
>> +                                             #$major ".0"))
>> +                     (destdir (string-append #$output prefix))
>> +                     (moddirs (cons (string-append #$gtk prefix "/immodules")
>> +                                    (filter file-exists?
>> +                                            (map (cut string-append <> prefix "/immodules")
>> +                                                 '#$(manifest-inputs manifest))))))
>> +
>> +                ;; Union all the gtk immodules directories.
>> +                (mkdir-p (string-append #$output "/lib/gtk-" #$major ".0"))
>> +                (union-build destdir moddirs #:log-port
>> (%make-void-port "w"))
>
> I think there is no need to run `union-build'.  Other hooks use it
> because they (eg: update-icon-cache, update-mime-databes) require input
> and output files in a single directory.

You are right.  This is a left-over of previous experimentation.  I
previously tried to do without pipes and rewrite some environment
variables instead, but that needed a single directory, hence the union.

>> +
>> +                ;; Generate a new 'immodules.cache' file.
>> +                (let ((pipe    (apply open-pipe*
>> +                                      OPEN_READ query
>> +                                      (map readlink (find-files
>> destdir "\\.so$"))))
> and use 'moddirs' here should work.

Using “moddirs” directly won’t work because it’s a list of directories.
I added another definition of “modules”, which is a flattened list of
the result of “find-files” on all the directories.

I tested the resulting cache files and they work fine with our patched
versions of GTK.  (The simple GTK input methods e.g. for switching
between Qwerty and Dvorak no longer work, but that appears to be
unrelated.)

I’ll push the updated version of this patch in a moment.

~~ Ricardo

Re: [PATCH 1/2] profiles: manifest-lookup-package: Optionally match version prefix.

[Ludovic Courtès]

Ricardo Wurmus <rekado@elephly.net> skribis:

> * guix/profiles.scm (manifest-lookup-package): Optionally filter store
> item matches by version prefix.

[...]

> -(define (manifest-lookup-package manifest name)
> +(define* (manifest-lookup-package manifest name #:optional version)
>    "Return as a monadic value the first package or store path referenced by
> -MANIFEST that named NAME, or #f if not found."
> +MANIFEST that is named NAME and optionally has the given VERSION prefix, or #f
> +if not found."

This should be phrased to mention that VERSION can be #f.

> +              (let-values (((pkg-name pkg-version)

Rather ‘name*’ and ‘version*’, but no abbreviations.

> +                            (package-name->name+version
> +                             (store-path-package-name item))))
> +                (and (equal? name pkg-name)

‘string=?’

OK with these changes, thanks!

Ludo’.

Re: [PATCH 2/2] profiles: Build GTK+ input module cache.

[Ludovic Courtès]

Ricardo Wurmus <rekado@elephly.net> skribis:

> * guix/profiles.scm (gtk-im-modules): New procedure.
> (%default-profile-hooks): Add it.

Very nice!

> +(define (gtk-im-modules manifest)
> +  "Return a derivation that builds the cache files for input method modules
> +for both major versions of GTK+."
> +
> +  (mlet %store-monad ((gtk+   (manifest-lookup-package manifest "gtk+" "3"))
> +                      (gtk+-2 (manifest-lookup-package manifest "gtk+" "2")))
> +
> +    (define (build gtk gtk-version)
> +      (let ((major (string-take gtk-version 1)))

Rather: (version-prefix gtk-version 1).

> +                ;; Generate a new 'immodules.cache' file.
> +                (let ((pipe    (apply open-pipe*
> +                                      OPEN_READ query
> +                                      (map readlink (find-files destdir "\\.so$"))))
> +                      (outfile (string-append #$output prefix
> +                                              "/immodules-gtk" #$major ".cache")))
> +                  (dynamic-wind
> +                    (const #t)
> +                    (lambda ()
> +                      (call-with-output-file outfile
> +                        (lambda (out)
> +                          (while (not (eof-object? (peek-char pipe)))
> +                            (write-char (read-char pipe) out))))
> +                      #t)
> +                    (lambda ()
> +                      (close-pipe pipe)))))))))

What about something along these lines instead:

  (define result
    (call-with-output-file "immodules.cache"
      (lambda (port)
        (close-fdes 1)
        (dup->fdes port 1)
        (system* query …))))

   ;; Fail when gtk-immodules-query fails.
   (zero? result)

> +    ;; Don't run the hook when there's nothing to do.
> +    (let ((gexp #~(begin
> +                    #$(if gtk+   (build gtk+   "3.0.0")  #t)
> +                    #$(if gtk+-2 (build gtk+-2 "2.10.0") #t))))

Simply:

  (let ((gexp (cond (gtk+ (build gtk+ "3.0.0"))
                    (gtk+-2 (built gtk+-2 …))
                    (else #f))))
    …)
                  
We should avoid the hardcoded version numbers though.

Otherwise LGTM.

Could you send an updated patch?

Thank you!

Ludo’.

Re: [PATCH 2/2] profiles: Build GTK+ input module cache.

[Ricardo Wurmus]

Hi Ludo,

I had already pushed the change by the time I got this email, and then I
forgot to reply to it in time.  While trying to clean up my massive Guix
inbox I stumbled upon this unreplied email.  My apologies for the delay!

Ludovic Courtès <ludo@gnu.org> writes:

> Ricardo Wurmus <rekado@elephly.net> skribis:
>
>> * guix/profiles.scm (gtk-im-modules): New procedure.
>> (%default-profile-hooks): Add it.
>
> Very nice!
>
>> +(define (gtk-im-modules manifest)
>> +  "Return a derivation that builds the cache files for input method modules
>> +for both major versions of GTK+."
>> +
>> +  (mlet %store-monad ((gtk+   (manifest-lookup-package manifest "gtk+" "3"))
>> +                      (gtk+-2 (manifest-lookup-package manifest "gtk+" "2")))
>> +
>> +    (define (build gtk gtk-version)
>> +      (let ((major (string-take gtk-version 1)))
>
> Rather: (version-prefix gtk-version 1).

Okay.

>> +                ;; Generate a new 'immodules.cache' file.
>> +                (let ((pipe    (apply open-pipe*
>> +                                      OPEN_READ query
>> +                                      (map readlink (find-files destdir "\\.so$"))))
>> +                      (outfile (string-append #$output prefix
>> +                                              "/immodules-gtk" #$major ".cache")))
>> +                  (dynamic-wind
>> +                    (const #t)
>> +                    (lambda ()
>> +                      (call-with-output-file outfile
>> +                        (lambda (out)
>> +                          (while (not (eof-object? (peek-char pipe)))
>> +                            (write-char (read-char pipe) out))))
>> +                      #t)
>> +                    (lambda ()
>> +                      (close-pipe pipe)))))))))
>
> What about something along these lines instead:
>
>   (define result
>     (call-with-output-file "immodules.cache"
>       (lambda (port)
>         (close-fdes 1)
>         (dup->fdes port 1)
>         (system* query …))))
>
>    ;; Fail when gtk-immodules-query fails.
>    (zero? result)

This does indeed look nicer.  I’ll put this on my TODO list and revisit
the code at a later point in time.

>> +    ;; Don't run the hook when there's nothing to do.
>> +    (let ((gexp #~(begin
>> +                    #$(if gtk+   (build gtk+   "3.0.0")  #t)
>> +                    #$(if gtk+-2 (build gtk+-2 "2.10.0") #t))))
>
> Simply:
>
>   (let ((gexp (cond (gtk+ (build gtk+ "3.0.0"))
>                     (gtk+-2 (built gtk+-2 …))
>                     (else #f))))
>     …)

Here I’m building one big gexp containing what’s needed for whatever
version of GTK is installed in the profile.  Your version would pick
only one of the expressions for a single version, which doesn’t cover
the case where both are installed.

> We should avoid the hardcoded version numbers though.

I agree but I don’t know how to avoid this elegantly.  These numbers
seem almost arbitrary.  Since we only have two major versions at this
point I don’t think it’s worth trying to generalise this.

~~ Ricardo