;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gen.scm
;; Copyright (C) 2025 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 (dql dql)
  #:use-module (rx irregex)
  #:use-module (ice-9 pretty-print)
  #:use-module (ice-9 string-fun)
  #:use-module (ice-9 textual-ports)
  #:use-module (srfi srfi-1))

;;Function to generate template from ebuild with variable substitution.
(define-public ebuild-from-tmpl
  (lambda* (vars verbosity #:key
								 (tmpl (string-append (assoc-ref vars 'name) ".tmpl"))
								 ignore-diff)
    ""
    (letrec*
        ((input-port (open-input-file (string-join (list (assoc-ref vars 'repo)
																												 "autogen"
																												 (assoc-ref vars 'category)
																												 (assoc-ref vars 'name)
																												 tmpl)
																									 file-name-separator-string)))
         (data (append (list "# 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)
                                     "]")
                      (car data))
            (if (not (null? (cdr data)))
                (traverse-list pre (1+ no) (cdr data)))))
         (traverse-alist
          (lambda (pre data)
            (for-each (lambda (var)
                        (if (and (string? (car var))
                                 (string? (cdr var)))
                            (replace (if (eq? (string-length pre) 0)
                                         (car var)
                                         (string-append pre
                                                        "."
                                                        (car var)))
                                     (cdr var))
                            (traverse (if (eq? (string-length pre) 0)
                                          (car var)
                                          (string-append pre
                                                         "."
                                                         (car var)))
                                      (cdr var))))
                      data)))
         (traverse (lambda (pre data)
                     (cond ((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))
                           (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))))))
      (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)
																	 (assoc-ref vars "version")))
						 (ebuild-name (lambda (rel)
													(string-append (assoc-ref vars 'name)
																				 "-"
																				 (assoc-ref vars "version")
																				 (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)))))
								(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)
									;;(display "data-diff!!!") (newline)
									(ebuild-name (1+ rel)))
								(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)
							(ebuild-name rel)))))))

;; filter keep components
(define-public ebuild-fkc
  (lambda (vlist-in comps-in)
    ""
    (letrec*
        ((base (lambda (vlist comps)
                 (if (null? comps)
                     (cdr (car vlist))
                     (let ((clist (sort (delete-duplicates
                                         (map (lambda (vers)
                                                (if (null? (car vers))
                                                    -1
                                                    (car (car vers))))
                                              vlist))
                                        <)))
                       (map (lambda (vcomp)
                              (append-map
                               (lambda (sts)
                                   (cond ((string? sts)
                                          (list (list vcomp) sts))
                                         ((null? (car sts))
                                          (append (list vcomp) (cdr sts)))
                                         ((not (list? (car (car sts))))
                                          (list (list (append (list vcomp)
                                                              (car sts))
                                                      (second sts))))
                                         (else
                                          (map (lambda (tst)
                                                 (list (append (list vcomp)
                                                               (car tst))
                                                       (second tst)))
                                               sts))))
                               (base (map (lambda (ver)
                                            (list (if (null? (car ver))
                                                      '()
                                                      (cdr (car ver)))
                                                  (car (cdr ver))))
                                          (filter (lambda (vers)
                                                    (= vcomp
                                                       (if (null? (car vers))
                                                           -1
                                                           (car (car vers)))))
                                                  vlist))
                                     (cdr comps))))
                            (take-right clist
                                        (min (length clist)
                                             ;; 0=all.
                                             (if (zero? (car comps))
                                                 (length clist)
                                                 (car comps))))))))))
      ;;Works, but probably only for 3 components so shit solution.
      (append-map (lambda (vmaj)
                    vmaj)
                  (base vlist-in comps-in)))))

(define default-version-components
  (lambda (version)
    ""
    (map (lambda (component)
           (string->number component))
         (irregex-split #\.
                        (irregex-match-substring
                         (irregex-search '(seq (+ num) (+ (seq "." (+ num))))
                                         version))))))

