84 lines
2.4 KiB
Racket
84 lines
2.4 KiB
Racket
#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)))))
|