371 lines
14 KiB
Scheme
371 lines
14 KiB
Scheme
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; nodejs.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 nodejs)
|
|
#:use-module (ebuild utils)
|
|
#:use-module (ebuild defs)
|
|
#:use-module (ebuild gen)
|
|
#:use-module (ebuild pkt-map)
|
|
#:use-module (ebuild state)
|
|
#:use-module (ebuild repo)
|
|
#:use-module (ebuild semver)
|
|
#:use-module (ebuild fetchers npmjs)
|
|
#: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))
|
|
|
|
(define get-constraints
|
|
(lambda (spec)
|
|
""
|
|
(let ((raw (irregex-extract '(seq (or bos (look-behind space))
|
|
(? (or "^" "~" "*" "<" ">" "="
|
|
">=" "<=" "=="))
|
|
(* space)
|
|
(+ num)
|
|
(* (seq "." (+ num)))
|
|
(? (seq "-" (+ alphanum) (* "." (+ num)))))
|
|
spec)))
|
|
;; Return method, slot depth, comps
|
|
(map (lambda (const)
|
|
(cond ((string-prefix? "^" const)
|
|
;; Major match minor and patch higher than.
|
|
(list (cons 'type '=)
|
|
(cons 'slot-level 1)
|
|
(cons 'components
|
|
(take (semver->comps (string-drop const 1)) 1))))
|
|
((string-prefix? "~" const)
|
|
;; Major and minor match, patch higher than.
|
|
(list (cons 'type '=)
|
|
(cons 'slot-level 2)
|
|
(cons 'components
|
|
(take (semver->comps (string-drop const 1)) 2))))
|
|
((string-prefix? "*" const)
|
|
;; Any version.
|
|
(list (cons 'type '())
|
|
(cons 'slot-level 0)
|
|
(cons 'components '())))
|
|
((string-prefix? ">=" const)
|
|
;; Newer then.
|
|
(list (cons 'type '>=)
|
|
(cons 'slot-level 0)
|
|
(cons 'components
|
|
(semver->comps (string-drop const 2)))))
|
|
((string-prefix? "<=" const)
|
|
;; Newer then.
|
|
(list (cons 'type '<=)
|
|
(cons 'slot-level 0)
|
|
(cons 'components
|
|
(semver->comps (string-drop const 2)))))
|
|
((string-prefix? "<" const)
|
|
;; Newer then.
|
|
(list (cons 'type '<)
|
|
(cons 'slot-level 0)
|
|
(cons 'components
|
|
(semver->comps (string-drop const 1)))))
|
|
((string-prefix? ">" const)
|
|
;; Newer then.
|
|
(list (cons 'type '>)
|
|
(cons 'slot-level 0)
|
|
(cons 'components
|
|
(semver->comps (string-drop const 1)))))
|
|
((string-prefix? "=" const)
|
|
;; Newer then.
|
|
(list (cons 'type '=)
|
|
(cons 'slot-level
|
|
(length (semver->comps (string-drop const 1))))
|
|
(cons 'components
|
|
(semver->comps (string-drop const 1)))))
|
|
(else
|
|
;; Exact version.
|
|
(list (cons 'type '=)
|
|
(cons 'slot-level
|
|
(length (semver->comps const)))
|
|
(cons 'components (semver->comps const))))))
|
|
raw))))
|
|
|
|
(define replace-npm-folder
|
|
(lambda (npm-name)
|
|
""
|
|
(let ((folder-match (irregex-search `(seq (look-behind (seq bos "@"))
|
|
(+ (or alphanum #\- #\_ #\.))
|
|
(look-ahead "/"))
|
|
npm-name)))
|
|
(if folder-match
|
|
(irregex-replace `(seq bos "@" (+ (or alphanum #\- #\_ #\.)) "/")
|
|
npm-name
|
|
(string-append (irregex-match-substring folder-match)
|
|
"+"))
|
|
npm-name))))
|
|
|
|
(define setup-nodejs-dep
|
|
(lambda (dep parms pkt-map-db)
|
|
""
|
|
(if (>= (assoc-ref parms 'verbosity) verbosity-warn)
|
|
(begin (display "dep:") (newline)
|
|
(pretty-print dep)))
|
|
(let* ((nodejs-ebuilds '())
|
|
(last-release-comps '())
|
|
(dep-vers (assoc-ref dep "version"))
|
|
(constraints (get-constraints dep-vers))
|
|
(dep-name (irregex-replace/all
|
|
'(seq #\- (look-ahead num))
|
|
(irregex-replace/all #\.
|
|
(replace-npm-folder
|
|
(assoc-ref dep "pkg"))
|
|
"-dot-")
|
|
"-num"))
|
|
(pkt-map (let ((answ (pkt-map-get pkt-map-db
|
|
(assoc-ref dep "pkg"))))
|
|
(if (null? answ)
|
|
#f
|
|
(car answ))))
|
|
(dep-mod (if pkt-map
|
|
(begin (setup-pkg
|
|
(list (assoc 'repo parms)
|
|
(assoc 'verbosity parms)
|
|
(assoc 'category pkt-map)
|
|
(cons 'name (assoc-ref pkt-map 'pkg))))
|
|
(resolve-module
|
|
`(,(string->symbol (assoc-ref pkt-map 'category))
|
|
,(string->symbol (assoc-ref pkt-map 'pkg))
|
|
autogen)))
|
|
(begin (setup-pkg
|
|
(list (assoc 'repo parms)
|
|
(assoc 'verbosity parms)
|
|
(cons 'category "dev-nodejs")
|
|
(cons 'name dep-name)))
|
|
(resolve-module
|
|
`(,(string->symbol "dev-nodejs")
|
|
,(string->symbol dep-name)
|
|
autogen)))))
|
|
(dep-parms (let ((answ (alist-copy parms))
|
|
(dep-graph (assoc-ref parms 'dep-graph)))
|
|
(set! answ (assoc-set! answ
|
|
'category
|
|
(if pkt-map
|
|
(assoc-ref pkt-map 'category)
|
|
"dev-nodejs")))
|
|
(set! answ (assoc-set! answ
|
|
'name
|
|
(if pkt-map
|
|
(assoc-ref pkt-map 'pkg)
|
|
dep-name)))
|
|
(set! answ (assoc-set! answ
|
|
'constraint
|
|
constraints))
|
|
(set! answ
|
|
(assoc-set! answ
|
|
'dep-graph
|
|
(if dep-graph
|
|
(append dep-graph
|
|
(list (cons (assoc-ref answ
|
|
'name)
|
|
constraints)))
|
|
(list (cons (assoc-ref parms 'name)
|
|
'())
|
|
(cons (assoc-ref answ 'name)
|
|
constraints)))))
|
|
(set! answ (assoc-set! answ
|
|
'npm-name
|
|
(assoc-ref dep "pkg")))
|
|
(set! answ (assoc-remove! answ "dependencies"))
|
|
(set! answ (assoc-remove! answ "version"))
|
|
(set! answ (assoc-remove! answ "version-values"))
|
|
(set! answ (assoc-remove! answ 'pkgfiles))
|
|
(set! answ (assoc-remove! answ "assets"))
|
|
(set! answ (assoc-remove! answ "npm-name"))
|
|
(set! answ (assoc-remove! answ "homepage"))
|
|
(set! answ (assoc-remove! answ "description"))
|
|
(set! answ (assoc-remove! answ "license"))
|
|
(set! answ (assoc-remove! answ "node"))
|
|
(set! answ (assoc-remove! answ "npm"))
|
|
(if (>= (assoc-ref parms 'verbosity) verbosity-warn)
|
|
(begin (display "dep-vars:") (newline)
|
|
(pretty-print answ)))
|
|
answ))
|
|
(state-db (state-load (assoc-ref dep-parms 'repo)
|
|
(assoc-ref dep-parms 'category)
|
|
(assoc-ref dep-parms 'name)))
|
|
(dep-state (state-get state-db constraints)))
|
|
(if (>= (assoc-ref parms 'verbosity) verbosity-warn)
|
|
(begin (display "dep-state:") (newline)
|
|
(pretty-print dep-state)))
|
|
(if (and (or (nil? dep-state)
|
|
(time<? (date->time-utc (assoc-ref dep-state 'date))
|
|
(assoc-ref parms 'age-limit)))
|
|
(not (member (cons (assoc-ref dep-parms 'name) ;; recursive dep.
|
|
constraints)
|
|
(if (assoc-ref parms 'dep-graph)
|
|
(assoc-ref parms 'dep-graph)
|
|
'()))))
|
|
(let ((dep-releases
|
|
(semver-constrain
|
|
(if (and dep-mod
|
|
(module-variable dep-mod 'get-releases))
|
|
((module-ref dep-mod 'get-releases)
|
|
dep-parms)
|
|
(fetch-npmjs dep-parms))
|
|
constraints)))
|
|
(set! last-release-comps (if (not (null? dep-releases))
|
|
(assoc-ref (car dep-releases)
|
|
"version-values")
|
|
'()))
|
|
(set! nodejs-ebuilds
|
|
(append nodejs-ebuilds
|
|
(if (and dep-mod
|
|
(module-variable dep-mod 'generate-ebuilds))
|
|
((module-ref dep-mod 'generate-ebuilds)
|
|
dep-parms
|
|
dep-releases)
|
|
(ebuild-gen dep-parms
|
|
dep-releases)))))
|
|
(set! nodejs-ebuilds
|
|
(append nodejs-ebuilds
|
|
(list
|
|
(list
|
|
(cons 'category (assoc-ref dep-parms 'category))
|
|
(cons 'name (assoc-ref dep-parms 'name))
|
|
(cons 'pkgfiles
|
|
(append (if (assoc-ref dep-parms 'pkgfiles)
|
|
(assoc-ref dep-parms 'pkgfiles)
|
|
'())
|
|
(list (assoc-ref dep-state 'ebuild))))
|
|
(cons 'distfiles (if (assoc-ref dep-parms 'distfiles)
|
|
(assoc-ref dep-parms 'distfiles)
|
|
'())))))))
|
|
(if (>= (assoc-ref parms 'verbosity) verbosity-warn)
|
|
(begin (display "dep-version:") (display dep-vers) (newline)))
|
|
(values
|
|
;; Dependencys.
|
|
(let ((pkg-name (string-append (if pkt-map
|
|
(assoc-ref pkt-map 'category)
|
|
"dev-nodejs")
|
|
"/"
|
|
(if pkt-map
|
|
(assoc-ref pkt-map 'pkg)
|
|
dep-name))))
|
|
(map (lambda (const)
|
|
(string-append
|
|
(if (null? (assoc-ref const 'type))
|
|
""
|
|
(symbol->string (assoc-ref const 'type)))
|
|
pkg-name
|
|
"-"
|
|
(comps->genver (if (positive? (assoc-ref const 'slot-level))
|
|
(if (> (length (assoc-ref const 'components))
|
|
(assoc-ref const 'slot-level))
|
|
(take (assoc-ref const 'components)
|
|
(assoc-ref const 'slot-level))
|
|
(assoc-ref const 'components))
|
|
(assoc-ref const 'components)))
|
|
(if (eq? (assoc-ref const 'type) '=) "*" "")))
|
|
constraints))
|
|
;; Symlinks.
|
|
(if (null? constraints)
|
|
""
|
|
(let ((const (car constraints)))
|
|
(string-append
|
|
"\""
|
|
(assoc-ref dep "alias")
|
|
" -> "
|
|
(assoc-ref dep "pkg")
|
|
(cond ((eq? (assoc-ref const 'type) '=)
|
|
(string-append
|
|
"-"
|
|
(comps->genver
|
|
(if (> (length (assoc-ref const 'components))
|
|
(assoc-ref const 'slot-level))
|
|
(take (assoc-ref const 'components)
|
|
(min (assoc-ref const 'slot-level)
|
|
3))
|
|
(take (assoc-ref const 'components)
|
|
(min (length (assoc-ref const 'components))
|
|
3))))))
|
|
((null? last-release-comps) "") ;; Not found select any.
|
|
;; Highest usable version is car of releases.
|
|
((or (eq? (assoc-ref const 'type) '<)
|
|
(eq? (assoc-ref const 'type) '<=)
|
|
(> (length constraints) 1))
|
|
(string-append "-"
|
|
(comps->genver last-release-comps)))
|
|
(else (string-append "-" (assoc-ref dep "version"))))
|
|
"\"")))
|
|
;; Ebuilds.
|
|
nodejs-ebuilds))))
|
|
|
|
(define gen-nodejs-ebuild
|
|
(lambda* (vars verbosity #:key
|
|
(tmpl #f)
|
|
ignore-diff)
|
|
""
|
|
(let* ((pkt-map-db (pkt-map-load (assoc-ref vars 'repo) "nodejs"))
|
|
(vers (assoc-ref vars "version-values"))
|
|
(nodejs-symlinks '())
|
|
(nodejs-ebuilds '())
|
|
(nodejs-deps (append-map (lambda (dep)
|
|
(receive (deps links dep-ebuilds)
|
|
(setup-nodejs-dep dep
|
|
vars
|
|
pkt-map-db)
|
|
(set! nodejs-ebuilds
|
|
(append nodejs-ebuilds
|
|
dep-ebuilds))
|
|
(set! nodejs-symlinks
|
|
(append nodejs-symlinks
|
|
(list links)))
|
|
deps))
|
|
(if (assoc-ref vars "dependencies")
|
|
(assoc-ref vars "dependencies")
|
|
'()))))
|
|
(append (ebuild-from-tmpl
|
|
(append vars
|
|
(list (cons "slot"
|
|
(comps->genver (if (> (length vers) 3)
|
|
(take vers 3)
|
|
vers)))
|
|
(cons "nodejs-deps"
|
|
(string-join nodejs-deps "\n\t"))
|
|
(cons "nodejs-symlinks"
|
|
(string-join nodejs-symlinks "\n\t"))))
|
|
(assoc-ref vars 'verbosity)
|
|
#:tmpl tmpl
|
|
#:ignore-diff ignore-diff)
|
|
nodejs-ebuilds))))
|
|
|
|
(define-public ebuild-gen
|
|
(lambda* (parms releases #:key
|
|
(keep-components (list 1 1 2))
|
|
(keep (lambda (version) #f))
|
|
(drop (lambda (version) #f))
|
|
(template #f)
|
|
(gen-ebuild-hook gen-nodejs-ebuild)
|
|
(post-hook ebuild-default-post)
|
|
ignore-autogen-diff)
|
|
""
|
|
((@ (ebuild gen) ebuild-gen)
|
|
parms releases
|
|
#:keep-components keep-components
|
|
#:keep keep
|
|
#:drop drop
|
|
#:template template
|
|
#:gen-ebuild-hook gen-ebuild-hook
|
|
#:post-hook post-hook
|
|
#:ignore-autogen-diff ignore-autogen-diff)))
|