;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gen.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 gen)
  #:use-module (ebuild utils)
  #:use-module (ebuild defs)
	#:use-module (ebuild semver)
	#:use-module (ebuild state)
  #:use-module (dql dql)
  #:use-module (rx irregex)
  #:use-module (ice-9 pretty-print)
	#:use-module (ice-9 receive)
  #:use-module (ice-9 string-fun)
  #:use-module (ice-9 textual-ports)
  #:use-module (srfi srfi-1)
	#:use-module (srfi srfi-19))

;;Function to generate template from ebuild with variable substitution.
(define-public ebuild-from-tmpl
  (lambda* (vars verbosity #:key
								 (tmpl #f)
								 ignore-diff)
    ""
    (letrec*
        ((pkg-tmpl (string-join (list (assoc-ref vars 'repo)
																				 "autogen"
																				 (assoc-ref vars 'category)
																				 (assoc-ref vars 'name)
																				 (string-append (assoc-ref vars 'name)
																												".tmpl"))
																file-name-separator-string))
				 (cat-tmpl (string-join (list (assoc-ref vars 'repo)
																			"autogen"
																			(assoc-ref vars 'category)
																			(string-append (assoc-ref vars 'category)
																										 ".tmpl"))
																file-name-separator-string))
				 (input-port (open-input-file
											(cond (tmpl tmpl)
														((file-exists? pkg-tmpl) pkg-tmpl)
														((file-exists? cat-tmpl) cat-tmpl)
														(else
														 (error "No pkg or category template found!")))))
         (data (append (list (string-append
															"# Copyright (C) "
															(number->string (date-year (current-date)))
															" auto generated from autogen.scm"))
											 ;; Remove mode-line of tmpl file.
											 (let ((raw (string-split (get-string-all input-port)
																								#\lf)))
												 (if (irregex-search '(seq (+ "#")
																									 (+ space)
																									 "-*-"
																									 (+ space))
																						 (car raw))
														 (cdr raw)
														 raw))))
         (traverse-list
          (lambda (pre no data)
            (traverse (string-append (if (symbol? pre)
                                         (symbol->string pre)
                                         pre)
                                     "["
                                     (number->string no)
                                     "]")
                      (if (null? data) '() (car data)))
            (if (not (null? (cdr data)))
                (traverse-list pre (1+ no) (cdr data)))))
         (traverse-alist
          (lambda (pre data)
            (if (not (eq? pre 'dep-graph))
								(for-each
								 (lambda (var)
									 (if (and (or (string? (car var))
																(symbol? (car var)))
														(or (string? (cdr var))
																(symbol? (cdr var))))
											 (replace (if (eq? (string-length pre) 0)
																		(if (symbol? (car var))
																				(symbol->string (car var))
																				(car var))
																		(string-append pre
																									 "."
																									 (if (symbol? (car var))
																											 (symbol->string (car var))
																											 (car var))))
																(if (symbol? (cdr var))
																		(symbol->string (cdr var))
																		(cdr var)))
											 (traverse (if (eq? (string-length pre) 0)
																		 (if (symbol? (car var))
																				 (symbol->string (car var))
																				 (car var))
																		 (string-append pre
																										"."
																										(if (symbol? (car var))
																												(symbol->string (car var))
																												(car var))))
																 (cdr var))))
								 data))))
         (traverse (lambda (pre data)
                     (cond ((null? data) '())
													 ((alist? data)
														(traverse-alist pre data))
                           ((list? data)
                            (traverse-list pre 0 data))
                           ((number? data)
                            (replace pre (number->string data)))
                           ((string? data) (replace pre data))
													 ((eqv? #f data) (replace pre "false"))
													 ((eqv? #t data) (replace pre "true"))
                           ((time? data)
                            (replace pre (number->string (time-second data))))
                           (else (error (string-append "Error! Don't know how "
                                                       "to process \""
                                                       (object->string data)
                                                       "\" data type."))))))
         (replace
          (lambda (var val)
            (let ((var-str (string-append "{{"
                                          (if (symbol? var)
                                              (symbol->string var)
                                              var)
                                          "}}")))
              (if (>= verbosity verbosity-info)
                  (begin (display "Replacing \"") (display var-str)
                         (display "\" with \"") (display val)
                         (display "\"") (newline)))
              (set! data (map (lambda (line)
                                (string-replace-substring line
                                                          var-str
                                                          val))
                              data)))))
				 (final-ebuild
					(lambda (ebuild)
						(state-write (state-set
													(state-load (assoc-ref vars 'repo)
																			(assoc-ref vars 'category)
																			(assoc-ref vars 'name))
													(assoc-ref vars 'constraint)
													ebuild
													(comps->genver (assoc-ref vars "version-values"))
													'())
												 (assoc-ref vars 'repo)
												 (assoc-ref vars 'category)
												 (assoc-ref vars 'name))
            (list (list (cons 'category (assoc-ref vars 'category))
												(cons 'name (assoc-ref vars 'name))
												(cons 'pkgfiles
															(append (if (assoc-ref vars 'pkgfiles)
																					(assoc-ref vars 'pkgfiles)
																					'())
																			(list ebuild)))
												(cons 'distfiles (if (assoc-ref vars 'distfiles)
																						 (assoc-ref vars 'distfiles)
																						 '())))))))
      (traverse "" vars)
			(let* ((folder-out (string-join (list (assoc-ref vars 'repo)
																						(assoc-ref vars 'category)
																						(assoc-ref vars 'name))
																			file-name-separator-string))
						 (rel (last-ebuild-rel folder-out
																	 (assoc-ref vars 'name)
																	 (comps->genver (assoc-ref vars
																														 "version-values"))))
						 (ebuild-name (lambda (rel)
														(string-append
														 (assoc-ref vars 'name)
														 "-"
														 (comps->genver (assoc-ref vars "version-values"))
														 (if (< 0 rel)
																 (string-append "-r"
																								(number->string rel))
																 "")
														 ".ebuild"))))
				(if (file-exists? (string-join (list folder-out
																						 (ebuild-name rel))
																			 file-name-separator-string))
						(if (and (not ignore-diff)
										 (diff? data
														(let* ((port-ebuild
																		(open-input-file
																		 (string-join (list folder-out
																												(ebuild-name rel))
																									file-name-separator-string)))
																	 (data-ebuild (get-string-all port-ebuild)))
															(close port-ebuild)
															(string-split data-ebuild #\newline))
														#:allow (lambda (a b)
																			(let* ((rx '(seq bos "#"))
																						 (match-a (irregex-search rx a))
																						 (match-b (irregex-search rx b)))
																				(if (and match-a match-b)
																						#false #true)))
														#:print-delta (>= verbosity verbosity-info)))
								;; Data the same.
								(let ((output-port (open-output-file
																		(string-join (list folder-out
																											 (ebuild-name (1+ rel)))
																								 file-name-separator-string))))
									(display (string-join data "\n") output-port)
									(close output-port)
									(final-ebuild (ebuild-name (1+ rel))))
								;; Data differs.
								(final-ebuild (ebuild-name rel)))
						(let ((output-port (open-output-file
																(string-join (list folder-out
																									 (ebuild-name rel))
																						 file-name-separator-string))))
							(display (string-join data "\n") output-port)
							(close output-port)
							(final-ebuild (ebuild-name rel))))))))

(define-public ebuild-version-filter
  (lambda* (releases #:key
                     (keep-components (if (assoc-ref releases 'keep-vers-comps)
                                          (assoc-ref releases 'keep-vers-comps)
                                          (list 1 1 1)))
                     (keep (lambda (version) #f))
                     (drop (lambda (version) #f)))
    ""
    (let* ((vlist (map (lambda (release)
												 (assoc-ref release "version-values"))
                       releases))
           (vlist-filtered
            (append (filter (lambda (vers)
                              (if (keep vers) vers #f))
                            vlist)
                    (semver-keep (filter (lambda (vers)
																					 (if (drop vers) #f vers))
																				 vlist)
																 keep-components))))
      (filter-map (lambda (rel)
                    (if (any (lambda (vers)
															 (semver-eq? (assoc-ref rel "version-values")
																					 vers))
                             vlist-filtered)
												rel
                        #f))
                  releases))))

(define allow-keyword-comment-diff
	(lambda (a b)
		(let* ((rx '(or (seq bos "#")
										(seq bos
												 "KEYWORDS=\""
												 (+ (or alphanumeric whitespace #\- #\~))
												 "\""
												 eos)))
					 (match-a (irregex-search rx a))
					 (match-b (irregex-search rx b)))
			(if (and match-a match-b)
					#false #true))))

(define-public ebuild-cp-man
	(lambda (parms)
		""
		(let* ((genver (comps->genver (assoc-ref parms "version-values")))
					 (folder-in (string-join (list (assoc-ref parms 'repo)
																				 "autogen"
																				 (assoc-ref parms 'category)
																				 (assoc-ref parms 'name))
																	 file-name-separator-string))
					 (folder-out (string-join (list (assoc-ref parms 'repo)
																					(assoc-ref parms 'category)
																					(assoc-ref parms 'name))
																		file-name-separator-string))
					 (rel-in (last-ebuild-rel folder-in
																		(assoc-ref parms 'name)
																		genver))
					 (rel-out (last-ebuild-rel folder-out
																		 (assoc-ref parms 'name)
																		 genver))
					 (ebuild-name (lambda (rel)
													(string-append (assoc-ref parms 'name)
																				 "-"
																				 genver
																				 (if (< 0 rel)
																						 (string-append "-r"
																														(number->string rel))
																						 "")
																				 ".ebuild")))
					 (return (lambda (rel)
										 (list (list (cons 'category (assoc-ref parms 'category))
																 (cons 'name (assoc-ref parms 'name))
																 (cons 'pkgfiles
																			 (append (if (assoc-ref parms 'pkgfiles)
																									 (assoc-ref parms 'pkgfiles)
																									 '())
																							 (list (ebuild-name rel))))
																 (cons 'distfiles (if (assoc-ref parms 'distfiles)
																											(assoc-ref parms 'distfiles)
																											'())))))))
			(if rel-in
					(let ((path-in (string-join (list folder-in
																						(ebuild-name rel-in))
																			file-name-separator-string))
								(path-out (string-join (list folder-out
																						 (ebuild-name rel-out))
																			 file-name-separator-string)))
						(if (and (< 0 rel-in)
										 (< verbosity-warn (assoc-ref parms 'verbosity)))
								(begin (display "Warning: Source ebuild should not have ")
											 (display "revisions, handled automatically!")
											 (newline)))
						(if (file-exists? path-in)
								(let* ((port-in (open-input-file path-in))
											 (port-out (open-input-file path-out))
											 (data-in (get-string-all port-in))
											 (data-out (get-string-all port-out)))
									(close port-in)
									(close port-out)
									(if (diff? data-in data-out
														 #:allow allow-keyword-comment-diff
														 #:print-delta (>= (assoc-ref parms "verbosity")
																							 verbosity-info))
											(let ((output-port
														 (open-output-file
															(string-join (list folder-out
																								 (ebuild-name (1+ rel-out)))
																					 file-name-separator-string))))
												(display data-in output-port)
												(close output-port)
												(return (1+ rel-out)))
											(if (diff? data-in data-out
																 #:allow allow-keyword-comment-diff
																 #:print-delta (>= (assoc-ref parms "verbosity")
																									 verbosity-info))
													(let ((output-port (open-output-file
																							(return rel-out))))
														(display data-in output-port)
														(close output-port)
														(return rel-out))
													'())))
								'()))
					'()))))

(define-public ebuild-default-post-ebuild
	(lambda (ebuild parms)
		(system* "ebuild" ebuild "manifest")
		'()))

(define-public ebuild-default-post
	(lambda* (ebuilds parms
										#:key (ebuild-callback ebuild-default-post-ebuild))
    ;; (display "parms:") (newline)
    ;; (pretty-print parms)
    ;; (display "ebuild-created:") (newline)
    ;; (pretty-print ebuilds)
    (let* ((out-file (lambda (ebuild)
														(string-join (list (assoc-ref parms 'repo)
																							 (assoc-ref parms 'category)
																							 (assoc-ref parms 'name)
																							 ebuild)
																				 file-name-separator-string)))
          (run-post (lambda (ebuild)
									 (if (not (file-exists? (out-file ebuild)))
											 (error (string-append "Ebuild \""
																						 (out-file ebuild)
																						 "\" does not exists!!!")))
									 (if (string-suffix? ".ebuild" (out-file ebuild))
											 (ebuild-callback (out-file ebuild) parms)
											 '()))))
      (cond ((null? ebuilds) '())
						((assoc-ref ebuilds 'pkg-files)
						 (assoc-set! ebuilds
												 'distfiles
												 (append (append-map run-post
																						 (assoc-ref ebuilds 'pkgfiles))
																 (assoc-ref ebuilds 'distfiles))))
						((assoc-ref (car ebuilds) 'pkgfiles)
						 (cons (assoc-set! (car ebuilds)
															 'distfiles
															 (append (append-map run-post
																									 (assoc-ref (car ebuilds)
																															'pkgfiles))
																			 (assoc-ref (car ebuilds) 'distfiles)))
									 (cdr ebuilds)))))))

;;Procedure to generate the required ebuild from the given releases.
(define-public ebuild-gen
  (lambda* (parms releases #:key
									(keep-components (if (assoc-ref parms 'keep-vers-comps)
                                       (assoc-ref parms 'keep-vers-comps)
                                       (list 1 1 1)))
                 (keep (lambda (version) #f))
                 (drop (lambda (version) #f))
                 (template #f)
								 (gen-ebuild-hook ebuild-from-tmpl)
                 (post-hook ebuild-default-post)
								 (post-ebuild-hook ebuild-default-post-ebuild)
								 ignore-autogen-diff)
    ""
    (if (>= (assoc-ref parms 'verbosity) verbosity-notice)
        (begin (display "Releases:\n")
               (pretty-print releases)))
    (letrec* ((version-list
               (map (lambda (release)
											(assoc-ref release "version-values"))
                    releases))
							(selected-versions (semver-keep version-list keep-components))
							(ebuilds (append-map (lambda (vers)
																		 (let* ((vars (append
																									 (car (filter
																												 (lambda (rel)
																													 (equal? (assoc-ref rel
																																							"version-values")
																																	 vers))
																												 releases))
																									 parms))
																						(ebuild-man (ebuild-cp-man vars))
																						(ebuild-created
																						 (if (and (null? ebuild-man)
																											(not (drop vers))
																											(or (find
																													 (lambda (test-vers)
																														 (semver-eq? test-vers vers))
																													 selected-versions)
																													(keep vers)))
																								 (gen-ebuild-hook vars
																																	(assoc-ref parms 'verbosity)
																																	#:tmpl template
																																	#:ignore-diff ignore-autogen-diff)
																								 ebuild-man)))
																			 (post-hook ebuild-created vars
																									#:ebuild-callback post-ebuild-hook)))
																	 version-list)))
      ebuilds)))