408 lines
19 KiB
Scheme
408 lines
19 KiB
Scheme
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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))))
|