(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)))
                     (version-components default-version-components)
                     (keep (lambda (version) #f))
                     (drop (lambda (version) #f)))
    ""
    (let* ((vlist (map (lambda (release)
                         (list (version-components (assoc-ref release
                                                              "version"))
                               (assoc-ref release "version")))
                       releases))
           (vlist-filtered
            (append (filter (lambda (vers)
                              (if (keep (second vers)) vers #f))
                            vlist)
                    (filter (lambda (vers)
                              (if (drop (second vers)) #f vers))
                            (ebuild-fkc vlist keep-components)))))
      (filter-map (lambda (rel)
                    (if (any (lambda (vers)
                               (string= (assoc-ref rel "version")
                                        (second vers)))
                             vlist-filtered)
                        (append (list (cons "version-components"
                                            (version-components
                                             (assoc-ref rel
                                                        "version"))))
                                rel)
                        #f))
                  releases))))

(define-public ebuild-cp-man
	(lambda (parms)
		""
		(let* ((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)
																		(assoc-ref parms "version")))
					 (rel-out (last-ebuild-rel folder-out
																		 (assoc-ref parms 'name)
																		 (assoc-ref parms "version")))
					 (ebuild-name (lambda (rel)
													(string-append (assoc-ref parms 'name)
																				 "-"
																				 (assoc-ref parms "version")
																				 (if (< 0 rel)
																						 (string-append "-r"
																														(number->string rel))
																						 "")
																				 ".ebuild"))))
			(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 (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))))
											(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)
												(string-join (list folder-out
																					 (ebuild-name (1+ rel-out)))
																		 file-name-separator-string))
											(if (diff? data-in data-out
																 #:allow (lambda (a b)
																			 (let* ((rx '(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))))
													(let ((output-port (open-output-file
																							(string-join (list folder-out
																																 (ebuild-name rel-out))
																													 file-name-separator-string))))
														(display data-in output-port)
														(close output-port)
														(string-join (list folder-out
																							 (ebuild-name rel-out))
																				 file-name-separator-string))
													#false)))
								#false))
					#false))))

;;Procedure to generate the required ebuild from the given releases.
(define-public ebuild-gen
  (lambda* (parms releases #:key
                 (version-components (lambda (version)
                                       (map (lambda (component)
                                              (string->number component))
                                            (string-split version #\.))))
                 (keep-components (list 1 1 2))
                 (keep (lambda (version) #f))
                 (drop (lambda (version) #f))
                 (template (string-append (assoc-ref parms 'name) ".tmpl"))
                 (post-hook (lambda (ebuild vars)
                              (system* "ebuild"
                                       (string-join (list (assoc-ref parms 'repo)
																													(assoc-ref parms 'category)
																													(assoc-ref parms 'name)
																													ebuild)
																										file-name-separator-string)
                                       "manifest")
															'()))
								 ignore-autogen-diff)
    ""
    (if (>= (assoc-ref parms 'verbosity) verbosity-notice)
        (begin (display "Releases:\n")
               (pretty-print releases)))
    (letrec* ((version-list
               (map (lambda (release)
                      (list (version-components (assoc-ref release "version"))
                            (assoc-ref release "version")))
                    releases))
							(selected-versions (ebuild-fkc version-list keep-components))
							(distfiles '())
							(ebuilds (filter-map
												(lambda (vers)
													(let* ((vars (append (car (filter (lambda (rel)
																															(string= (assoc-ref rel "version")
																																			 (second vers)))
																														releases))
																							 parms))
																 (ebuild-man (ebuild-cp-man vars))
																 (ebuild-created (if (and (not ebuild-man)
																													(not (drop (second vers)))
																													(or (find (lambda (test-vers)
																																			(string= (second test-vers)
																																							 (second vers)))
																																		selected-versions)
																															(keep (second vers))))
																										 (ebuild-from-tmpl
																											vars
																											(assoc-ref parms 'verbosity)
																											#:tmpl template
																											#:ignore-diff ignore-autogen-diff)
																										 ebuild-man)))
														(if ebuild-created
																(set! distfiles
																			(append distfiles
																							(post-hook ebuild-created vars))))
														ebuild-created))
												version-list)))
      (values ebuilds distfiles))))