;;;; 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 (chicken string) string-compare3)
  (only (srfi 1) drop-while reverse!)
  (only (srfi 69) equal?-hash)
  (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-strict=?     (ver ver #!optional boolean --> boolean))

;;

(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 (tail-zeros ls tail-zero?) (if tail-zero? ls (drop-tailing-zeros ls)))

;;

(define (version-compare ver1 ver2 #!optional (tail-zero? (version-tail-zero)))
  (let loop (
    (p1 (tail-zeros (ver-parts (check-version 'version-compare ver1 'ver1)) tail-zero?))
    (p2 (tail-zeros (ver-parts (check-version 'version-compare ver2 'ver2)) tail-zero?)))
    (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 (canon-compare-elm (car p1)) (canon-compare-elm (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)
  (apply equal?-hash (tail-zeros (ver-parts (check-version 'version-hash ver)) (version-tail-zero)) rest) )

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

) ;module semantic-version.compare