V0.0.3 Nodejs support.

This commit is contained in:
Cor Legemaat 2026-03-30 07:00:06 +02:00
commit 54f494163a
17 changed files with 1871 additions and 484 deletions

View file

@ -1,6 +1,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gen.scm
;; Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
;; 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
@ -17,29 +17,50 @@
(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-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 (string-append (assoc-ref vars 'name) ".tmpl"))
(tmpl #f)
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")
((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)))
(let ((raw (string-split (get-string-all input-port)
#\lf)))
(if (irregex-search '(seq (+ "#")
(+ space)
"-*-"
@ -55,35 +76,54 @@
"["
(number->string no)
"]")
(car data))
(if (null? data) '() (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)))
(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 ((alist? data)
(traverse-alist 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)
@ -103,7 +143,30 @@
(string-replace-substring line
var-str
val))
data))))))
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)
@ -111,154 +174,102 @@
file-name-separator-string))
(rel (last-ebuild-rel folder-out
(assoc-ref vars 'name)
(assoc-ref vars "version")))
(comps->genver (assoc-ref vars
"version-values"))))
(ebuild-name (lambda (rel)
(string-append (assoc-ref vars 'name)
"-"
(assoc-ref vars "version")
(if (< 0 rel)
(string-append "-r"
(number->string rel))
"")
".ebuild"))))
(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)))))
(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)
;;(display "data-diff!!!") (newline)
(ebuild-name (1+ rel)))
(ebuild-name rel))
(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)
(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))))))
(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)))
(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")))
(assoc-ref release "version-values"))
releases))
(vlist-filtered
(append (filter (lambda (vers)
(if (keep (second vers)) vers #f))
(if (keep vers) vers #f))
vlist)
(filter (lambda (vers)
(if (drop (second vers)) #f vers))
(ebuild-fkc vlist keep-components)))))
(semver-keep (filter (lambda (vers)
(if (drop vers) #f vers))
vlist)
keep-components))))
(filter-map (lambda (rel)
(if (any (lambda (vers)
(string= (assoc-ref rel "version")
(second vers)))
(semver-eq? (assoc-ref rel "version-values")
vers))
vlist-filtered)
(append (list (cons "version-components"
(version-components
(assoc-ref rel
"version"))))
rel)
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* ((folder-in (string-join (list (assoc-ref parms 'repo)
(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))
@ -269,19 +280,30 @@
file-name-separator-string))
(rel-in (last-ebuild-rel folder-in
(assoc-ref parms 'name)
(assoc-ref parms "version")))
genver))
(rel-out (last-ebuild-rel folder-out
(assoc-ref parms 'name)
(assoc-ref parms "version")))
genver))
(ebuild-name (lambda (rel)
(string-append (assoc-ref parms 'name)
"-"
(assoc-ref parms "version")
genver
(if (< 0 rel)
(string-append "-r"
(number->string rel))
"")
".ebuild"))))
".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))
@ -302,70 +324,67 @@
(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))))
#: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)
(string-join (list folder-out
(ebuild-name (1+ rel-out)))
file-name-separator-string))
(return (1+ rel-out)))
(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))))
#: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 rel-out))
file-name-separator-string))))
(return rel-out))))
(display data-in output-port)
(close output-port)
(string-join (list folder-out
(ebuild-name rel-out))
file-name-separator-string))
#false)))
#false))
#false))))
(return rel-out))
'())))
'()))
'()))))
(define-public ebuild-default-post
(lambda (ebuilds parms)
;; (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))
(system* "ebuild" (out-file ebuild) "manifest")))))
(cond ((null? ebuilds) '())
((assoc-ref ebuilds 'pkg-files)
(map run-post (assoc-ref ebuilds 'pkgfiles)))
((assoc-ref (car ebuilds) 'pkgfiles)
(map run-post (assoc-ref (car ebuilds) 'pkgfiles))))
ebuilds)))
;;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-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 (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")
'()))
(template #f)
(gen-ebuild-hook ebuild-from-tmpl)
(post-hook ebuild-default-post)
ignore-autogen-diff)
""
(if (>= (assoc-ref parms 'verbosity) verbosity-notice)
@ -373,36 +392,32 @@
(pretty-print releases)))
(letrec* ((version-list
(map (lambda (release)
(list (version-components (assoc-ref release "version"))
(assoc-ref release "version")))
(assoc-ref release "version-values"))
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))))
(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)))
version-list)))
ebuilds)))