Added makefile.rkt

private/commands.rkt

@@ -3,11 +3,14 @@
 (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
@@ -21,32 +24,33 @@
     (error who "~a is only available while a target recipe is running" description))
   value)
 
-(define (command-item->strings value)
+(define (command-item->strings who value)
   (cond
     [(eq? value '$target)
-     (list (recipe-value 'run current-target "$target"))]
+     (list (recipe-value who current-target "$target"))]
     [(eq? value '$deps)
-     (recipe-value 'run current-dependencies "$deps")]
+     (recipe-value who current-dependencies "$deps")]
     [(eq? value '$<)
      (define first (current-first-dependency))
      (unless first
-       (error 'run "$< is not available: this target has no dependencies"))
+       (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 command-item->strings value)]
+    [(list? value) (append-map (lambda (item) (command-item->strings who item)) value)]
     [else
      (raise-argument-error
-      'run
+      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 command-item->strings command))
+  (define arguments
+    (append-map (lambda (item) (command-item->strings 'run item)) command))
   (when (null? arguments)
     (error 'run "empty command"))
   (define program (car arguments))
@@ -59,6 +63,57 @@
     (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)
+  ;; Prefer the console executable directory reported by the current Racket
+  ;; installation. This does not depend on PATH and therefore also works for
+  ;; typical Windows installations under Program Files.
+  (define console-bin
+    (with-handlers ([exn:fail? (lambda (_) #f)])
+      (find-console-bin-dir)))
+  (define from-console-bin
+    (existing-raco-in console-bin))
+
+  ;; A useful fallback for portable/non-standard installations: raco normally
+  ;; lives alongside the currently running racket executable.
+  (define exec-file
+    (with-handlers ([exn:fail? (lambda (_) #f)])
+      (find-system-path 'exec-file)))
+  (define from-exec-dir
+    (and exec-file
+         (existing-raco-in (path-only exec-file))))
+
+  ;; PATH is intentionally last; it might refer to a different Racket install.
+  (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 (lambda (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)