262 lines
13 KiB
Scheme
262 lines
13 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 (tmpl vars out verbosity)
|
||
|
|
""
|
||
|
|
(letrec*
|
||
|
|
((input-port (open-input-file tmpl))
|
||
|
|
(output-port (open-output-file out))
|
||
|
|
(data (string-split (get-string-all input-port) #\lf))
|
||
|
|
(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))))))
|
||
|
|
(if (irregex-search '(seq (+ "#") (+ space) "-*-" (+ space))
|
||
|
|
(car data))
|
||
|
|
(set! data (cdr data)))
|
||
|
|
(traverse "" vars)
|
||
|
|
(display "# Auto generated from autogen.scm" output-port)
|
||
|
|
(newline output-port)
|
||
|
|
(display (string-join data "\n") output-port)
|
||
|
|
(close output-port)
|
||
|
|
out)))
|
||
|
|
|
||
|
|
(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))))
|
||
|
|
|
||
|
|
;;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-join (list (assoc-ref parms 'repo)
|
||
|
|
"autogen"
|
||
|
|
(assoc-ref parms 'category)
|
||
|
|
(assoc-ref parms 'name)
|
||
|
|
(string-append (assoc-ref parms 'name)
|
||
|
|
".tmpl"))
|
||
|
|
file-name-separator-string))
|
||
|
|
(post-hook (lambda (ebuild-path vars)
|
||
|
|
(system* "ebuild"
|
||
|
|
ebuild-path
|
||
|
|
"manifest"))))
|
||
|
|
""
|
||
|
|
(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)))
|
||
|
|
(let ((selected-versions (ebuild-fkc version-list keep-components)))
|
||
|
|
(filter-map
|
||
|
|
(lambda (vers)
|
||
|
|
(let ((path (string-join (list (assoc-ref parms 'repo)
|
||
|
|
(assoc-ref parms 'category)
|
||
|
|
(assoc-ref parms 'name)
|
||
|
|
(string-append (assoc-ref parms 'name)
|
||
|
|
"-"
|
||
|
|
(second vers)
|
||
|
|
".ebuild"))
|
||
|
|
file-name-separator-string)))
|
||
|
|
(if (and (not (access? path F_OK))
|
||
|
|
(not (drop (second vers)))
|
||
|
|
(or (find (lambda (test-vers)
|
||
|
|
(string= (second test-vers)
|
||
|
|
(second vers)))
|
||
|
|
selected-versions)
|
||
|
|
(keep (second vers))))
|
||
|
|
(let* ((vars (car (filter (lambda (rel)
|
||
|
|
(string= (assoc-ref rel "version")
|
||
|
|
(second vers)))
|
||
|
|
releases)))
|
||
|
|
(ebuild-created (ebuild-from-tmpl
|
||
|
|
template
|
||
|
|
(append vars parms)
|
||
|
|
path
|
||
|
|
(assoc-ref parms 'verbosity))))
|
||
|
|
(post-hook ebuild-created (append parms vars))
|
||
|
|
(append vars
|
||
|
|
(list (cons "ebuild" path))))
|
||
|
|
#f)))
|
||
|
|
version-list)))))
|