;;;; 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 (verpro-parts? x) (ver-parts? x))
(define (verpro-puncs? x) (string? x))

(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 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)
       (verpro-parts? (verpro-parts x))
       (verpro-puncs? (verpro-puncs x))) )

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

;;

#;
(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