;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; state.scm
;; Copyright (C) 2025, 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 state)
  #:use-module (ebuild defs)
  #:use-module (ebuild utils)
  #:use-module (ice-9 pretty-print)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
	#:use-module (srfi srfi-19)
  #:use-module (srfi srfi-43)
  #:use-module (rx irregex)
  #:use-module (dql dql))

(define-public state-load
	(lambda (repo category name)
		""
		(let ((path (string-join (list repo
																	 category
																	 name
																	 ".state.aldb")
														 file-name-separator-string)))
			(if (file-exists? path)
					(dql-read path)
					'()))))

(define-public state-set
	(lambda (db constraint ebuild version distfiles)
		""
		(if (not (null? (state-get db constraint)))
				((dql (alter (where (lambda (pkg-constraint)
															(or (and (not constraint)
																			 (not pkg-constraint))
																	(equal? pkg-constraint constraint)))
														'constraint)
										 (update 'constraint constraint)
										 (update 'date (date->string (current-date)))
										 (update 'ebuild ebuild)
										 (update 'version version)
										 (update 'distfiles distfiles))
							;;#:print-query state-set
							)
				 db)
				(append db (list (list (cons 'constraint constraint)
															 (cons 'date (date->string (current-date)))
															 (cons 'ebuild ebuild)
															 (cons 'version version)
															 (cons 'distfiles distfiles)))))))

(define-public state-get
	(lambda (db constraint)
		""
		;;(display "constraint=") (display constraint) (newline)
		(let ((answ ((dql (select (filter (where (lambda (pkg-constraint)
																							 (or (and (not constraint)
																												(not pkg-constraint))
																									 (equal? pkg-constraint constraint)))
																						 'constraint))
															(parm 'date)
															(parm 'ebuild)
															(parm 'version)
															(parm 'distfiles))
											;;#:print-query state-get
											)
								 db)))
			;; (display "state-answ") (newline)
			;; (pretty-print answ)
			(if (not (nil? answ))
					(let ((date (string->date (assoc-ref (car answ) 'date)
																		"~a ~b ~d ~H:~M:~S~z ~Y")))
						(assoc-set! (append (alist-copy (car answ))
																(list (cons 'age
																						(time-difference
																						 (current-time)
																						 (date->time-utc date)))))
												'date
												date))
					answ))))

(define-public state-write
	(lambda (db repo category name)
		""
		(dql-write db
							 (string-join (list repo
																	category
																	name
																	".state.aldb")
														file-name-separator-string))))