ui: Add 'make-regexp*'.

Fixes <http://bugs.gnu.org/21773>.
Reported by Jan Synáček <jan.synacek@gmail.com>.

* guix/ui.scm (make-regexp*): New procedure.
* guix/scripts/package.scm (options->installable, guix-package): Use it
  when processing user-provided regexps.

2 files changed, 16 insertions, 5 deletions

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d8689490b7..adbc4a1828 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -435,14 +435,14 @@ return the new list of manifest entries."
   (define upgrade-regexps
     (filter-map (match-lambda
                  (('upgrade . regexp)
-                  (make-regexp (or regexp "")))
+                  (make-regexp* (or regexp "")))
                  (_ #f))
                 opts))
 
   (define do-not-upgrade-regexps
     (filter-map (match-lambda
                  (('do-not-upgrade . regexp)
-                  (make-regexp regexp))
+                  (make-regexp* regexp))
                  (_ #f))
                 opts))
 
@@ -736,7 +736,7 @@ more information.~%"))
          #t)
 
         (('list-installed regexp)
-         (let* ((regexp    (and regexp (make-regexp regexp)))
+         (let* ((regexp    (and regexp (make-regexp* regexp)))
                 (manifest  (profile-manifest profile))
                 (installed (manifest-entries manifest)))
            (leave-on-EPIPE
@@ -752,7 +752,7 @@ more information.~%"))
            #t))
 
         (('list-available regexp)
-         (let* ((regexp    (and regexp (make-regexp regexp)))
+         (let* ((regexp    (and regexp (make-regexp* regexp)))
                 (available (fold-packages
                             (lambda (p r)
                               (let ((n (package-name p)))
@@ -778,7 +778,7 @@ more information.~%"))
            #t))
 
         (('search regexp)
-         (let ((regexp (make-regexp regexp regexp/icase)))
+         (let ((regexp (make-regexp* regexp regexp/icase)))
            (leave-on-EPIPE
             (for-each (cute package->recutils <> (current-output-port))
                       (find-packages-by-description regexp)))
diff --git a/guix/ui.scm b/guix/ui.scm
index 72208e7de7..312c2a01a1 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -61,6 +61,7 @@
             warn-about-load-error
             show-version-and-exit
             show-bug-report-information
+            make-regexp*
             string->number*
             size->number
             show-derivation-outputs
@@ -350,6 +351,16 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
                  (list (strerror (car errno)) target)
                  (list errno)))))))
 
+(define (make-regexp* regexp . flags)
+  "Like 'make-regexp' but error out if REGEXP is invalid, reporting the error
+nicely."
+  (catch 'regular-expression-syntax
+    (lambda ()
+      (apply make-regexp regexp flags))
+    (lambda (key proc message . rest)
+      (leave (_ "'~a' is not a valid regular expression: ~a~%")
+             regexp message))))
+
 (define (string->number* str)
   "Like `string->number', but error out with an error message on failure."
   (or (string->number str)