;;;; 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*<? version*=? version*>? version*<=? version*>=?
  ;version*-hash
  version-comparator)

(import scheme
  utf8
  (chicken base)
  (chicken type)
  (only (chicken string) string-compare3)
  (only (srfi 1) drop-while reverse!)
  (only (srfi 69) equal?-hash)
  (only (srfi 128) make-comparator)
  (semantic-version core))

;;

;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-comparator   (--> (struct comparator)))

;;

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

;;

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

(define number-zero? (conjoin number? zero?))

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

;;

(define (version-compare ver1 ver2 #!optional (tail-zero? (version-tail-zero)))
  (define (tail-zeros ls) (if tail-zero? ls (drop-tailing-zeros ls)))
  (let loop ((p1 (tail-zeros (ver-parts (check-version 'version-compare ver1))))
             (p2 (tail-zeros (ver-parts (check-version 'version-compare ver2)))))
    (cond
      ((and (null? p1) (null? p2))  0)
      ((null? p1)                   -1)
      ((null? p2)                   1)
      ((and (number? (car p1)) (number? (car p2)))
        (let ((cmp (- (car p1) (car p2))))
          (if (zero? cmp) (loop (cdr p1) (cdr p2))
            cmp ) ) )
      ((number? (car p1))           -1)
      ((number? (car p2))           1)
      ((string-compare3 (car p1) (car p2)) =>
        (lambda (cmp)
          (if (zero? cmp) (loop (cdr p1) (cdr p2))
            cmp ) ) ) ) ) )

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

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

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

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

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

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

#;
(define (version*=? ver1 ver2 #!optional (tail-zero? (version-tail-zero)))
  (and
    (zero? (version-compare ver1 ver2 tail-zero?))
    (equal? (ver-puncs1 ver) (ver-puncs ver2))) )

#;
(define (version*-hash ver . rest)
  (equal?-hash (check-version 'version-hash* ver) rest) )

(define (version-comparator)
  (make-comparator version? version=? version<? version-hash) )

) ;module semantic-version.compare