Initial import

private/commands.rkt

@@ -0,0 +1,82 @@
+#lang racket/base
+
+(require file/glob
+         racket/file
+         racket/list
+         racket/string
+         racket/system
+         "engine.rkt")
+
+(provide run
+         rm-f
+         rm-rf
+         cleanup)
+
+(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 value)
+  (cond
+    [(eq? value '$target)
+     (list (recipe-value 'run current-target "$target"))]
+    [(eq? value '$deps)
+     (recipe-value 'run current-dependencies "$deps")]
+    [(eq? value '$<)
+     (define first (current-first-dependency))
+     (unless first
+       (error 'run "$< 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)]
+    [else
+     (raise-argument-error
+      'run
+      "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))
+  (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 (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))