;;;; semantic-version.schema.scm  -*- Scheme -*-
;;;; Kon Lovett, Apr '21

;; Issues
;;

;; - Version Protocols: major#.minor#[.point#][;fix#[-reason$]]
;;   where <alpha>+ name, <separator> char, [] optional ([] & [...[ ]]), # number & $ string
;;   w/ both otherwise

(module semantic-version.schema

(;export
  string->version-protocol version-protocol->string
  list->version-protocol version-protocol->list
  string->version/protocol
  list->version/protocol)

(import scheme
  utf8
  (chicken base)
  (chicken type)
  (only (srfi 1) list-copy every)
  semantic-version)

;;Types

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

;NOTE symbols are not preserved; the printname is used!
(define-type verpro-part  (or number string symbol))
(define-type verpro-punc  char)
(define-type verpro-parts (list-of verpro-part))
(define-type verpro-puncs (list-of verpro-punc))
(define-type verpro       (struct semantic-version-protocol))

(: list->version-protocol        ((list-of (or verpro-part verpro-punc)) --> verpro))
(: version-protocol->list        (verpro --> (list-of (or verpro-part verpro-punc))))
(: string->version-protocol      (string --> verpro))
(: version-protocol->string      (verpro --> string))
(: list->version/protocol        (verpro (list-of (or ver-part ver-punc)) -> ver))
(: string->version/protocol      (verpro string -> ver))

;;

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

;;

;semantic-version-protocol type

;NOTE symbols are not preserved; the printname is used!
(define (ver-part? x) (or (number? x) (string? x) (symbol? x)))
(define (ver-punc? x) (char? x))

;NOTE symbols are not preserved; the printname is used!
(define (verpro-part? x) (or (number? x) (string? x) (symbol? x)))
(define (verpro-punc? x) (char? x))

(define semantic-version-protocol 'semantic-version-protocol)
(define-record-type-variant semantic-version-protocol (unsafe unchecked inline)
  (make-verpro cs ps)
  verpro?
  (cs verpro-parts)
  (ps verpro-puncs))

(define (make-empty-verpro) (make-verpro '() "")) ;#f ok

(define (verprotyp? x) (and (verpro? x) (list? (verpro-parts x)) (string? (verpro-puncs x))))

(define (copy-verpro v) (make-verpro (list-copy (verpro-parts v)) (string-copy (verpro-puncs v))))

(define (ver-parts? l) (every ver-part? l))
(define (ver-puncs? l) (every ver-punc? l))

(define (verpro-parts? l) (every verpro-part? l))
(define (verpro-puncs? l) (every verpro-punc? l))

(define (badargmsg msg #!optional nam)
  (string-append (or (and nam (->string nam)) "bad argument") " - " msg) )

(define (badargerr loc obj msg #!optional nam)
  (error loc (badargmsg msg nam) obj) )

(define (check-parts loc x #!optional nam)
  (unless (verpro-parts? x) (badargerr loc x "invalid semantic-version-protocol parts" nam))
  x )

(define (check-puncs loc x #!optional nam)
  (unless (verpro-puncs? x) (badargerr loc x "invalid semantic-version-protocol puncs" nam))
  x )

;;

#;
(define ()
  (void) )

;;

;(list-of (or punc part))
;part :: (or name (list name kind))
;punc :: char
;name :: (or string symbol)
;kind :: (or # $ *)

;(list->version-protocol '("major" #) #\. '(minor #) '(#\. (point #)) '(#\; "fix" (#\- (reason $))))
(define (list->version-protocol ls)
  (make-empty-verpro) )

;(version-protocol->list vp1) ;=> (("major" #) #\. ("minor" #) '(#\. ("point" #)) '(#\; ("fix" *) (#\- ("reason" $))))
(define (version-protocol->list verpro)
  '() )

;(define vp1 (string->version-protocol "major#.minor#[.point#][;fix[-reason$]]"))
(define (string->version-protocol str)
	(make-empty-verpro) )

;(version-protocol->string vp1) ;=> "major#.minor#[.point#][;fix[-reason$]]"
(define (version-protocol->string verpro)
	"" )

;(list->version/protocol vp1 '(1 #\. 2 #\. 3 #\; abc #\- because))
(define (list->version/protocol verpro ls)
	(make-version 0) )

;(list->version/protocol vp1 "1.2.3;abc-because")
(define (string->version/protocol verpro str)
	(make-version 0) )

) ;module semantic-version.schema