Re: Subdirectories in GUIX_PACKAGE_PATH

[ludo@gnu.org (Ludovic Courtès)]

[-- Attachment #1: Type: text/plain, Size: 1047 bytes --]

Hello,

Ricardo Wurmus <rekado@elephly.net> skribis:

> Christopher Baines <mail@cbaines.net> writes:
>
>> Recently I had problems with the way GUIX_PACKAGE_PATH was working with
>> govuk-guix [1]. Currently, I'm using a separate directory for the
>> GUIX_PACKAGE_PATH that contains symlinks to a subset of the Guile
>> modules necessary for the packages in the repository.
>>
>> I think support (whether intentional or otherwise) for this approach was
>> removed in [2].
>
> Looks like this was removed in an attempt to improve performance over
> NFS.  The “scheme-files” procedure now includes a comment:
>
>   ;; XXX: We don't recurse if we find a symlink.
>
> Would it not be better to fix this instead of adding support for special
> syntax in GUIX_PACKAGE_PATH?

Indeed, apologies for the breakage.

I think the patch below fixes it.  It incurs overhead only when a
symlink is encountered, which is reasonable I think.

Chris & Alex: could you give it a try and report back?

Thanks in advance,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1249 bytes --]

diff --git a/guix/discovery.scm b/guix/discovery.scm
index 292df2bd9..b1731de93 100644
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -60,11 +60,20 @@ DIRECTORY is not accessible."
                      (case (entry-type absolute properties)
                        ((directory)
                         (append (scheme-files absolute) result))
-                       ((regular symlink)
-                        ;; XXX: We don't recurse if we find a symlink.
+                       ((regular)
                         (if (string-suffix? ".scm" name)
                             (cons absolute result)
                             result))
+                       ((symlink)
+                        (cond ((string-suffix? ".scm" name)
+                               (cons absolute result))
+                              ((stat absolute #f)
+                               =>
+                               (match-lambda
+                                 (#f result)
+                                 ((= stat:type 'directory)
+                                  (append (scheme-files absolute)
+                                          result))))))
                        (else
                         result))))))
               '()