[PATCH -v2 1/2] build: union: Add create-all-directories? parameter to union-build

[PATCH -v2 1/2] build: union: Add create-all-directories? parameter to union-build

[Huang Ying]

* guix/build/union.scm (union-build): Add create-all-directories? keyword
  parameter.  To add/remove some files from the directory.
---
 guix/build/union.scm | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/guix/build/union.scm b/guix/build/union.scm
index 6640b5652..6a2a0f546 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -73,7 +73,8 @@ identical, #f otherwise."
                                   (loop)))))))))))))
 
 (define* (union-build output inputs
-                      #:key (log-port (current-error-port)))
+                      #:key (log-port (current-error-port))
+                      (create-all-directories? #f))
   "Build in the OUTPUT directory a symlink tree that is the union of all
 the INPUTS."
 
@@ -104,8 +105,11 @@ the INPUTS."
   (define (union output inputs)
     (match inputs
       ((input)
-       ;; There's only one input, so just make a link.
-       (symlink* input output))
+       ;; There's only one input, so just make a link unless
+       ;; create-all-directories?.
+       (if (and create-all-directories? (file-is-directory? input))
+           (union-of-directories output inputs)
+           (symlink* input output)))
       (_
        (call-with-values (lambda () (partition file-is-directory? inputs))
          (match-lambda*
-- 
2.12.0

[PATCH -v2 2/2] guix: profiles: create fonts.dir/scale for all fonts directories

[Huang Ying]

* guix/profiles.scm (fonts-dir-file): Create fonts.dir/scale files for all
  fonts directories.
---
 guix/profiles.scm | 56 ++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 39 insertions(+), 17 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index de82eae34..2f10147f2 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -879,7 +879,7 @@ entries.  It's used to query the MIME type of a given file."
 
 (define (fonts-dir-file manifest)
   "Return a derivation that builds the @file{fonts.dir} and @file{fonts.scale}
-files for the truetype fonts of the @var{manifest} entries."
+files for the fonts of the @var{manifest} entries."
   (define mkfontscale
     (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontscale))
 
@@ -890,30 +890,52 @@ files for the truetype fonts of the @var{manifest} entries."
     #~(begin
         (use-modules (srfi srfi-26)
                      (guix build utils)
-                     (guix build union))
-        (let ((ttf-dirs (filter file-exists?
-                                (map (cut string-append <>
-                                          "/share/fonts/truetype")
-                                     '#$(manifest-inputs manifest)))))
+                     (guix build union)
+                     (ice-9 ftw))
+        (let ((fonts-dirs (filter file-exists?
+                                  (map (cut string-append <>
+                                            "/share/fonts")
+                                       '#$(manifest-inputs manifest)))))
           (mkdir #$output)
-          (if (null? ttf-dirs)
+          (if (null? fonts-dirs)
               (exit #t)
-              (let* ((fonts-dir   (string-append #$output "/share/fonts"))
-                     (ttf-dir     (string-append fonts-dir "/truetype"))
+              (let* ((share-dir   (string-append #$output "/share"))
+                     (fonts-dir   (string-append share-dir "/fonts"))
                      (mkfontscale (string-append #+mkfontscale
                                                  "/bin/mkfontscale"))
                      (mkfontdir   (string-append #+mkfontdir
-                                                 "/bin/mkfontdir")))
-                (mkdir-p fonts-dir)
-                (union-build ttf-dir ttf-dirs
-                             #:log-port (%make-void-port "w"))
-                (with-directory-excursion ttf-dir
-                  (exit (and (zero? (system* mkfontscale))
-                             (zero? (system* mkfontdir))))))))))
+                                                 "/bin/mkfontdir"))
+                     (empty-file? (lambda (filename)
+                                    (call-with-ascii-input-file filename
+                                      (lambda (p)
+                                        (eqv? #\0 (read-char p))))))
+                     (fonts-dir-file "fonts.dir")
+                     (fonts-scale-file "fonts.scale"))
+                (mkdir-p share-dir)
+                (union-build fonts-dir fonts-dirs
+                             #:log-port (%make-void-port "w")
+                             #:create-all-directories? #t)
+                (ftw fonts-dir
+                     (lambda (dir statinfo flag)
+                       (and (eq? flag 'directory)
+                            (with-directory-excursion dir
+                              (and (file-exists? fonts-scale-file)
+                                   (delete-file fonts-scale-file))
+                              (and (file-exists? fonts-dir-file)
+                                   (delete-file fonts-dir-file))
+                              (system* mkfontscale)
+                              (system* mkfontdir)
+                              (and (empty-file? fonts-scale-file)
+                                   (delete-file fonts-scale-file))
+                              (and (empty-file? fonts-dir-file)
+                                   (delete-file fonts-dir-file))))
+                       #t)))))))
 
   (gexp->derivation "fonts-dir" build
                     #:modules '((guix build utils)
-                                (guix build union))
+                                (guix build union)
+                                (srfi srfi-26)
+                                (ice-9 ftw))
                     #:local-build? #t
                     #:substitutable? #f))
 
-- 
2.12.0

Re: [PATCH -v2 2/2] guix: profiles: create fonts.dir/scale for all fonts directories

[Danny Milosavljevic]

Hi,

> +                            (with-directory-excursion dir
> +                              (and (file-exists? fonts-scale-file)
> +                                   (delete-file fonts-scale-file))
> +                              (and (file-exists? fonts-dir-file)
> +                                   (delete-file fonts-dir-file))
> +                              (system* mkfontscale)
> +                              (system* mkfontdir)

Please do not throw away the status code here (result of system*). You can check for okayness by (zero? (system* ...)).

Re: [PATCH -v2 2/2] guix: profiles: create fonts.dir/scale for all fonts directories

[huang ying]

On Wed, Mar 8, 2017 at 4:24 AM, Danny Milosavljevic
<dannym@scratchpost.org> wrote:
> Hi,
>
>> +                            (with-directory-excursion dir
>> +                              (and (file-exists? fonts-scale-file)
>> +                                   (delete-file fonts-scale-file))
>> +                              (and (file-exists? fonts-dir-file)
>> +                                   (delete-file fonts-dir-file))
>> +                              (system* mkfontscale)
>> +                              (system* mkfontdir)
>
> Please do not throw away the status code here (result of system*). You can check for okayness by (zero? (system* ...)).

Then what is the intended behavior?  abort the build process with
message and non-zero exit code?  Usually we will raise a exception or
just display some message and exit?

Best Regards,
Huang, Ying

Re: [PATCH -v2 2/2] guix: profiles: create fonts.dir/scale for all fonts directories

[Ludovic Courtès]

huang ying <huang.ying.caritas@gmail.com> skribis:

> On Wed, Mar 8, 2017 at 4:24 AM, Danny Milosavljevic
> <dannym@scratchpost.org> wrote:
>> Hi,
>>
>>> +                            (with-directory-excursion dir
>>> +                              (and (file-exists? fonts-scale-file)
>>> +                                   (delete-file fonts-scale-file))
>>> +                              (and (file-exists? fonts-dir-file)
>>> +                                   (delete-file fonts-dir-file))
>>> +                              (system* mkfontscale)
>>> +                              (system* mkfontdir)
>>
>> Please do not throw away the status code here (result of system*). You can check for okayness by (zero? (system* ...)).
>
> Then what is the intended behavior?  abort the build process with
> message and non-zero exit code?  Usually we will raise a exception or
> just display some message and exit?

See for instance ‘info-dir-file’, which does this:

          (exit (every install-info
                       (append-map info-files
                                   '#$(manifest-inputs manifest))))

The effect is to exit with 0 upon success and some other code upon
failure, leading to a proper derivation build failure.

HTH!

Ludo’.

Re: [PATCH -v2 2/2] guix: profiles: create fonts.dir/scale for all fonts directories

[Huang, Ying]

ludo@gnu.org (Ludovic Courtès) writes:

> huang ying <huang.ying.caritas@gmail.com> skribis:
>
>> On Wed, Mar 8, 2017 at 4:24 AM, Danny Milosavljevic
>> <dannym@scratchpost.org> wrote:
>>> Hi,
>>>
>>>> +                            (with-directory-excursion dir
>>>> +                              (and (file-exists? fonts-scale-file)
>>>> +                                   (delete-file fonts-scale-file))
>>>> +                              (and (file-exists? fonts-dir-file)
>>>> +                                   (delete-file fonts-dir-file))
>>>> +                              (system* mkfontscale)
>>>> +                              (system* mkfontdir)
>>>
>>> Please do not throw away the status code here (result of system*). You can check for okayness by (zero? (system* ...)).
>>
>> Then what is the intended behavior?  abort the build process with
>> message and non-zero exit code?  Usually we will raise a exception or
>> just display some message and exit?
>
> See for instance ‘info-dir-file’, which does this:
>
>           (exit (every install-info
>                        (append-map info-files
>                                    '#$(manifest-inputs manifest))))
>
> The effect is to exit with 0 upon success and some other code upon
> failure, leading to a proper derivation build failure.

Sure.

Best Regards,
Huang, Ying

> HTH!
>
> Ludo’.

Re: [PATCH -v2 2/2] guix: profiles: create fonts.dir/scale for all fonts directories

[Ludovic Courtès]

Huang Ying <huang.ying.caritas@gmail.com> skribis:

> * guix/profiles.scm (fonts-dir-file): Create fonts.dir/scale files for all
>   fonts directories.

Looks cool, modulo Danny’s suggestions and minor issues below.

BTW, could you explain (probably as a comment in the code) why we need
to do all this?  What is it fixing?  :-)

> +                (union-build fonts-dir fonts-dirs
> +                             #:log-port (%make-void-port "w")
> +                             #:create-all-directories? #t)
> +                (ftw fonts-dir
> +                     (lambda (dir statinfo flag)

‘ftw’ is not great IMO and not used in Guix.

I would suggest using ‘find-files’ from (guix build utils).  You could
write something like:

  (let ((directories (find-files fonts-dir
                                 (lambda (file stat)
                                   (eq? 'directory (stat:type stat)))
                                 #:directories? #t)))
    (for-each do-something directories))

This also has the advantage of separating the generation of the
directory list from the actual action.

> +                       (and (eq? flag 'directory)
> +                            (with-directory-excursion dir
> +                              (and (file-exists? fonts-scale-file)
> +                                   (delete-file fonts-scale-file))

Here, since ‘delete-file’ has a side-effect and a meaningless return
value, we conventionally avoid ‘and’ and instead write:

  (when (file-exists? fonts-scale-file)
    (delete-file fonts-scale-file))

for clarity.

> +                              (and (file-exists? fonts-dir-file)
> +                                   (delete-file fonts-dir-file))
> +                              (system* mkfontscale)
> +                              (system* mkfontdir)
> +                              (and (empty-file? fonts-scale-file)
> +                                   (delete-file fonts-scale-file))
> +                              (and (empty-file? fonts-dir-file)
> +                                   (delete-file fonts-dir-file))))

Same as above.

Thank you!

Ludo’.

Re: [PATCH -v2 2/2] guix: profiles: create fonts.dir/scale for all fonts directories

[Huang, Ying]

Hi, Ludo,

Thanks for comments!

ludo@gnu.org (Ludovic Courtès) writes:

> Huang Ying <huang.ying.caritas@gmail.com> skribis:
>
>> * guix/profiles.scm (fonts-dir-file): Create fonts.dir/scale files for all
>>   fonts directories.
>
> Looks cool, modulo Danny’s suggestions and minor issues below.
>
> BTW, could you explain (probably as a comment in the code) why we need
> to do all this?  What is it fixing?  :-)

Sure.

>> +                (union-build fonts-dir fonts-dirs
>> +                             #:log-port (%make-void-port "w")
>> +                             #:create-all-directories? #t)
>> +                (ftw fonts-dir
>> +                     (lambda (dir statinfo flag)
>
> ‘ftw’ is not great IMO and not used in Guix.
>
> I would suggest using ‘find-files’ from (guix build utils).  You could
> write something like:
>
>   (let ((directories (find-files fonts-dir
>                                  (lambda (file stat)
>                                    (eq? 'directory (stat:type stat)))
>                                  #:directories? #t)))
>     (for-each do-something directories))
>
> This also has the advantage of separating the generation of the
> directory list from the actual action.

Sure.

>> +                       (and (eq? flag 'directory)
>> +                            (with-directory-excursion dir
>> +                              (and (file-exists? fonts-scale-file)
>> +                                   (delete-file fonts-scale-file))
>
> Here, since ‘delete-file’ has a side-effect and a meaningless return
> value, we conventionally avoid ‘and’ and instead write:
>
>   (when (file-exists? fonts-scale-file)
>     (delete-file fonts-scale-file))
>
> for clarity.

Sure

>> +                              (and (file-exists? fonts-dir-file)
>> +                                   (delete-file fonts-dir-file))
>> +                              (system* mkfontscale)
>> +                              (system* mkfontdir)
>> +                              (and (empty-file? fonts-scale-file)
>> +                                   (delete-file fonts-scale-file))
>> +                              (and (empty-file? fonts-dir-file)
>> +                                   (delete-file fonts-dir-file))))
>
> Same as above.

Sure.

Best Regards,
Huang, Ying

> Thank you!
>
> Ludo’.

Re: [PATCH -v2 1/2] build: union: Add create-all-directories? parameter to union-build

[Danny Milosavljevic]

Hi,

On Tue,  7 Mar 2017 19:07:48 +0800
Huang Ying <huang.ying.caritas@gmail.com> wrote:

> * guix/build/union.scm (union-build): Add create-all-directories? keyword
>   parameter.  To add/remove some files from the directory.

Maybe without "To add/remove some files from the directory." ?

If you'd like to document your new functionality, please update the docstring in the source code - it's not like we read the git log for API documentation.

The source code currently says:

 "Build in the OUTPUT directory a symlink tree that is the union of all
 the INPUTS."

and it could be updated to say:

 "Build in the OUTPUT directory a symlink tree that is the union of all
  the INPUTS.  As a special case, if CREATE-ALL-DIRECTORIES?, creates
  the direct subdirectories in the output directory to make sure the
  user can add to them later."

Otherwise LGTM!

Re: [PATCH -v2 1/2] build: union: Add create-all-directories? parameter to union-build

[Danny Milosavljevic]

>  "Build in the OUTPUT directory a symlink tree that is the union of all
>   the INPUTS.  As a special case, if CREATE-ALL-DIRECTORIES?, creates
>   the direct subdirectories in the output directory to make sure the
>   user can add to them later."

Or without "direct" if it's intended to do it recursively.

Re: [PATCH -v2 1/2] build: union: Add create-all-directories? parameter to union-build

[huang ying]

On Wed, Mar 8, 2017 at 4:35 AM, Danny Milosavljevic
<dannym@scratchpost.org> wrote:
> Hi,
>
> On Tue,  7 Mar 2017 19:07:48 +0800
> Huang Ying <huang.ying.caritas@gmail.com> wrote:
>
>> * guix/build/union.scm (union-build): Add create-all-directories? keyword
>>   parameter.  To add/remove some files from the directory.
>
> Maybe without "To add/remove some files from the directory." ?
>
> If you'd like to document your new functionality, please update the docstring in the source code - it's not like we read the git log for API documentation.

Sure.

> The source code currently says:
>
>  "Build in the OUTPUT directory a symlink tree that is the union of all
>  the INPUTS."
>
> and it could be updated to say:
>
>  "Build in the OUTPUT directory a symlink tree that is the union of all
>   the INPUTS.  As a special case, if CREATE-ALL-DIRECTORIES?, creates
>   the direct subdirectories in the output directory to make sure the
>   user can add to them later."

Will change the docstring as this.  Maybe change "user" to "caller" to
emphasize the end user will not change the directories.

> Otherwise LGTM!

Thanks!

Best Regards,
Huang, Ying

Re: [PATCH -v2 1/2] build: union: Add create-all-directories? parameter to union-build

[Ludovic Courtès]

Huang Ying <huang.ying.caritas@gmail.com> skribis:

> * guix/build/union.scm (union-build): Add create-all-directories? keyword
>   parameter.  To add/remove some files from the directory.

I guess this is needed for fonts.dir, but could you explain why it is?
(The explanation could go as a comment above the ‘union-build’ call in
the second patch.)

Other than that LGTM.

Thanks,
Ludo’.

Re: [PATCH -v2 1/2] build: union: Add create-all-directories? parameter to union-build

[Huang, Ying]

ludo@gnu.org (Ludovic Courtès) writes:

> Huang Ying <huang.ying.caritas@gmail.com> skribis:
>
>> * guix/build/union.scm (union-build): Add create-all-directories? keyword
>>   parameter.  To add/remove some files from the directory.
>
> I guess this is needed for fonts.dir, but could you explain why it is?
> (The explanation could go as a comment above the ‘union-build’ call in
> the second patch.)

Sure.

Best Regards,
Huang, Ying

> Other than that LGTM.
>
> Thanks,
> Ludo’.