Initial import

2026-08-17 23:19:13 +02:00
parent 8210aa8e63
commit 1d546c3d6f
20 changed files with 1799 additions and 1 deletions
@@ -0,0 +1,75 @@
+#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))