76 lines
2.2 KiB
Racket
76 lines
2.2 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/format
|
|
racket/list
|
|
racket/path
|
|
racket/string
|
|
racket/system
|
|
setup/dirs)
|
|
|
|
(provide coreutils-raco
|
|
find-raco-executable)
|
|
|
|
(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)
|
|
;; Prefer the console executable directory of the current Racket
|
|
;; installation. This avoids accidentally using raco from another Racket
|
|
;; installation on PATH.
|
|
(define console-bin
|
|
(with-handlers ([exn:fail? (λ (_) #f)])
|
|
(find-console-bin-dir)))
|
|
(define from-console-bin
|
|
(existing-raco-in console-bin))
|
|
|
|
;; Portable and non-standard installations commonly put raco next to the
|
|
;; currently running Racket executable.
|
|
(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))))
|
|
|
|
;; PATH is deliberately last because it may point to another installation.
|
|
(or from-console-bin
|
|
from-exec-dir
|
|
(find-executable-path (raco-executable-name))
|
|
(error 'raco "cannot find raco for the current Racket installation")))
|
|
|
|
(define (command-item->strings value)
|
|
(cond
|
|
[(symbol? value) (list (symbol->string value))]
|
|
[(path? value) (list (path->string value))]
|
|
[(string? value) (list value)]
|
|
[(number? value) (list (~a value))]
|
|
[(list? value) (append-map command-item->strings value)]
|
|
[else
|
|
(raise-argument-error
|
|
'raco
|
|
"command item (string, symbol, path, number, or list)"
|
|
value)]))
|
|
|
|
(define (coreutils-raco . command)
|
|
(define arguments
|
|
(append-map command-item->strings 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"
|
|
(if (null? arguments)
|
|
""
|
|
(format ": ~a" (car arguments)))))
|
|
(void))
|