LordMZTE/dotfiles
1
0
Fork 0
mirror of https://mzte.de/git/LordMZTE/dotfiles.git synced 2024-09-27 20:48:53 +02:00
Code Issues Projects Releases Packages Wiki Activity

setup: add contract to install-script?

Browse source
This commit is contained in:
LordMZTE 2023-10-31 16:18:18 +01:00
parent 596dc5a133
commit a98d607f6b
Signed by: LordMZTE
GPG key ID: B64802DC33A64FF6
1 changed files with 11 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
setup/common.rkt
View file

@ -15,7 +15,9 @@
install-script?) install-script?)
;; A parameter containing a predicate string? -> boolean? for checking if a script should be installed. ;; A parameter containing a predicate string? -> boolean? for checking if a script should be installed.
(define install-script? (make-parameter (λ (_) #t))) (define/contract install-script?
(parameter/c (string? . -> . boolean?))
(make-parameter (λ (_) #t)))
(define-namespace-anchor common-ns) (define-namespace-anchor common-ns)
(define (load-config) (define (load-config)
@ -46,12 +48,12 @@
;; Defines a script installer with a backing function which will only run when install-script? returns #t. ;; 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-syntax-rule (define-script-installer name func)
(define (name p) (define (name . args)
(if ((install-script?) p) (if ((install-script?) (car args))
(begin (begin
(display-function-call 'name (list p)) (display-function-call 'name args)
(func p)) (apply func args))
(fprintf (current-error-port) "skipping script ~s\n" p)))) (fprintf (current-error-port) "skipping script ~s\n" (car args)))))
(define-logging cmd (define-logging cmd
(λ (exe . args) (λ (exe . args)