;;;; 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'?
;;
;; - Lot'sa overhead

(module semantic-version.operation

(;export
  ;
  version-extend!
  version-extend
  ;
  version-depth+!
  version-depth-!
  version-depth+
  version-depth-
  ;
  version-succ! version-pred!
  version-succ version-pred)

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

;;

(: 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-succ! (ver #!optional fixnum fixnum -> ver))
(: version-pred! (ver #!optional fixnum fixnum -> ver))
(: version-succ (ver #!optional fixnum fixnum --> ver))
(: version-pred (ver #!optional fixnum fixnum --> 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 should be successor/predecessor semantics, not +/-

(define (version-component-location loc ver idx pred)
  (let* ((ls (ver-parts ver))
         (len (length ls))
         (idx (if (not idx) (sub1 len)
                  (check-range loc (check-fixnum loc idx 'index) 0 len)))
         (cel (pair-find-nth pred idx ls)) )
    (unless cel (error loc "missing adjustable version component at or before" idx))
    cel ) )

;;

(define (has-version-component-next? x) (->boolean (version-component-next x)))

(define (ver-succ! loc ver idx amt)
  (check-fixnum loc amt 'amount)
  (check-range loc amt 0 most-positive-fixnum 'amount)
  (let ((cel (version-component-location loc ver idx has-version-component-next?)))
    (set! (car cel) (version-component-next (car cel) amt)) )
  ver )

(define (ver-pred! loc ver idx amt)
  (check-fixnum loc amt 'amount)
  (check-range loc amt 0 most-positive-fixnum 'amount)
  (let ((cel (version-component-location loc ver idx has-version-component-next?)))
    (set! (car cel) (version-component-prev (car cel) amt)) )
  ver )

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

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

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

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

) ;module semantic-version.operation