~ruther/guix-local

9b48fb88ca8177c987b0d3bf2e9ae46dac782430 — Ludovic Courtès 13 years ago d388c2c
utils: Add `package-name->name+version'.

* guix/utils.scm (package-name->name+version): New procedure.
* guix-package.in (guix-package)[find-package]: Use it.
* tests/utils.scm ("package-name->name+version"): New test.
3 files changed, 42 insertions(+), 7 deletions(-)

M guix-package.in
M guix/utils.scm
M tests/utils.scm
M guix-package.in => guix-package.in +1 -6
@@ 283,8 283,6 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
    ;; Find the package NAME; NAME may contain a version number and a
    ;; sub-derivation name.
    (define request name)
    (define versioned-rx
      (make-regexp "^(.*)-([0-9][^-]*)$"))

    (let*-values (((name sub-drv)
                   (match (string-rindex name #\:)


@@ 292,10 290,7 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
                     (colon (values (substring name (+ 1 colon))
                                    (substring name colon)))))
                  ((name version)
                   (match (regexp-exec versioned-rx name)
                     (#f    (values name #f))
                     (m     (values (match:substring m 1)
                                    (match:substring m 2))))))
                   (package-name->name+version name)))
      (match (find-packages-by-name name version)
        ((p)
         (list name version sub-drv p))

M guix/utils.scm => guix/utils.scm +23 -1
@@ 58,7 58,8 @@
            source-properties->location

            gnu-triplet->nix-system
            %current-system))
            %current-system
            package-name->name+version))


;;;


@@ 571,6 572,27 @@ returned by `config.guess'."
  ;; System type as expected by Nix, usually ARCHITECTURE-KERNEL.
  (make-parameter (gnu-triplet->nix-system %host-type)))

(define (package-name->name+version name)
  "Given NAME, a package name like \"foo-0.9.1b\", return two values:
\"foo\" and \"0.9.1b\".  When the version part is unavailable, NAME and
#f are returned.  The first hyphen followed by a digit is considered to
introduce the version part."
  ;; See also `DrvName' in Nix.

  (define number?
    (cut char-set-contains? char-set:digit <>))

  (let loop ((chars   (string->list name))
             (prefix '()))
    (match chars
      (()
       (values name #f))
      ((#\- (? number? n) rest ...)
       (values (list->string (reverse prefix))
               (list->string (cons n rest))))
      ((head tail ...)
       (loop tail (cons head prefix))))))


;;;
;;; Source location.

M tests/utils.scm => tests/utils.scm +18 -0
@@ 104,6 104,24 @@
               (equal? nix (gnu-triplet->nix-system gnu)))
             gnu nix))))

(test-assert "package-name->name+version"
  (every (match-lambda
          ((name version)
           (let*-values (((full-name)
                          (if version
                              (string-append name "-" version)
                              name))
                         ((name* version*)
                          (package-name->name+version full-name)))
             (and (equal? name* name)
                  (equal? version* version)))))
         '(("foo" "0.9.1b")
           ("foo-bar" "1.0")
           ("foo-bar2" #f)
           ("guile" "2.0.6.65-134c9") ; as produced by `git-version-gen'
           ("nixpkgs" "1.0pre22125_a28fe19")
           ("gtk2" "2.38.0"))))

(test-assert "define-record-type*"
  (begin
    (define-record-type* <foo> foo make-foo