;;;; semantic-version.core.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.core

(;export
  ;struct tag; needed by internals
  semantic-version
  ;
  version-punctuation
  ;
  make-version
  version? check-version error-version
  list->version
  version->list
  string->version
  version->string
  version-print)

(import scheme utf8
  (chicken base)
  (chicken type)
  (chicken fixnum)
  (chicken format)
  (only (srfi 1) make-list every reverse! map! drop append! append-map!)
  (only utf8-srfi-13 string-filter string-index)
  (semantic-version components))

(cond-expand
  ((or chicken-5.0 chicken-5.1)
    (define (set-record-printer! tag proc)
      (##sys#register-record-printer tag proc) ) )
  (else) )

;;string-utils

;"..." => string-parts char-puncs
;"a.3,c" => ("a" "3" "c") (#\. #\,)
(define (*string-unzip str punc-str)
  (let ((parts (string-split str punc-str #t))
        (punct (string->list (string-filter (cut string-index punc-str <>) str))) )
    (values parts punct) ) )

;;

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

(: version-punctuation (#!optional string -> string))

(: make-version (fixnum #!optional ver-part ver-punc --> ver))
(: version? (* -> boolean : ver))
(: check-version (symbol ver #!optional (or string symbol) -> ver))
(: error-version (symbol * #!optional (or string symbol) -> void))
(: list->version ((list-of (or ver-part ver-punc)) --> ver))
(: version->list (ver --> (list-of (or ver-part ver-punc))))
(: string->version (string --> ver))
(: version->string (ver --> string))

;;

(define semantic-version 'semantic-version)

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

;;

;"!?@#$%^&*-_+=|/\\;:,. "
;"#$%^&-_+=/\\;:,. "
;"._- +;:,"
(define-constant VERSION-PUNCT "._- +;:,")

(define version-punctuation (make-parameter VERSION-PUNCT))

;;

(define (make-version cnt #!optional (part 0) (punc (default-punctuation)))
  (check-fixnum-range 'make-version cnt 0 most-positive-fixnum)
  (make-ver (make-list cnt (check-part 'make-version part))
            (make-list (fxmax 0 (fx- cnt 1))
                       (check-punc 'make-version punc))) )

(define (version? ver)
  (and (vertyp? ver)
       (let ((parts (ver-parts ver)) (puncs (ver-puncs ver)))
         (or (and (null? puncs) (null? parts))
             (and (fx= (length puncs) (fx- (length parts) 1))
                  (ver-parts? parts)
                  (ver-puncs? puncs) ) ) ) ) )

(define (error-version loc x #!optional nam)
  (badargerr loc x "invalid semantic-version" nam) )

(define (check-version loc x #!optional nam)
  (unless (vertyp? x) (error-version loc x nam))
  (check-parts loc (ver-parts x) nam)
  (check-puncs loc (ver-puncs x) nam)
  x )

(define (*version->list parts puncs)
  (append! (append-map! list parts puncs) (drop parts (length puncs))) )

(define (version->list ver)
  (check-version 'version->list ver)
  (*version->list (ver-parts ver) (ver-puncs ver)) )

(define (list->version ls)
  (let loop ((parts '()) (puncs '()) (ls ls))
    (cond ((null? ls)
            (make-ver (reverse! parts) (reverse! puncs)) )
          ;flip-flop
          ((= (length parts) (length puncs))
            (let ((p (car ls)))
              (unless (ver-part? p) (error 'list->version "invalid version part" p))
              (loop (cons (version-component-literal p) parts) puncs (cdr ls)) ) )
          (else
            (let ((p (car ls)))
              (unless (ver-punc? p) (error 'list->version "invalid version punc" p))
              (loop parts (cons p puncs) (cdr ls))) ) ) ) )

(define (string->version str)
  (let-values (((parts puncs) (*string-unzip (check-string 'string->version str)
                                             (version-punctuation))))
    (make-ver (map! version-component-object parts) puncs) ) )

;FIXME use kind string conversion@

(define (version->string ver)
  (check-version 'version->string ver)
  (apply string-append (*version->list (map version-component-string (ver-parts ver))
                                       (map string (ver-puncs ver)))) )

;; Read/Print Syntax

;NOTE if print == for-each display then bad naming
(define (version-print ver #!optional (out (current-output-port)))
  (format out "#<version ~S>" (version->string ver)) )

;;;

(set-record-printer! semantic-version version-print)

) ;module semantic-version.core