>From 37ac6690b6609105211b093f129b6325616251f9 Mon Sep 17 00:00:00 2001
From: Mario Domenech Goulart <mario@parenteses.org>
Date: Fri, 2 Dec 2022 22:14:48 +0100
Subject: [PATCH] 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.
---
 NEWS                |  3 +++
 chicken-install.scm | 21 ++++++++++++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

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+))
-- 
2.30.2