Initial import

private/dispatcher.rkt

@@ -0,0 +1,83 @@
+#lang racket/base
+
+(require racket/list
+         racket/path
+         "commands.rkt"
+         "env-support.rkt"
+         "help.rkt")
+
+(provide dispatch-coreutils-command
+         expand-coreutils-arguments)
+
+(define (regexp-paths pattern)
+  (define entries
+    (directory-list (current-directory) #:build? #t))
+  (define matching-entries
+    (filter
+     (λ (entry)
+       (define name (file-name-from-path entry))
+       (and name
+            (regexp-match? pattern (path->string name))))
+     entries))
+  (sort matching-entries
+        string<?
+        #:key
+        (λ (entry)
+          (path->string (file-name-from-path entry)))))
+
+(define (expand-coreutils-argument arg)
+  (cond
+    [(list? arg)
+     (append-map expand-coreutils-argument arg)]
+    [(regexp? arg)
+     (define matches (regexp-paths arg))
+     (when (null? matches)
+       (raise-arguments-error
+        'dispatch-coreutils-command
+        "regular expression matched no paths"
+        "pattern" arg))
+     matches]
+    [else
+     (list arg)]))
+
+(define (expand-coreutils-arguments args)
+  (append-map expand-coreutils-argument args))
+
+(define (help-option? arg)
+  (or (equal? arg '--help)
+      (equal? arg "--help")))
+
+(define (argument->command-name arg)
+  (cond
+    [(symbol? arg) arg]
+    [(string? arg) (string->symbol arg)]
+    [(path? arg) (string->symbol (path->string arg))]
+    [else #f]))
+
+(define (run-coreutils-command-if-known command)
+  (define command-name
+    (and (pair? command)
+         (argument->command-name (car command))))
+  (define known-command
+    (and command-name
+         (find-coreutils-command command-name)))
+  (if known-command
+      (begin
+        (apply dispatch-coreutils-command command-name (cdr command))
+        #t)
+      #f))
+
+(define (dispatch-coreutils-command command-name . args)
+  (unless (symbol? command-name)
+    (raise-argument-error 'dispatch-coreutils-command "symbol?" command-name))
+  (define command (find-coreutils-command command-name))
+  (unless command
+    (raise-arguments-error 'dispatch-coreutils-command
+                           "unknown coreutils command"
+                           "command" command-name))
+  (if (ormap help-option? args)
+      (coreutils-help command-name)
+      (parameterize ([current-coreutils-command-runner
+                      run-coreutils-command-if-known])
+        (apply (coreutils-command-procedure command)
+               (expand-coreutils-arguments args)))))