Do not show duplicates on search results. Format search result output

lib/chibi/snow/commands.scm

@@ -98,7 +98,9 @@
   (cond ((string? x) x)
         ((symbol? x) (symbol->string x))
         ((number? x) (number->string x))
-        (else (error "not a valid path component" x))))
+        (else (parameterize ((current-output-port (open-output-string)))
+                (display x)
+                (get-output-string (current-output-port))))))
 
 (define (library-path-base file name)
   (let lp ((ls (cdr (reverse name))) (dir (path-directory file)))
@@ -729,15 +731,9 @@
                `(url ,(cond
                         ((and (string-prefix? "git@" url) use-ssh-url?) url)
                         ((and (string-prefix? "ssh://" url) use-ssh-url?) url)
-                        ((string-prefix? "git@" url)
-                         (uri->string
-                           (uri-with-scheme
-                             (string->uri
-                               (string-append "https://" (string-copy url 4)))
-                               'https)))
+                        ((string-prefix? "git@" url) (git-url->https url))
                         ((and (string-prefix? "https://" url) use-ssh-url?)
-                         (uri->string
-                           (uri-with-scheme (string->uri url) 'ssh)))
+                         (uri->string (uri-with-scheme (string->uri url) 'ssh)))
                         ((string-prefix? "https://" url) url)
                         (else (error "Could not fix repository url" url)))))))
          (pkgs (filter-map
@@ -779,8 +775,7 @@
                             ,@(remove
                                 (lambda (x)
                                   (equal? name (package-name x))
-                                  (equal? version (package-version x))
-                                  )
+                                  (equal? version (package-version x)))
                                 (cdr repo)))))
                      (guard (exn (else (list 'repository)))
                        (car (file->sexp-list repo-path)))
@@ -1174,10 +1169,22 @@
 ;; Prints a list of libraries whose meta-info contain any of the given
 ;; keywords.  Returns in sorted order for how well the package matches.
 
-(define (summarize-libraries cfg lib-names+pkgs)
-  (for-each (lambda (name pkg) (describe-library cfg name pkg))
-            (map car lib-names+pkgs)
-            (map cdr lib-names+pkgs)))
+(define (summarize-libraries cfg lib-names+pkgs . repo)
+  (let* ((repository (if (null? repo) '(repository) (car repo)))
+         (sorted-lib-names+pkgs
+           (delete-duplicates
+             (sort lib-names+pkgs string>=? package-version)
+             (lambda (a b) (equal? (package-id repo (cdr a) #f)
+                                   (package-id repo (cdr b) #f)))))
+         (packages (map cdr sorted-lib-names+pkgs))
+         (names (map x->string (map package-name packages)))
+         (versions (map x->string (map package-version packages)))
+         (get-publisher (lambda (x) (package-publisher repository x)))
+         (publishers (map x->string (map get-publisher packages))))
+    (show #t
+          (columnar (joined displayed (cons "Name" names) "\n")
+                    (joined displayed (cons "Version" versions) "\n")
+                    (joined displayed (cons "Publisher" publishers) "\n")))))
 
 (define (string-count-word str word)
   (let lp ((sc (string-cursor-start str)) (count 0))
@@ -1237,7 +1244,7 @@
     (cond
      ((or (pair? lib-names+pkgs) sexp?)
       (if sexp? (display "("))
-      (summarize-libraries cfg lib-names+pkgs)
+      (summarize-libraries cfg lib-names+pkgs repo)
       (if sexp? (display ")\n")))
      (else
       (display "No libraries matched your query.\n")))))

lib/chibi/snow/commands.sld

@@ -31,6 +31,8 @@
           (srfi 1)
           (srfi 27)
           (srfi 95)
+          (srfi 166)
+          (srfi 166 columnar)
           (chibi snow interface)
           (chibi snow package)
           (chibi snow utils)
@@ -49,7 +51,6 @@
           (chibi process)
           (chibi pathname)
           (chibi regexp)
-          (chibi show)
           (chibi show pretty)
           (chibi string)
           (chibi sxml)

lib/chibi/snow/package.scm

@@ -101,6 +101,14 @@
            (any library-name (package-libraries package))
            (any program-name (package-programs package)))))
 
+(define (package-id repo pkg . exclude-version?)
+  (append (list (package-name pkg)
+                (package-publisher repo pkg))
+          (if (or (null? exclude-version?)
+                  (equal? (car exclude-version?) #f))
+            '()
+            (list (package-version pkg)))))
+
 (define (package-email pkg)
   (and (package? pkg)
        (let ((sig (assq 'signature (cdr pkg))))
@@ -110,6 +118,16 @@
 (define (strip-email str)
   (string-trim (regexp-replace '(: "<" (* (~ (">"))) ">") str "")))
 
+(define (package-publisher repo pkg)
+  (cond
+    ((package-git-url pkg #t)
+     => (lambda (uri)
+          (let* ((uri (string->uri (package-git-url pkg #t)))
+                 (host (uri-host uri))
+                 (repository-name (path-directory (uri-path uri))))
+            (string-append (string-copy repository-name 1) "@" host))))
+    (else (package-email pkg))))
+
 (define (package-author repo pkg . o)
   (let ((show-email? (and (pair? o) (car o))))
     (cond
@@ -142,8 +160,13 @@
      (else
       #f))))
 
-(define (package-git-url pkg)
-  (car (assq-ref (assq-ref pkg 'git '()) 'url '(#f))))
+(define (package-git-url pkg . as-https?)
+  (let ((url (car (assq-ref (assq-ref pkg 'git '()) 'url '(#f)))))
+    (if (and url
+             (not (null? as-https?))
+             (car as-https?))
+      (git-url->https url)
+      url)))
 
 (define (package-git-tag pkg)
   (car (assq-ref (assq-ref pkg 'git '()) 'tag '(#f))))

lib/chibi/snow/package.sld

@@ -1,8 +1,8 @@
 
 (define-library (chibi snow package)
   (export package? library? program?
-          package-name package-email package-url package-version
-          package-git-url package-git-tag package-git-hash
+          package-name package-id package-email package-url package-version
+          package-git-url package-git-tag package-git-hash package-publisher
           package-libraries package-programs package-data-files
           package-provides? package-dependencies package-test-dependencies
           package-installed-files package-author package-maintainer

lib/chibi/snow/utils.scm

@@ -278,3 +278,16 @@
      (pad2 (time-hour tm)) ":"
      (pad2 (time-minute tm)) ":"
      (pad2 (time-second tm)) "+00:00")))
+
+(define (git-url->https url)
+  (string-append
+    "https://"
+    (list->string
+      (map (lambda (c)
+             ;; To fix githost.com:Username urls
+             (if (char=? c #\:) #\/ c))
+           (string->list
+             (if (string-prefix? "git@" url)
+               (string-copy url (string-length "git@"))
+               (string-copy url (string-length "https://"))))))))
+

lib/chibi/snow/utils.sld

@@ -3,7 +3,7 @@
   (export find-in-path find-sexp-in-path
           write-to-string display-to-string
           resource->bytevector git-resource->bytevector
-          uri-normalize uri-directory
+          uri-normalize uri-directory git-url->https
           version-split version-compare version>? version>=?
           topological-sort assq-ref
           known-implementations impl->version impl->features tai->rfc-3339)