;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; semver.scm
;; Copyright (C) 2026 Cor Legemaat <cor@cor.za.net>
;;
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published by the
;; Free Software Foundation, version 3 of the License.
;;
;; ebuild-autogen is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
;; more details.
;;
;; You should have received a copy of the GNU General Public License along with
;; ebuild-autogen. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (ebuild semver)
	#:use-module (rx irregex)
	#:use-module (ice-9 pretty-print)
	#:use-module (srfi srfi-1)
  #:use-module (srfi srfi-13)
	#:use-module (rnrs sorting))

;; https://semver.org/

(define-public semver->irregex-match
	(lambda (version)
		""
		(irregex-search
     '(seq (+ (or "." bos) (+ num))
					 (? (seq "-" (+ alphanum) (* "." (+ num))))
					 (look-ahead (or (seq "+" (+ (or alphanum "-")) eos)
													 (seq (+ space) eos)
													 eos)))
		 ;; Strip leading spaces.
     (if (string=? version "")
				 version
				 (substring version
										(string-skip version #\space))))))

;;TODO make match keyworded parm to use value from fetch and skip an regex
;; per release.
(define-public semver->comps
	(lambda* (version #:key (vers-match (semver->irregex-match version)))
		""
		(if vers-match
				(filter-map (lambda (component)
											(cond ((string=? component "") #f)
														((string=? component "p") -1)
														((string=? component "rc") -2)
														((string=? component "pre") -3)
														((string=? component "beta") -4)
														((string=? component "alpha") -5)
														((not (string-every char-numeric? component))
														 component)
														(else (string->number component))))
										(irregex-extract '(or (seq (look-behind (or bos "."))
																							 (+ num))
																					(seq (look-behind "-")
																							 (+ alphanum)))
																		 (irregex-match-substring vers-match)))
				'())))

(define-public comps->semver
	(lambda* (comps)
		""
		(string-drop
		 (string-join (map (lambda (comp)
												 (case comp
													 ((-1) "-p")
													 ((-2) "-rc")
													 ((-3) "-pre")
													 ((-4) "-beta")
													 ((-5) "-alpha")
													 (else (string-append "."
																								(if (string? comp)
																										comp
																										(number->string comp))))))
											 comps)
									"")
		 1)))

(define-public comps->genver
	(lambda* (comps #:key (comp-prefix ""))
		""
		(if (or (null? comps)
						(string? (car comps)))
				""
				(string-append
				 (if (and (number? (car comps))
									(negative? (car comps)))
						 ""
						 comp-prefix)
				 (case (car comps)
					 ((-1) "_p")
					 ((-2) "_rc")
					 ((-3) "_pre")
					 ((-4) "_beta")
					 ((-5) "_alpha")
					 (else (if (number? (car comps))
										 (number->string (car comps))
										 "")))
				 (comps->genver  (if (or (not (negative? (car comps)))
																 (null? (cdr comps)))
														 (cdr comps)
														 (if (and (number? (cadr comps))
																			(positive? (cadr comps)))
																 (list (cadr comps))
																 '()))
												 #:comp-prefix (if (negative? (car comps))
																					 ""
																					 "."))))))

(define-public semver-keep
	(lambda* (versions keep #:key
										 (current-path '()))
		""
		(let* ((unique-comps (delete-duplicates (map (lambda (rel)
																									(if (null? rel)
																											0
																											(car rel)))
																								versions)))
					 (my-quant (if (null? keep) 1 (car keep)))
					 (my-values (if (> (length unique-comps) my-quant)
													(take (list-sort
																 (lambda (a b)
																	 (cond ((and (string? a) (number? b)) #f)
																				 ((and (number? a) (string? b)) #t)
																				 ((and (string? a) (string? b))
																					(string> a b))
																				 (else (> a b)))) unique-comps)
																my-quant)
													unique-comps)))
			(if (every null? versions)
					(list current-path)
					(append-map
					 (lambda (comp)
						 (semver-keep (filter-map (lambda (rel)
																				(if (eq? (if (null? rel) 0 (car rel))
																								 comp)
																						(if (null? rel) '() (cdr rel))
																						#f))
																			versions)
													(if (null? keep)
															'()
															(cdr keep))
													#:current-path (append current-path (list comp))))
					 my-values)))))

(define-public semver-stable?
	(lambda (vers)
		""
		(every (lambda (comp)
						 (and (number? comp)
									(not (negative? comp))))
					 vers)))

(define-public semver-eq?
	(lambda* (ref test #:key (cc (length ref)))
		""
		(let ((ref-val (if (null? ref) 0 (car ref)))
					(test-val (if (null? test) 0 (car test))))
			(cond ((and (null? ref) (null? test)) #t)
									((and (positive? cc)
												(not (eqv? ref-val test-val)))
									 #f)
									((zero? cc) #t)
									((and (string? ref-val) (number? test-val)) #f)
									((and (number? ref-val) (string? test-val)) #t)
									((and (string? ref-val)
												(string? test-val)
												(not (string=? ref-val test-val)))
									 #f)
									(else (semver-eq? (if (null? ref) '() (cdr ref))
																		(if (null? test) '() (cdr test))
																		#:cc (if (positive? cc)
																						 (1- cc)
																						 0)))))))

(define-public semver-less?
	(lambda* (ref test #:key (cc 0))
		""
		(let ((ref-val (if (null? ref) 0 (car ref)))
					(test-val (if (null? test) 0 (car test))))
			(cond ((and (null? ref) (null? test)) #f)
					 ((and (positive? cc)
								 (not (eqv? ref-val test-val)))
						#f)
					 ((and (number? ref-val)
								 (number? test-val)
								 (< ref-val test-val)) #t)
					 ((and (number? ref-val)
								 (number? test-val)
								 (> ref-val test-val)) #f)
					 ((and (string? ref-val) (number? test-val)) #t)
					 ((and (string? ref-val)
								 (string? test-val)
								 (string<? ref-val test-val)) #t)
					 (else (semver-less? (if (null? ref) '() (cdr ref))
															 (if (null? test) '() (cdr test))
															 #:cc (if (positive? cc)
																				(1- cc)
																				0)))))))

(define-public semver-leq?
	(lambda* (ref test #:key (cc 0))
		""
		(let ((ref-val (if (null? ref) 0 (car ref)))
					(test-val (if (null? test) 0 (car test))))
			(cond ((and (null? ref) (null? test)) #t)
					 ((and (positive? cc)
								 (not (eqv? ref-val test-val)))
						#f)
					 ((and (number? ref-val)
								 (number? test-val)
								 (< ref-val test-val)) #t)
					 ((and (number? ref-val)
								 (number? test-val)
								 (> ref-val test-val)) #f)
					 ((and (string? ref-val) (number? test-val)) #t)
					 ((and (string? ref-val)
								 (string? test-val)
								 (string<=? ref-val test-val)) #t)
					 (else (semver-leq? (if (null? ref) '() (cdr ref))
															 (if (null? test) '() (cdr test))
															 #:cc (if (positive? cc)
																				(1- cc)
																				0)))))))

(define-public semver-gr?
	(lambda* (ref test #:key (cc 0))
		""
		(let ((ref-val (if (null? ref) 0 (car ref)))
					(test-val (if (null? test) 0 (car test))))
			(cond ((and (null? ref) (null? test)) #f)
						((and (positive? cc)
									(not (eqv? ref-val test-val)))
						 #f)
						((and (number? ref-val)
									(number? test-val)
									(> ref-val test-val)) #t)
						((and (number? ref-val)
									(number? test-val)
									(< ref-val test-val)) #f)
						((and (number? ref-val) (string? test-val)) #t)
						((and (string? ref-val)
									(string? test-val)
									(string>? ref-val test-val)) #t)
						(else (semver-gr? (if (null? ref) '() (cdr ref))
															(if (null? test) '() (cdr test))
															#:cc (if (positive? cc)
																			 (1- cc)
																			 0)))))))

(define-public semver-geq?
	(lambda* (ref test #:key (cc 0))
		""
		(let ((ref-val (if (null? ref) 0 (car ref)))
					(test-val (if (null? test) 0 (car test))))
			(cond ((and (null? ref) (null? test)) #t)
					 ((and (positive? cc)
								 (not (eqv? ref-val
														test-val)))
						#f)
					 ((and (number? ref-val)
								 (number? test-val)
								 (> ref-val test-val)) #t)
					 ((and (number? ref-val)
								 (number? test-val)
								 (< ref-val test-val)) #f)
					 ((and (number? ref-val) (string? test-val)) #t)
					 ((and (string? ref-val)
								 (string? test-val)
								 (string>=? ref-val test-val)) #t)
					 (else (semver-geq? (if (null? ref) '() (cdr ref))
															 (if (null? test) '() (cdr test))
															 #:cc (if (positive? cc)
																				(1- cc)
																				0)))))))

(define-public semver-constrain
	(lambda* (releases constraints #:key
										 (allow-unfiletered #f)
										 (prefer-stable-only #t))
		""
		(let* ((releases-usable
					 (filter-map
						(lambda (rel)
							(if (every (lambda (const)
													 (cond ((and (null? (assoc-ref const 'type))
																			 (eq? (assoc-ref const 'slot-level) 0))
																	#t)
																 ((eq? (assoc-ref const 'type) '=)
																	(semver-eq? (assoc-ref rel "version-values")
																							(assoc-ref const 'components)
																							#:cc (assoc-ref const 'slot-level)))
																 ((eq? (assoc-ref const 'type) '<=)
																	(semver-geq? (assoc-ref rel "version-values")
																							 (assoc-ref const 'components)))
																 ((eq? (assoc-ref const 'type) '<=)
																	(semver-leq? (assoc-ref rel "version-values")
																							 (assoc-ref const 'components)))
																 ((eq? (assoc-ref const 'type) '>)
																	(semver-gr? (assoc-ref rel "version-values")
																							(assoc-ref const 'components)))
																 ((eq? (assoc-ref const 'type) '<)
																	(semver-less? (assoc-ref rel "version-values")
																								(assoc-ref const 'components)))
																 (else #f)))
												 constraints)
									rel #f))
						releases))
					 (releases-stable
						(filter-map (lambda (rel)
													(if (semver-stable? (assoc-ref rel "version-values"))
															rel #f))
												releases-usable))
					 (answ (sort (if (or (null? releases-stable)
															 (not prefer-stable-only))
														 (if (null? releases-usable)
																 (if (or (null? releases)
																				 (not allow-unfiletered))
																		 '()
																		 releases)
																 releases-usable)
														 releases-stable)
												 (lambda (a b)
													 (semver-gr? (assoc-ref a "version-values")
																			 (assoc-ref b "version-values"))))))
			;; (display "all-releases:") (newline) (pretty-print releases)
			;; (display "releases:") (newline) (pretty-print releases-usable)
			;; (display "stable-releases:") (newline) (pretty-print releases-stable)
			;; (display "ret:") (newline) (pretty-print answ)
			answ)))