Nicer error message from bh install when the package isn't found

per-gron · Nov 11, 2011 · b84d72e · b84d72e
1 parent 41f3502
commit b84d72e
Show file tree

Hide file tree

Showing 2 changed files with 58 additions and 47 deletions.
diff --git a/src/cli.scm b/src/cli.scm
@@ -321,10 +321,15 @@
                   installed at a time:" args))
 
   (let ((pkgs-to-be-installed
-         (find-packages-for-installation
-          args
-          version: version
-          ignore-dependencies?: ignore-dependencies))
+         (or (find-packages-for-installation
+              args
+              version: version
+              ignore-dependencies?: ignore-dependencies
+              throw-error?: #f)
+             (apply
+              die/error
+              (cons "No package with the specified version was found:"
+                    args))))
         (port (if quiet
                   (open-string "")
                   (current-output-port))))

diff --git a/src/packages.scm b/src/packages.scm
@@ -774,49 +774,55 @@
          pkg-names ;; A list of strings
          #!key
          (version #t)
-         ignore-dependencies?)
-  (remove-duplicates
-   (apply
-    append
-    (map
-        (lambda (pkg-name)
-          (let* ((pkg
-                  (find-suitable-package (get-remote-packages)
-                                         pkg-name
-                                         version: version))
-                 (pkg-md
-                  (package-metadata pkg))
-                 (pkgs-to-be-installed (list pkg)))
-            (if (not ignore-dependencies?)
-                (let loop ((deps (package-metadata-dependencies pkg-md)))
-                  (cond
-                   ((pair? deps)
-                    (let* ((dep-pkg-name
-                            (symbol->string (caar deps)))
-                           (dep-pkg-v `(and ,@(cdar deps)))
-                           (installed-pkg
-                            (find-suitable-package (get-installed-packages)
-                                                   dep-pkg-name
-                                                   version: dep-pkg-v
-                                                   throw-error?: #f)))
-                      (if (not installed-pkg)
-                          (let ((install-pkg
-                                 (find-suitable-package (get-remote-packages)
-                                                        dep-pkg-name
-                                                        version: dep-pkg-v
-                                                        throw-error?: #f)))
-                            (if (not install-pkg)
-                                (error "Can't install dependency"
-                                       dep-pkg-name
-                                       dep-pkg-v)
-                                (begin
-                                  (loop (package-metadata-dependencies
-                                         (package-metadata install-pkg)))
-                                  (push! pkgs-to-be-installed install-pkg))))))
-                    (loop (cdr deps))))))
-
-            pkgs-to-be-installed))
-      pkg-names))))
+         ignore-dependencies?
+         (throw-error? #t))
+  (call/cc
+   (lambda (exit)
+     (remove-duplicates
+      (apply
+       append
+       (map
+           (lambda (pkg-name)
+             (let* ((pkg
+                     (or
+                      (find-suitable-package (get-remote-packages)
+                                             pkg-name
+                                             version: version
+                                             throw-error?: throw-error?)
+                      (exit #f)))
+                    (pkg-md
+                     (package-metadata pkg))
+                    (pkgs-to-be-installed (list pkg)))
+               (if (not ignore-dependencies?)
+                   (let loop ((deps (package-metadata-dependencies pkg-md)))
+                     (cond
+                      ((pair? deps)
+                       (let* ((dep-pkg-name
+                               (symbol->string (caar deps)))
+                              (dep-pkg-v `(and ,@(cdar deps)))
+                              (installed-pkg
+                               (find-suitable-package (get-installed-packages)
+                                                      dep-pkg-name
+                                                      version: dep-pkg-v
+                                                      throw-error?: #f)))
+                         (if (not installed-pkg)
+                             (let ((install-pkg
+                                    (find-suitable-package (get-remote-packages)
+                                                           dep-pkg-name
+                                                           version: dep-pkg-v
+                                                           throw-error?: #f)))
+                               (if (not install-pkg)
+                                   (error "Can't install dependency"
+                                          dep-pkg-name
+                                          dep-pkg-v)
+                                   (begin
+                                     (loop (package-metadata-dependencies
+                                            (package-metadata install-pkg)))
+                                     (push! pkgs-to-be-installed install-pkg))))))
+                       (loop (cdr deps))))))
+
+               pkgs-to-be-installed))
+         pkg-names))))))
 
 (define (package-install! pkg
                           #!key