ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 06:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add version-compare and version>? to utils.scm.

Browse source 
* guix/utils.scm (version-compare, version>?): New exported procedures,
  based on version-string>?, which was formerly in gnu-maintenance.scm.

* guix/gnu-maintenance.scm (version-string>?): Removed procedure.
  (latest-release): Use 'version>?' instead of 'version-string>?'.
This commit is contained in:
Mark H Weaver 2013-02-12 12:02:15 -05:00
parent 96be765ca5
commit 0d1e6ce4d2
2 changed files with 22 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
guix/gnu-maintenance.scm
View file

@ -28,6 +28,7 @@ (define-module (guix gnu-maintenance)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (system foreign) #:use-module (system foreign)
#:use-module (guix ftp-client) #:use-module (guix ftp-client)
#:use-module (guix utils)
#:export (official-gnu-packages #:export (official-gnu-packages
releases releases
latest-release latest-release
@ -156,21 +157,12 @@ (define conn (ftp-open server))
files) files)
result))))))) result)))))))
(define version-string>?
(let ((strverscmp
(let ((sym (or (dynamic-func "strverscmp" (dynamic-link))
(error "could not find `strverscmp' (from GNU libc)"))))
(pointer->procedure int sym (list '* '*)))))
(lambda (a b)
"Return #t when B denotes a newer version than A."
(> (strverscmp (string->pointer a) (string->pointer b)) 0))))
(define (latest-release project) (define (latest-release project)
"Return (\"FOO-X.Y\" . \"/bar/foo\") or #f." "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f."
(let ((releases (releases project))) (let ((releases (releases project)))
(and (not (null? releases)) (and (not (null? releases))
(fold (lambda (release latest) (fold (lambda (release latest)
(if (version-string>? (car release) (car latest)) (if (version>? (car release) (car latest))
release release
latest)) latest))
'("" . "") '("" . "")

20
guix/utils.scm
View file

@ -57,6 +57,8 @@ (define-module (guix utils)
gnu-triplet->nix-system gnu-triplet->nix-system
%current-system %current-system
version-compare
version>?
package-name->name+version)) package-name->name+version))
@ -422,6 +424,24 @@ (define %current-system
;; By default, this is equal to (gnu-triplet->nix-system %host-type). ;; By default, this is equal to (gnu-triplet->nix-system %host-type).
(make-parameter %system)) (make-parameter %system))
(define version-compare
(let ((strverscmp
(let ((sym (or (dynamic-func "strverscmp" (dynamic-link))
(error "could not find `strverscmp' (from GNU libc)"))))
(pointer->procedure int sym (list '* '*)))))
(lambda (a b)
"Return '> when A denotes a newer version than B,
'< when A denotes a older version than B,
or '= when they denote equal versions."
(let ((result (strverscmp (string->pointer a) (string->pointer b))))
(cond ((positive? result) '>)
((negative? result) '<)
(else '=))))))
(define (version>? a b)
"Return #t when A denotes a newer version than B."
(eq? '> (version-compare a b)))
(define (package-name->name+version name) (define (package-name->name+version name)
"Given NAME, a package name like \"foo-0.9.1b\", return two values: "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 \"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and