guile-semver/semver/comparator.scm

;;; guile-semver --- Semantic Version tooling for guile
;;; Copyright © 2017 Jelle Dirk Licht <jlicht@fsfe.org>
;;;
;;; This file is part of guile-semver.
;;;
;;; guile-semver is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-semver is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-semver.  If not, see <http://www.gnu.org/licenses/>.

(define-module (semver comparator)
  #:use-module (srfi srfi-67)
  #:use-module (ice-9 match)
  #:use-module (semver structs)
  #:export (semantic-version-compare
	    *semantic-version-min*
	    *semantic-version-max*
	    semantic-version-wildcard-min
	    semantic-version-wildcard-max))

(define *semantic-version-min*
  (make-semantic-version 0 0 0 '(0) '(0)))

(define *semantic-version-max*
  (make-semantic-version +inf.0 +inf.0 +inf.0 '() '()))

(define (wildcard? part)
  (or (equal? part "X")
      (equal? part "x")
      (equal? part "*")))

;;; TODO

;; If a version has a prerelease tag (for example, 1.2.3-alpha.3) then
;; it will only be allowed to satisfy comparator sets if at least one
;; comparator with the same [major, minor, patch] tuple also has a
;; prerelease tag.

;; For example, the range >1.2.3-alpha.3 would be allowed to match the
;; version 1.2.3-alpha.7, but it would not be satisfied by
;; 3.4.5-alpha.9, even though 3.4.5-alpha.9 is technically "greater
;; than" 1.2.3-alpha.3 according to the SemVer sort rules. The version
;; range only accepts prerelease tags on the 1.2.3 version. The
;; version 3.4.5 would satisfy the range, because it does not have a
;; prerelease flag, and 3.4.5 is greater than 1.2.3-alpha.7.

;; The purpose for this behavior is twofold. First, prerelease
;; versions frequently are updated very quickly, and contain many
;; breaking changes that are (by the author's design) not yet fit for
;; public consumption. Therefore, by default, they are excluded from
;; range matching semantics.

;; Second, a user who has opted into using a prerelease version has
;; clearly indicated the intent to use that specific set of
;; alpha/beta/rc versions. By including a prerelease tag in the range,
;; the user is indicating that they are aware of the risk. However, it
;; is still not appropriate to assume that they have opted into taking
;; a similar risk on the next set of prerelease versions.

(define* (semantic-version-wildcard-max major #:optional (minor "*") (patch "*") . _)
  (cond ((wildcard? major) 		; Basically everything, except
	 *semantic-version-max*)
	((wildcard? minor)
	 (make-semantic-version
	  (string->number major) +inf.0 +inf.0 '() '()))
	((wildcard? patch)
	 (make-semantic-version
	  (string->number major) (string->number minor) +inf.0 '() '()))
	;; Last part is incorrect I guess?
	(else (inc-semantic-version (make-semantic-version* major minor patch)))))

(define* (semantic-version-wildcard-min major #:optional (minor "*") (patch "*") . _)
  (cond ((wildcard? major) 		; Basically everything, except
	 *semantic-version-min*)
	((wildcard? minor)
	 (make-semantic-version
	  (string->number major) 0 0 '(0) '(0)))
	((wildcard? patch)
	 (make-semantic-version
	  (string->number major) (string->number minor) 0 '(0) '(0)))
	;; Last part is incorrect I guess?
	(else (make-semantic-version* major minor patch))))

(define (int-str-compare int-str1 int-str2)
  (match (list (string? int-str1)
	       (number? int-str1)
	       (string? int-str2)
	       (number? int-str2))
    ((#t #f #t #f) (string-compare int-str1 int-str2))
    ((#t #f #f #t) 1)
    ((#f #t #t #f) -1)
    ((#f #t #f #t) (number-compare int-str1 int-str2))))

(define (pre-release-compare pre-release1 pre-release2)
  (match (list (null? pre-release1)
	       (null? pre-release2))
    ((#t #t) 0)
    ((#t #f) 1)
    ((#f #f)
     (list-compare int-str-compare pre-release1 pre-release2))
    ((#f #t) -1)))

(define (semantic-version-compare semver1 semver2)
  (refine-compare 
   (number-compare (semantic-version-major semver1)
		    (semantic-version-major semver2))
   (number-compare (semantic-version-minor semver1)
		    (semantic-version-minor semver2))
   (number-compare (semantic-version-patch semver1)
		    (semantic-version-patch semver2))
   (pre-release-compare (semantic-version-pre-release semver1)
			(semantic-version-pre-release semver2))

   ;; The Semantic Version specification says we should not sort on
   ;; build data, but having a total order is still nice for plenty of
   ;; things. As this ends up being kind of arbitrary, we just re-use
   ;; the pre-release ordering for now.
   (pre-release-compare (semantic-version-build-metadata semver1)
			(semantic-version-build-metadata semver2))))