;;;; semantic-version.operation.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
;;
;; - Better name for `version-depth+/-': `version-depth-extend/retract'?

(module semantic-version.operation

(;export
  version-extend!
  version-extend
  version-depth+!
  version-depth-!
  version-depth+
  version-depth-
  version-inc! version-dec!
  version-inc version-dec)

(import scheme
  utf8
  (chicken base)
  (chicken type)
  (only (srfi 1) append! every make-list drop drop-right! list-copy)
  (semantic-version core))

;;

(: pair-find-nth ((* -> boolean) fixnum list --> (or false pair)))

(define (pair-find-nth pred idx ls)
  (let loop ((ls ls) (idx idx) (prev #f))
    (if (or (negative? idx) (null? ls)) prev
        (loop (cdr ls) (sub1 idx) (if (pred (car ls)) ls prev)) ) ) )

;;

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

(: version-extend!      (ver #!rest (or ver-part ver-punc) -> ver))
(: version-extend       (ver #!rest (or ver-part ver-punc) --> ver))
(: version-depth+!      (ver fixnum #!optional ver-part ver-punc -> ver))
(: version-depth-!      (ver fixnum -> ver))
(: version-depth+       (ver fixnum #!optional ver-part ver-punc --> ver))
(: version-depth-       (ver fixnum --> ver))
(: version-inc!         (ver #!optional fixnum number -> ver))
(: version-dec!         (ver #!optional fixnum number -> ver))
(: version-inc          (ver #!optional fixnum number --> ver))
(: version-dec          (ver #!optional fixnum number --> ver))

;;

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

;;

(define (version-extend! ver . comps)
  (let ((vern (apply version-extend (check-version 'version-extend! ver) comps)))
    (ver-parts-set! ver (ver-parts vern))
    (ver-puncs-set! ver (ver-puncs vern)) )
  ver )

(define (version-extend ver . comps)
  (list->version (append! (version->list (check-version 'version-extend ver)) comps)) )

(define (version-depth+! ver cnt #!optional (part 0) (punc (default-punctuation)))
  (check-version 'version-depth+! ver)
  (check-fixnum 'version-depth+! cnt)
  (check-parts 'version-depth+! (list part))
  (check-puncs 'version-depth+! (list punc))
  (ver-parts-set! ver (append! (ver-parts ver) (make-list cnt part)))
  ;need to include leading punct!
  (ver-puncs-set! ver (append! (ver-puncs ver) (make-list cnt punc)))
  ver )

(define (version-depth-! ver cnt)
  (check-version 'version-depth-! ver)
  (check-fixnum 'version-depth-! cnt)
  (cond ((zero? cnt)
          ver )
        ((positive? cnt)
          (let ((puncs (ver-puncs ver)) (parts (ver-parts ver)))
            (unless (<= cnt (length parts))
              (error 'version-depth-! "semantic-version cannot drop such depth" ver cnt) )
            ;be direct when dropping all
            (ver-parts-set! ver (if (= cnt (length parts)) '() (drop-right! parts cnt)))
            ;need to drop leading punctuation
            (ver-puncs-set! ver (if (= cnt (length parts)) '() (drop-right! puncs cnt)))
            ver ) )
        (else
          (error 'version-depth-! "semantic-version cannot drop negative depth" ver cnt)) ) )

(define (version-depth+ ver cnt #!optional (part 0) (punc (default-punctuation)))
  (version-depth+! (copy-ver (check-version 'version-depth+ ver)) cnt part punc) )

(define (version-depth- ver cnt)
  (version-depth-! (copy-ver (check-version 'version-depth- ver)) cnt) )

;FIXME semantic-version API is (unsafe unchecked inline) so cannot use #!optional

(define (version-add! loc ver idx amt)
  (let* ((ls (ver-parts ver))
         (len (length ls))
         (idx (if (not idx) (sub1 len)
                  (check-range loc (check-fixnum loc idx) 0 len)))
         (cel (pair-find-nth integer? idx ls)) )
    (unless cel (error loc "missing integer at or before" idx))
    (set-car! cel (+ (car cel) amt))
    ver ) )

;default is the last component, better be a number!
(define (version-inc! ver #!optional idx (amt 1))
  (version-add! 'version-inc!
                (check-version 'version-inc! ver)
                idx
                (check-number 'version-inc! amt)) )

(define (version-dec! ver #!optional idx (amt 1))
  (version-add! 'version-dec!
                (check-version 'version-dec! ver)
                idx
                (- (check-number 'version-dec! amt))) )

(define (version-inc ver #!optional idx (amt 1))
  (version-add! 'version-inc
                (copy-ver (check-version 'version-inc ver))
                idx
                (check-number 'version-inc amt)) )

(define (version-dec ver #!optional idx (amt 1))
  (version-add! 'version-dec
                (copy-ver (check-version 'version-dec ver))
                idx
                (- (check-number 'version-dec amt))) )

) ;module semantic-version.operation