;;;; 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
  ;
  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 format)
  (only (chicken string) ->string)
  (only (srfi 1) make-list every reverse! map! drop append! append-map!)
  (only utf8-srfi-13 string-filter string-index))

;;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         (integer #!optional ver-part ver-punc --> ver))
(: version?             (* -> boolean : ver))
(: check-version        (symbol * #!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))

;;

(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-parts 'make-version (list part))
  (check-puncs 'make-version (list punc))
  (make-ver (make-list cnt part) (make-list (min 0 (sub1 cnt)) punc)) )

(define (version? ver)
  (and
    (vertyp? ver)
    (let ((parts (ver-parts ver)) (puncs (ver-puncs ver)))
      (or
        (and (null? puncs) (null? parts))
        (and
          (= (length puncs) (sub1 (length parts)))
          (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 ver)
  (check-version 'version->list ver)
  (let ((puncs (ver-puncs ver)) (parts (ver-parts ver)))
    (append! (append-map! list parts puncs) (drop parts (length puncs))) ) )

(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)))
          (if (ver-part? p)
            (loop (cons (canon-list-elm p) parts) puncs (cdr ls))
            (error 'list->version "invalid version part" p)) ) )
      (else
        (let ((p (car ls)))
          (if (ver-punc? p)
            (loop parts (cons p puncs) (cdr ls))
            (error 'list->version "invalid version punc" p)) ) ) ) ) )

(define (string->version str)
  (let-values (((parts puncs) (*string-unzip str (version-punctuation))))
    (make-ver (map! canon-string-elm parts) puncs) ) )

(define (version->string ver)
  (apply string-append (map! ->string (version->list (check-version 'version->string 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