153 lines
4.6 KiB
Racket
153 lines
4.6 KiB
Racket
#lang racket/base
|
|
|
|
(require file/glob
|
|
racket/file
|
|
racket/list
|
|
racket/path
|
|
racket/string
|
|
racket/system
|
|
setup/dirs
|
|
"engine.rkt")
|
|
|
|
(provide run
|
|
raco
|
|
rm-f
|
|
rm-rf
|
|
cleanup
|
|
list-dir/files
|
|
list-files
|
|
list-dirs)
|
|
|
|
(define (recipe-value who parameter description)
|
|
(define value (parameter))
|
|
(unless value
|
|
(error who "~a is only available while a target recipe is running" description))
|
|
value)
|
|
|
|
(define (command-item->strings who value)
|
|
(cond
|
|
[(eq? value '$target)
|
|
(list (recipe-value who current-target "$target"))]
|
|
[(eq? value '$deps)
|
|
(recipe-value who current-dependencies "$deps")]
|
|
[(eq? value '$<)
|
|
(define first (current-first-dependency))
|
|
(unless first
|
|
(error who "$< is not available: this target has no dependencies"))
|
|
(list first)]
|
|
[(symbol? value) (list (symbol->string value))]
|
|
[(path? value) (list (path->string value))]
|
|
[(string? value) (list value)]
|
|
[(number? value) (list (number->string value))]
|
|
[(list? value) (append-map (lambda (item) (command-item->strings who item)) value)]
|
|
[else
|
|
(raise-argument-error
|
|
who
|
|
"command item (string, symbol, path, number, or list)"
|
|
value)]))
|
|
|
|
(define (run command)
|
|
(unless (list? command)
|
|
(raise-argument-error 'run "list?" command))
|
|
(define arguments
|
|
(append-map (lambda (item) (command-item->strings 'run item)) command))
|
|
(when (null? arguments)
|
|
(error 'run "empty command"))
|
|
(define program (car arguments))
|
|
(define executable
|
|
(or (find-executable-path program)
|
|
(and (file-exists? program) (path->complete-path program))
|
|
(error 'run "executable not found: ~a" program)))
|
|
(printf "> ~a\n" (string-join arguments " "))
|
|
(unless (apply system* executable (cdr arguments))
|
|
(error 'run "command failed: ~a" program))
|
|
(void))
|
|
|
|
|
|
(define (raco-executable-name)
|
|
(if (eq? (system-type 'os) 'windows)
|
|
"raco.exe"
|
|
"raco"))
|
|
|
|
(define (existing-raco-in directory)
|
|
(and directory
|
|
(let ([path (build-path directory (raco-executable-name))])
|
|
(and (file-exists? path) path))))
|
|
|
|
(define (find-raco-executable)
|
|
(define console-bin
|
|
(with-handlers ([exn:fail? (λ (_) #f)])
|
|
(find-console-bin-dir)))
|
|
(define from-console-bin
|
|
(existing-raco-in console-bin))
|
|
|
|
(define exec-file
|
|
(with-handlers ([exn:fail? (λ (_) #f)])
|
|
(find-system-path 'exec-file)))
|
|
(define from-exec-dir
|
|
(and exec-file
|
|
(existing-raco-in (path-only exec-file))))
|
|
|
|
(or from-console-bin
|
|
from-exec-dir
|
|
(find-executable-path (raco-executable-name))
|
|
(error 'raco "cannot find raco for the current Racket installation")))
|
|
|
|
(define (raco command)
|
|
(unless (list? command)
|
|
(raise-argument-error 'raco "list?" command))
|
|
(define arguments
|
|
(append-map (λ (item) (command-item->strings 'raco item)) command))
|
|
(when (null? arguments)
|
|
(error 'raco "empty command"))
|
|
(define executable (find-raco-executable))
|
|
(printf "> ~a ~a\n"
|
|
(path->string executable)
|
|
(string-join arguments " "))
|
|
(unless (apply system* executable arguments)
|
|
(error 'raco "command failed: ~a" (car arguments)))
|
|
(void))
|
|
|
|
(define (rm-f . paths)
|
|
(for ([path (in-list paths)])
|
|
(case (file-or-directory-type path #f)
|
|
[(file link) (delete-file path)]
|
|
[(directory-link) (delete-directory path)]
|
|
[(directory)
|
|
(error 'rm-f "refusing to remove directory without recursion: ~a" path)]
|
|
[else (void)]))
|
|
(void))
|
|
|
|
(define (rm-rf . paths)
|
|
(for ([path (in-list paths)])
|
|
(delete-directory/files path #:must-exist? #f))
|
|
(void))
|
|
|
|
(define (cleanup directory patterns)
|
|
(unless (list? patterns)
|
|
(raise-argument-error 'cleanup "list?" patterns))
|
|
(for* ([pattern (in-list patterns)]
|
|
[path (in-glob (build-path directory pattern))])
|
|
(case (file-or-directory-type path #f)
|
|
[(file link) (rm-f path)]
|
|
[else (void)]))
|
|
(void))
|
|
|
|
(define (list-dir/files directory regexp #:recursive [recursive #f])
|
|
(filter (lambda (path)
|
|
(define filename (file-name-from-path path))
|
|
(and filename
|
|
(regexp-match? regexp filename)))
|
|
(if recursive
|
|
(for/list ([path (in-directory directory)])
|
|
path)
|
|
(directory-list directory #:build? #t))))
|
|
|
|
(define (list-files directory regexp #:recursive [recursive #f])
|
|
(filter file-exists?
|
|
(list-dir/files directory regexp #:recursive recursive)))
|
|
|
|
(define (list-dirs directory regexp #:recursive [recursive #f])
|
|
(filter directory-exists?
|
|
(list-dir/files directory regexp #:recursive recursive)))
|