;;;; semantic-version.compare.scm  -*- Scheme -*-
;;;; Kon Lovett, Apr '21

;; Issues
;;
;; - Use symbol as ident impl, not string
;;
;; - Support Roman Numerals & Upper/Lowercase Letters ("outline numbers").
;;
;; - Use interleaved elm chr in single sequence
;;
;; - Use vector

(module semantic-version.compare

(;export
  ;
  version-tail-zero
  ;
  version-compare
  version<? version=? version>? version<=? version>=?
  version-hash
  version-strict=?)

(import scheme utf8
  (chicken base)
  (chicken type)
  (only (srfi 1) drop-while reverse!)
  (only (srfi 69) equal?-hash)
  (only record-variants define-record-type-variant)
  (semantic-version core)
  (semantic-version components))

;;

;NOTE symbols are not preserved; the printname is used!
(include-relative "semantic-version.types")

(: version-tail-zero (#!optional boolean -> boolean))

(: version-compare (ver ver #!optional boolean -> integer))
(: version<? (ver ver #!optional boolean -> boolean))
(: version=? (ver ver #!optional boolean -> boolean))
(: version>? (ver ver #!optional boolean -> boolean))
(: version<=? (ver ver #!optional boolean -> boolean))
(: version>=? (ver ver #!optional boolean -> boolean))
(: version-hash (ver #!rest -> integer))
(: version-strict=? (ver ver #!optional boolean -> boolean))

;;

(include-relative "semantic-version-internals")

;;

(define version-tail-zero (make-parameter #f))

(define (number-zero? x) (and (number? x) (zero? x)))

(define (drop-tailing-zeros ls) (reverse! (drop-while number-zero? (reverse ls))))

(define (tail-zeros ls tail-0-flag) (if tail-0-flag ls (drop-tailing-zeros ls)))

;;

(define (version-compare ver1 ver2 #!optional (tail-0-flag (version-tail-zero)))
  (let loop ((p1 (tail-zeros (ver-parts (check-version 'version-compare ver1 'ver1))
                             tail-0-flag))
             (p2 (tail-zeros (ver-parts (check-version 'version-compare ver2 'ver2))
                             tail-0-flag)))
          ;eol
    (cond ((null? p1) (if (null? p2) 0 -1))
          ((null? p2) 1)
          ;kick-it to the defineds
          (else
            (let ((cmp (version-component-compare (car p1) (car p2))))
              (if (not (zero? cmp)) cmp
                  (loop (cdr p1) (cdr p2)) ) ) ) ) ) )

(define (version<? ver1 ver2 #!optional (tail-0-flag (version-tail-zero)))
  (negative? (version-compare ver1 ver2 tail-0-flag)) )

(define (version=? ver1 ver2 #!optional (tail-0-flag (version-tail-zero)))
  (zero? (version-compare ver1 ver2 tail-0-flag)) )

(define (version>? ver1 ver2 #!optional (tail-0-flag (version-tail-zero)))
  (positive? (version-compare ver1 ver2 tail-0-flag)) )

(define (version<=? ver1 ver2 #!optional (tail-0-flag (version-tail-zero)))
  (<= (version-compare ver1 ver2 tail-0-flag) 0) )

(define (version>=? ver1 ver2 #!optional (tail-0-flag (version-tail-zero)))
  (>= (version-compare ver1 ver2 tail-0-flag) 0) )

(define (version-hash ver . rest)
  (apply equal?-hash (tail-zeros (ver-parts (check-version 'version-hash ver))
                                 (version-tail-zero))
                     rest) )

(define (version-strict=? ver1 ver2 #!optional (tail-0-flag (version-tail-zero)))
  (and (version=? ver1 ver2 tail-0-flag)
       (equal? (ver-puncs ver1) (ver-puncs ver2))) )

) ;module semantic-version.compare