;;;; 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-depth+!
  version-depth-!
  version-depth+
  version-depth-
  version-extend!
  version-extend
  version-inc! version-dec!
  version-inc version-dec)

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

;;

;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 integer #!optional ver-part ver-punc -> ver))
(: version-depth-!      (ver integer -> ver))
(: version-depth+       (ver integer #!optional ver-part ver-punc --> ver))
(: version-depth-       (ver integer --> ver))
(: version-inc!         (ver #!optional integer number -> ver))
(: version-dec!         (ver #!optional integer number -> ver))
(: version-inc          (ver #!optional integer number --> ver))
(: version-dec          (ver #!optional integer 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-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)
  (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) )

;default is the last component, better be a number!
(define (version-inc! ver #!optional idx (amt 1))
  (check-version 'version-inc! ver)
  (let loop ((idx (or idx (sub1 (length (ver-parts ver))))) (ls (ver-parts ver)))
    (if (positive? idx) (loop (sub1 idx) (cdr ls))
      (begin
        (set-car! ls (+ (car ls) amt))
        ver ) ) ) )

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

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

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

) ;module semantic-version.operation