setup: allow script filtering using a local setup configuration file

This commit is contained in:
LordMZTE 2023-10-31 15:51:21 +01:00
parent ad019a7331
commit 596dc5a133
Signed by: LordMZTE
GPG key ID: B64802DC33A64FF6
2 changed files with 37 additions and 11 deletions

View file

@ -31,6 +31,9 @@
(symbol=? valid-verb verb)) (symbol=? valid-verb verb))
(raise-user-error "Invalid verb" verb)) (raise-user-error "Invalid verb" verb))
(load-config)
;; Load local config
(match verb (match verb
['install-scripts ['install-scripts
(local-require "setup/commands/install-scripts.rkt") (local-require "setup/commands/install-scripts.rkt")

View file

@ -10,7 +10,20 @@
install-zig install-zig
install-rust install-rust
install-roswell install-roswell
build-haxe) build-haxe
load-config
install-script?)
;; A parameter containing a predicate string? -> boolean? for checking if a script should be installed.
(define install-script? (make-parameter (λ (_) #t)))
(define-namespace-anchor common-ns)
(define (load-config)
(let ([path (expand-user-path "~/.config/mzte_localconf/setup-opts.rkts")])
(if (file-exists? path)
(parameterize ([current-namespace (namespace-anchor->namespace common-ns)])
(load path))
(fprintf (current-error-port) "no setup-opts found, skipping\n"))))
;; Whether to log calls or not ;; Whether to log calls or not
(define log-calls (make-parameter #t)) (define log-calls (make-parameter #t))
@ -28,9 +41,18 @@
;; Defines an alias to a function which will log it's parameters on invokation. ;; Defines an alias to a function which will log it's parameters on invokation.
(define-syntax-rule (define-logging name func) (define-syntax-rule (define-logging name func)
(define (name . args) (define (name . args)
(display-function-call (quote name) args) (display-function-call 'name args)
(apply func args))) (apply func args)))
;; Defines a script installer with a backing function which will only run when install-script? returns #t.
(define-syntax-rule (define-script-installer name func)
(define (name p)
(if ((install-script?) p)
(begin
(display-function-call 'name (list p))
(func p))
(fprintf (current-error-port) "skipping script ~s\n" p))))
(define-logging cmd (define-logging cmd
(λ (exe . args) (λ (exe . args)
(unless (apply system* (find-executable-path exe) args) (unless (apply system* (find-executable-path exe) args)
@ -38,12 +60,13 @@
(define-logging rm (λ (path) (delete-directory/files path #:must-exist? false))) (define-logging rm (λ (path) (delete-directory/files path #:must-exist? false)))
(define-logging copy copy-directory/files) (define-logging copy copy-directory/files)
(define-logging install-zig (define-script-installer
install-zig
(λ (path [mode "ReleaseFast"]) (λ (path [mode "ReleaseFast"])
(parameterize ([current-directory path] [log-calls #f]) (parameterize ([current-directory path] [log-calls #f])
(cmd "zig" "build" "-p" (output-bin-path) (string-append "-Doptimize=" mode))))) (cmd "zig" "build" "-p" (output-bin-path) (string-append "-Doptimize=" mode)))))
(define-logging install-rust (define-script-installer install-rust
(λ (path) (λ (path)
(parameterize ([current-directory path] [log-calls #f]) (parameterize ([current-directory path] [log-calls #f])
(cmd "cargo" (cmd "cargo"
@ -63,14 +86,14 @@
(λ () (λ ()
(unless (directory-exists? "cgout") (unless (directory-exists? "cgout")
(make-directory "cgout")) (make-directory "cgout"))
(call-with-output-file* (call-with-output-file* #:exists 'truncate/replace
#:exists 'truncate/replace "cgout/opts.json"
"cgout/opts.json" (λ (outfile)
(λ (outfile) (parameterize ([log-calls #f]
(parameterize ([log-calls #f] [current-output-port outfile]) [current-output-port outfile])
(cmd "confgen" "--json-opt" "confgen.lua")))))) (cmd "confgen" "--json-opt" "confgen.lua"))))))
(define-logging (define-script-installer
install-roswell install-roswell
(λ (path) (λ (path)
(parameterize ([log-calls #f]) (parameterize ([log-calls #f])