~ chicken-core (chicken-5) 9d597d33ba57f2983aa924339b71fe055131ba16

commit 9d597d33ba57f2983aa924339b71fe055131ba16
Author:     Mario Domenech Goulart <mario@parenteses.org>
AuthorDate: Fri Dec 2 22:14:48 2022 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Dec 9 13:24:58 2022 +0100

    chicken-install: Consider two location layouts
    
    When `location' is specified in setup.defaults, make chicken-install
    consider two location layouts when looking for eggs:
    
    * <location>/<egg>
    * <location>/<egg>/<version>
    
    This can be convenient for users who use clones of the
    eggs-5-{all,latest} git repository of egg sources, or caches generated
    by henrietta-cache.
    
    As a bonus, support specification of versions when installing eggs
    from a local directory.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/NEWS b/NEWS
index 54888aff..7e0cffa5 100644
--- a/NEWS
+++ b/NEWS
@@ -19,6 +19,9 @@
   - The -prelude and -postlude options for csc work properly again.
   - chicken-install now retrieves the latest egg version when
     instructed to install an egg that's already installed (#1802).
+  - When `location' is specified in setup.defaults, chicken-install
+    will consider two location layouts when looking for eggs:
+    <location>/<egg> and <location>/<egg>/<version>.
 
 - Compiler
   - When emitting types files, the output list is now sorted, to ensure
diff --git a/chicken-install.scm b/chicken-install.scm
index 14333ce4..05fc1494 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -469,6 +469,25 @@
              (resolve-location new))))
         (else name)))
 
+(define (locate-local-egg-dir location egg-name version)
+  ;; Locate the directory of egg-name, considering the following
+  ;; directory layouts in order:
+  ;; * <location>/<egg-name>/<egg-name>.egg
+  ;; * <location>/<egg-name>/<version>/<egg-name>.egg
+  (and-let* ((egg-dir (probe-dir (make-pathname location egg-name))))
+    (cond
+     ;; <location>/<egg-name>/<egg-name>.egg
+     ((file-exists? (make-pathname egg-dir egg-name +egg-extension+))
+      egg-dir)
+     (else
+      ;; <location>/<egg-name>/<version>/<egg-name>.egg
+      (if version
+          (probe-dir (make-pathname egg-dir version))
+          (let ((versions (directory egg-dir)))
+            (and (not (null? versions))
+                 (let ((latest (car (sort versions version>=?))))
+                   (make-pathname egg-dir latest)))))))))
+
 (define (fetch-egg-sources name version dest lax)
   (print "fetching " name)
   (let loop ((locs default-locations))
@@ -503,7 +522,7 @@
                                  (make-pathname dest +timestamp-file+)
                                  (cut write (current-seconds))))
                              (else (loop (cdr srvs))))))))))
-          ((probe-dir (make-pathname (car locs) name))
+          ((locate-local-egg-dir (car locs) name version)
            => (lambda (dir)
                 (d "trying location ~a ...~%" dir)
                 (let* ((eggfile (make-pathname dir name +egg-extension+))