Update pseudo-meta-egg-info to allow for multiple major CHICKEN versions

2 files changed, 37 insertions, 14 deletions

diff --git a/README b/README
index cc14d53..8343e92 100644
--- a/README
+++ b/README
@@ -24,8 +24,9 @@ You can use it like this:
 (use spiffy spiffy-uri-match pseudo-meta-egg-info)
 
 ;; Trailing slash is mandatory here!
-;; By default this uses the Chicken repo
-(egg-repo "http://example.com/your-egg-repo/eggs/release/4/")
+;; The {chicken-release} placeholder gets replaced by the major CHICKEN version.
+;; By default this uses the Chicken repo.
+(egg-repo "http://example.com/your-egg-repo/eggs/release/{chicken-release}/")
 
 (vhost-map `((".*" 
               . ,(uri-match/spiffy
@@ -34,8 +35,8 @@ You can use it like this:
 (start-server)
 
 
-This makes the release-info for egg MY-EGG available under
-http://localhost:8080/release-info?egg=MY-EGG
+This makes the release-info for the CHICKEN 4 version of egg MY-EGG, available under
+http://localhost:8080/release-info?egg=MY-EGG;release=4
 
-and the files-list for release 1.0 under
-http://localhost:8080/files-list?egg=MY-EGG;release=1.0
+and the files-list for release 1.0 for the CHICKEN 5 version of MY-EGG under
+http://localhost:8080/files-list?egg=MY-EGG;release=1.0;release=5
diff --git a/pseudo-meta-egg-info.scm b/pseudo-meta-egg-info.scm
index d1ff8d8..3dd406a 100644
--- a/pseudo-meta-egg-info.scm
+++ b/pseudo-meta-egg-info.scm
@@ -10,23 +10,39 @@
 (import chicken scheme)
 (use extras data-structures spiffy intarweb uri-common svn-client)
 
+(define *default-chicken-release* "4")
+
 (define egg-repo
-  (make-parameter "http://anonymous:@code.call-cc.org/svn/chicken-eggs/release/4/"))
+  (make-parameter "http://anonymous:@code.call-cc.org/svn/chicken-eggs/release/{chicken-release}/"))
+
+;; This works on raw URI strings, not URI objects (for now?)
+(define (replace-uri-patterns uri patterns)
+  (string-translate* uri (map (lambda (pattern)
+                                (cons (conc "{" (car pattern) "}")
+                                      (uri-encode-string (->string (cdr pattern)))))
+                              patterns)))
 
 (define (release-info continue)
   (or (and-let* ((params (uri-query (request-uri (current-request))))
                  (port (response-port (current-response)))
+                 (chicken-release (string->number
+                                   (alist-ref 'release params eq?
+                                              *default-chicken-release*)))
                  (egg-name (alist-ref 'egg params))
                  ((not (string=? egg-name "")))
                  (tag-dir (update-uri (uri-reference "")
                                       path: (list egg-name "tags")))
-                 (repo-uri (uri-reference (egg-repo)))
+                 (uri-string (replace-uri-patterns
+                              (egg-repo)
+                              `((chicken-release . ,chicken-release))))
+                 (repo-uri (uri-reference uri-string))
                  (tags-uri (update-uri (uri-relative-to tag-dir repo-uri)
                                        username: #f password: #f)))
-        (or (and-let* ((releases (svn-client-list (uri->string tags-uri (constantly ""))
-                                                  svn-opt-revision-head 2
-                                                  (uri-username repo-uri)
-                                                  (uri-password repo-uri)))
+        (or (and-let* ((egg-releases
+                        (svn-client-list (uri->string tags-uri (constantly ""))
+                                         svn-opt-revision-head 2
+                                         (uri-username repo-uri)
+                                         (uri-password repo-uri)))
                        (files-list-uri (conc (uri->string
                                               (uri-relative-to
                                                (uri-reference "files-list")
@@ -43,7 +59,7 @@
                                          (not (string=? (svn-file-path r) "")))
                                 (write `(release ,(svn-file-path r)) port)
                                 (newline port)))
-                            releases)
+                            egg-releases)
                   (close-output-port port))))
             (send-status 404 (sprintf "Egg \"~A\" doesn't exist or has no tags dir" egg-name))))
       (send-status 400 "No egg name given")))
@@ -51,13 +67,19 @@
 (define (files-list continue)
   (or (and-let* ((params (uri-query (request-uri (current-request))))
                  (port (response-port (current-response)))
+                 (chicken-release (string->number
+                                   (alist-ref 'release params eq?
+                                              *default-chicken-release*)))
                  (egg-name (alist-ref 'egg params))
                  ((not (string=? egg-name "")))
                  (egg-release (alist-ref 'release params))
                  ((not (string=? egg-release "")))
                  (files-dir (update-uri (uri-reference "")
                                         path: (list egg-name "tags" egg-release)))
-                 (repo-uri (uri-reference (egg-repo)))
+                 (uri-string (replace-uri-patterns
+                              (egg-repo)
+                              `((chicken-release . ,chicken-release))))
+                 (repo-uri (uri-reference uri-string))
                  (files-uri (update-uri (uri-relative-to files-dir repo-uri))))
         (or (and-let* ((files (svn-client-list (uri->string files-uri (constantly ""))
                                                svn-opt-revision-head #t