Initial import

.gitignore

@@ -5,6 +5,7 @@
 # DrRacket autosave files
 *.rkt~
 *.rkt.bak
+*.bak
 \#*.rkt#
 \#*.rkt#*#
 
@@ -15,3 +16,6 @@ compiled/
 # Dependency tracking files
 *.dep
 
+doc
+
+

CHANGELOG

@@ -0,0 +1,22 @@
+0.2.7
+
+- Fix package setup regression in the Racket test suite after the raco command/procedure split.
+- Test coreutils-raco as the Racket procedure; keep the raco Rash alias covered by the Rash smoke test.
+
+0.2.3
+- Export raco as a normal first-class Racket procedure instead of a pipeline alias.
+- Keep raco usable directly in Rash line mode while avoiding syntax/value binding conflicts.
+- Allow raco with no subcommand to invoke the underlying raco program.
+
+0.2.4
+- Restore raco as a Rash pipeline command; keep coreutils-raco as the ordinary Racket procedure.
+
+0.2.5
+- Make env recognize NAME=(Racket expression) before runtime argument dispatch.
+- Preserve empty NAME= assignments without consuming the following command argument.
+- Let env execute registered rash-coreutils commands before falling back to PATH.
+
+0.2.6
+- Add character-range expansion to tr, including a-z, A-Z and 0-9.
+- Add tr -d and tr -s behavior.
+- Print Rash-friendly forward-slash paths on Windows for path-producing commands.

Makefile

@@ -0,0 +1,25 @@
+#lang rash
+
+(require racket-makefile/rash)
+
+(makefile rash-coreutils
+
+  (target all
+       (displayln "Use make clean, make zip, etc."))
+
+  (target clean
+          (for-each (λ (f) (displayln f) (rm-f f))
+                    (list-files "." #px"([.]bak|~)$" #:recursive #t))
+          (for-each (λ (d) (displayln d) (rm-rf d))
+                    (list-dirs "." #px"(compiled|doc|docs)$" #:recursive #t))
+          (unless (directory-exists? "scrbl")
+                  (make-directory "scrbl"))
+          (for-each (λ (f) (displayln f) (rm-f f))
+                    (list-files "scrbl" #px"[.](css|js|html)$")))
+
+  (target zip
+          (deps clean)
+          (zip-package))
+
+  )
+        

README.md

@@ -1,3 +1,38 @@
 # rash-coreutils
 
-Commands like 'ls', 'mkdir', etc. for rash, but platform independent, i.e. working on windows and on unix flavors. 
+Portable Unix-style core utilities for Rash, implemented in Racket.
+
+Version 0.2.7 includes text/pipeline tools (`head`, `tail`, `wc`, `sort`, `uniq`,
+`cut`, `tee`, `tr`), path and filesystem helpers (`basename`, `dirname`,
+`realpath`, `readlink`, `stat`, `du`, `df`, `mktemp`), environment commands
+(`printenv`, `env`), and `date` backed by Gregor.
+
+Rash remains responsible for shell syntax such as globbing, pipelines and
+redirection. `rash-coreutils` additionally accepts Racket regular expressions as
+path selectors.
+
+
+## Racket tooling
+
+`rash-coreutils` also exposes the `raco` command from the active Racket installation, without requiring `raco` to be on PATH.
+
+```text
+raco setup rash-coreutils
+raco pkg show
+```
+
+In Racket expression mode, use `coreutils-raco`, for example `(coreutils-raco '(setup rash-coreutils))`. The name `raco` is reserved for the Rash command binding.
+
+## Windows paths
+
+Commands that print paths use forward slashes on Windows. This keeps their textual output directly reusable in Rash line mode, where a backslash is an escape character. Internally, Racket path values remain native paths.
+
+```text
+pwd
+C:/devel/racket/rash-coreutils/
+
+mktemp
+C:/Users/hans/AppData/Local/Temp/tmp123
+```
+
+A native Racket path value can still be passed directly, for example `ls (values (find-system-path 'temp-dir))`.

help

@@ -0,0 +1,20 @@
+#lang info
+
+(define pkg-authors '(hnmdijkema))
+(define version "0.1.6")
+(define license 'MIT)
+(define collection "rash-coreutils")
+(define pkg-desc
+  "Platform-independent Unix-style core utilities for Rash, implemented in Racket.")
+
+(define scribblings
+  '(("scrbl/rash-coreutils.scrbl" () (library 0))))
+
+(define deps
+  '("base" "rash"))
+
+(define build-deps
+  '("racket-doc"
+    "rackunit-lib"
+    "scribble-lib"
+    "rash"))

info.rkt

@@ -0,0 +1,20 @@
+#lang info
+
+(define pkg-authors '(hnmdijkema))
+(define version "0.2.7")
+(define license 'MIT)
+(define collection "rash-coreutils")
+(define pkg-desc
+  "Platform-independent Unix-style core utilities for Rash, implemented in Racket.")
+
+(define scribblings
+  '(("scrbl/rash-coreutils.scrbl" () (library 0))))
+
+(define deps
+  '("base" "rash" "gregor-lib"))
+
+(define build-deps
+  '("racket-doc"
+    "rackunit-lib"
+    "scribble-lib"
+    "rash"))

main.rkt

@@ -0,0 +1,17 @@
+#lang racket/base
+
+(require "private/coreutils.rkt"
+         "private/extended.rkt"
+         "private/commands.rkt"
+         "private/racket-tools.rkt"
+         "private/dispatcher.rkt"
+         "private/help.rkt"
+         "private/aliases.rkt")
+
+(provide (all-from-out "private/coreutils.rkt")
+         (all-from-out "private/extended.rkt")
+         (all-from-out "private/commands.rkt")
+         (all-from-out "private/racket-tools.rkt")
+         (all-from-out "private/dispatcher.rkt")
+         (all-from-out "private/help.rkt")
+         (all-from-out "private/aliases.rkt"))

private/aliases.rkt

@@ -0,0 +1,135 @@
+#lang racket/base
+
+(require rash
+         "dispatcher.rkt"
+         "env-support.rkt"
+         "help.rkt"
+         "racket-tools.rkt"
+         (for-syntax racket/base))
+
+(provide pwd ls mkdir rmdir rm cp mv cat touch echo which
+         head tail wc sort uniq cut tee tr basename dirname realpath readlink
+         stat du df mktemp printenv env date help raco)
+
+(define (make-command-procedure name)
+  (λ args
+    (apply dispatch-coreutils-command name args)))
+
+(define pwd-command (make-command-procedure 'pwd))
+(define ls-command (make-command-procedure 'ls))
+(define mkdir-command (make-command-procedure 'mkdir))
+(define rmdir-command (make-command-procedure 'rmdir))
+(define rm-command (make-command-procedure 'rm))
+(define cp-command (make-command-procedure 'cp))
+(define mv-command (make-command-procedure 'mv))
+(define cat-command (make-command-procedure 'cat))
+(define touch-command (make-command-procedure 'touch))
+(define echo-command (make-command-procedure 'echo))
+(define which-command (make-command-procedure 'which))
+(define head-command (make-command-procedure 'head))
+(define tail-command (make-command-procedure 'tail))
+(define wc-command (make-command-procedure 'wc))
+(define sort-command (make-command-procedure 'sort))
+(define uniq-command (make-command-procedure 'uniq))
+(define cut-command (make-command-procedure 'cut))
+(define tee-command (make-command-procedure 'tee))
+(define tr-command (make-command-procedure 'tr))
+(define basename-command (make-command-procedure 'basename))
+(define dirname-command (make-command-procedure 'dirname))
+(define realpath-command (make-command-procedure 'realpath))
+(define readlink-command (make-command-procedure 'readlink))
+(define stat-command (make-command-procedure 'stat))
+(define du-command (make-command-procedure 'du))
+(define df-command (make-command-procedure 'df))
+(define mktemp-command (make-command-procedure 'mktemp))
+(define printenv-command (make-command-procedure 'printenv))
+(define env-command (make-command-procedure 'env))
+(define date-command (make-command-procedure 'date))
+(define raco-command coreutils-raco)
+
+(define (help-command . args)
+  (apply coreutils-help args))
+
+(begin-for-syntax
+  (define (assignment-prefix-name stx)
+    (define datum (syntax-e stx))
+    (define text
+      (cond
+        [(symbol? datum) (symbol->string datum)]
+        [(string? datum) datum]
+        [else #f]))
+    (and text
+         (regexp-match? #px"^[^=]+=$" text)
+         (substring text 0 (sub1 (string-length text)))))
+
+  (define (racket-expression? stx)
+    (pair? (syntax-e stx)))
+
+  (define (prepare-env-arguments arguments)
+    (let loop ([rest arguments] [result '()])
+      (cond
+        [(null? rest)
+         (reverse result)]
+        [(and (pair? (cdr rest))
+              (assignment-prefix-name (car rest))
+              (racket-expression? (cadr rest)))
+         (define name (assignment-prefix-name (car rest)))
+         (define expression (cadr rest))
+         (loop (cddr rest)
+               (cons #`(environment-assignment #,name #,expression)
+                     result))]
+        [else
+         (loop (cdr rest)
+               (cons (car rest) result))])))
+
+  (define (make-env-alias procedure-id)
+    (λ (stx)
+      (syntax-case stx ()
+        [(_ argument ...)
+         (let ([prepared
+                (prepare-env-arguments
+                 (syntax->list #'(argument ...)))])
+           (with-syntax ([(prepared-argument ...) prepared]
+                         [command-procedure procedure-id])
+             #'(=unix-pipe= (values command-procedure)
+                            prepared-argument ...)))])))
+
+  (define (make-coreutils-alias procedure-id)
+    (λ (stx)
+      (syntax-case stx ()
+        [(_ argument ...)
+         (with-syntax ([command-procedure procedure-id])
+           #'(=unix-pipe= (values command-procedure) argument ...))]))))
+
+(define-pipeline-alias pwd      (make-coreutils-alias #'pwd-command))
+(define-pipeline-alias ls       (make-coreutils-alias #'ls-command))
+(define-pipeline-alias mkdir    (make-coreutils-alias #'mkdir-command))
+(define-pipeline-alias rmdir    (make-coreutils-alias #'rmdir-command))
+(define-pipeline-alias rm       (make-coreutils-alias #'rm-command))
+(define-pipeline-alias cp       (make-coreutils-alias #'cp-command))
+(define-pipeline-alias mv       (make-coreutils-alias #'mv-command))
+(define-pipeline-alias cat      (make-coreutils-alias #'cat-command))
+(define-pipeline-alias touch    (make-coreutils-alias #'touch-command))
+(define-pipeline-alias echo     (make-coreutils-alias #'echo-command))
+(define-pipeline-alias which    (make-coreutils-alias #'which-command))
+(define-pipeline-alias head     (make-coreutils-alias #'head-command))
+(define-pipeline-alias tail     (make-coreutils-alias #'tail-command))
+(define-pipeline-alias wc       (make-coreutils-alias #'wc-command))
+(define-pipeline-alias sort     (make-coreutils-alias #'sort-command))
+(define-pipeline-alias uniq     (make-coreutils-alias #'uniq-command))
+(define-pipeline-alias cut      (make-coreutils-alias #'cut-command))
+(define-pipeline-alias tee      (make-coreutils-alias #'tee-command))
+(define-pipeline-alias tr       (make-coreutils-alias #'tr-command))
+(define-pipeline-alias basename (make-coreutils-alias #'basename-command))
+(define-pipeline-alias dirname  (make-coreutils-alias #'dirname-command))
+(define-pipeline-alias realpath (make-coreutils-alias #'realpath-command))
+(define-pipeline-alias readlink (make-coreutils-alias #'readlink-command))
+(define-pipeline-alias stat     (make-coreutils-alias #'stat-command))
+(define-pipeline-alias du       (make-coreutils-alias #'du-command))
+(define-pipeline-alias df       (make-coreutils-alias #'df-command))
+(define-pipeline-alias mktemp   (make-coreutils-alias #'mktemp-command))
+(define-pipeline-alias printenv (make-coreutils-alias #'printenv-command))
+(define-pipeline-alias env      (make-env-alias #'env-command))
+(define-pipeline-alias date     (make-coreutils-alias #'date-command))
+(define-pipeline-alias help     (make-coreutils-alias #'help-command))
+(define-pipeline-alias raco     (make-coreutils-alias #'raco-command))

private/commands.rkt

@@ -0,0 +1,50 @@
+#lang racket/base
+
+(require "coreutils.rkt"
+         "extended.rkt"
+         "racket-tools.rkt")
+
+(provide (struct-out coreutils-command)
+         coreutils-commands
+         find-coreutils-command)
+
+(struct coreutils-command (name procedure documentation-term) #:transparent)
+
+(define coreutils-commands
+  (list
+   (coreutils-command 'pwd coreutils-pwd 'rash-coreutils-pwd)
+   (coreutils-command 'ls coreutils-ls 'rash-coreutils-ls)
+   (coreutils-command 'mkdir coreutils-mkdir 'rash-coreutils-mkdir)
+   (coreutils-command 'rmdir coreutils-rmdir 'rash-coreutils-rmdir)
+   (coreutils-command 'rm coreutils-rm 'rash-coreutils-rm)
+   (coreutils-command 'cp coreutils-cp 'rash-coreutils-cp)
+   (coreutils-command 'mv coreutils-mv 'rash-coreutils-mv)
+   (coreutils-command 'cat coreutils-cat 'rash-coreutils-cat)
+   (coreutils-command 'touch coreutils-touch 'rash-coreutils-touch)
+   (coreutils-command 'echo coreutils-echo 'rash-coreutils-echo)
+   (coreutils-command 'which coreutils-which 'rash-coreutils-which)
+   (coreutils-command 'head coreutils-head 'rash-coreutils-head)
+   (coreutils-command 'tail coreutils-tail 'rash-coreutils-tail)
+   (coreutils-command 'wc coreutils-wc 'rash-coreutils-wc)
+   (coreutils-command 'sort coreutils-sort 'rash-coreutils-sort)
+   (coreutils-command 'uniq coreutils-uniq 'rash-coreutils-uniq)
+   (coreutils-command 'cut coreutils-cut 'rash-coreutils-cut)
+   (coreutils-command 'tee coreutils-tee 'rash-coreutils-tee)
+   (coreutils-command 'tr coreutils-tr 'rash-coreutils-tr)
+   (coreutils-command 'basename coreutils-basename 'rash-coreutils-basename)
+   (coreutils-command 'dirname coreutils-dirname 'rash-coreutils-dirname)
+   (coreutils-command 'realpath coreutils-realpath 'rash-coreutils-realpath)
+   (coreutils-command 'readlink coreutils-readlink 'rash-coreutils-readlink)
+   (coreutils-command 'stat coreutils-stat 'rash-coreutils-stat)
+   (coreutils-command 'du coreutils-du 'rash-coreutils-du)
+   (coreutils-command 'df coreutils-df 'rash-coreutils-df)
+   (coreutils-command 'mktemp coreutils-mktemp 'rash-coreutils-mktemp)
+   (coreutils-command 'printenv coreutils-printenv 'rash-coreutils-printenv)
+   (coreutils-command 'env coreutils-env 'rash-coreutils-env)
+   (coreutils-command 'date coreutils-date 'rash-coreutils-date)
+   (coreutils-command 'raco coreutils-raco 'rash-coreutils-raco)))
+
+(define (find-coreutils-command name)
+  (for/first ([command (in-list coreutils-commands)]
+              #:when (eq? name (coreutils-command-name command)))
+    command))

private/coreutils.rkt

@@ -0,0 +1,272 @@
+#lang racket/base
+
+(require racket/file
+         racket/format
+         racket/list
+         racket/path
+         racket/port
+         racket/string
+         racket/system
+         "path-output.rkt")
+
+(provide coreutils-pwd
+         coreutils-ls
+         coreutils-mkdir
+         coreutils-rmdir
+         coreutils-rm
+         coreutils-cp
+         coreutils-mv
+         coreutils-cat
+         coreutils-touch
+         coreutils-echo
+         coreutils-which)
+
+(define (arg->string arg)
+  (cond
+    [(path? arg) (path->string arg)]
+    [(symbol? arg) (symbol->string arg)]
+    [(string? arg) arg]
+    [else (~a arg)]))
+
+(define (arg->path arg)
+  (string->path (arg->string arg)))
+
+(define (option? arg option)
+  (string=? (arg->string arg) option))
+
+(define (hidden-name? path)
+  (define name (path->string (file-name-from-path path)))
+  (and (positive? (string-length name))
+       (char=? (string-ref name 0) #\.)))
+
+(define (path-display-name path)
+  (path->string (file-name-from-path path)))
+
+(define (directory-entry-type path)
+  (cond
+    [(directory-exists? path) "d"]
+    [(link-exists? path) "l"]
+    [else "-"]))
+
+(define (directory-entry-size path)
+  (if (file-exists? path)
+      (file-size path)
+      0))
+
+(define (write-ls-entry path long?)
+  (if long?
+      (printf "~a ~a ~a\n"
+              (directory-entry-type path)
+              (~a (directory-entry-size path)
+                  #:min-width 10
+                  #:align 'right)
+              (path-display-name path))
+      (printf "~a\n" (path-display-name path))))
+
+(define (write-directory-listing directory all? long?)
+  (define entries
+    (sort (directory-list directory #:build? #t)
+          string<?
+          #:key path-display-name))
+  (for ([entry (in-list entries)])
+    (when (or all? (not (hidden-name? entry)))
+      (write-ls-entry entry long?))))
+
+(define (coreutils-pwd . args)
+  (unless (null? args)
+    (raise-arguments-error 'pwd "does not accept arguments" "arguments" args))
+  (displayln (path->rash-string (current-directory))))
+
+(define (coreutils-ls . args)
+  (define all? #f)
+  (define long? #f)
+  (define paths '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-a") (string=? text "--all"))
+       (set! all? #t)]
+      [(or (string=? text "-l") (string=? text "--long"))
+       (set! long? #t)]
+      [(or (string=? text "-la") (string=? text "-al"))
+       (set! all? #t)
+       (set! long? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'ls "unsupported option" "option" text)]
+      [else
+       (set! paths (append paths (list (arg->path arg))))]))
+  (when (null? paths)
+    (set! paths (list (current-directory))))
+  (define file-paths
+    (filter
+     (λ (path)
+       (or (file-exists? path) (link-exists? path)))
+     paths))
+  (define directory-paths
+    (filter directory-exists? paths))
+  (for ([path (in-list paths)])
+    (unless (or (file-exists? path)
+                (link-exists? path)
+                (directory-exists? path))
+      (raise-arguments-error 'ls "path does not exist" "path" path)))
+  (for ([path (in-list file-paths)])
+    (write-ls-entry path long?))
+  (for ([path (in-list directory-paths)]
+        [index (in-naturals)])
+    (when (or (pair? file-paths) (> index 0))
+      (newline))
+    (when (> (length paths) 1)
+      (printf "~a:\n" (path->rash-string path)))
+    (write-directory-listing path all? long?)))
+
+(define (coreutils-mkdir . args)
+  (define parents? #f)
+  (define paths '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-p") (string=? text "--parents"))
+       (set! parents? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'mkdir "unsupported option" "option" text)]
+      [else
+       (set! paths (append paths (list (arg->path arg))))]))
+  (when (null? paths)
+    (raise-arguments-error 'mkdir "expected at least one directory" "arguments" args))
+  (for ([path (in-list paths)])
+    (if parents?
+        (make-directory* path)
+        (make-directory path))))
+
+(define (coreutils-rmdir . args)
+  (when (null? args)
+    (raise-arguments-error 'rmdir "expected at least one directory" "arguments" args))
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (when (string-prefix? text "-")
+      (raise-arguments-error 'rmdir "unsupported option" "option" text))
+    (delete-directory (arg->path arg))))
+
+(define (delete-path path recursive? force?)
+  (cond
+    [(directory-exists? path)
+     (if recursive?
+         (delete-directory/files path)
+         (raise-arguments-error 'rm
+                                "cannot remove a directory without -r"
+                                "path" path))]
+    [(or (file-exists? path) (link-exists? path))
+     (delete-file path)]
+    [force? (void)]
+    [else
+     (raise-arguments-error 'rm "path does not exist" "path" path)]))
+
+(define (coreutils-rm . args)
+  (define recursive? #f)
+  (define force? #f)
+  (define paths '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-r")
+           (string=? text "-R")
+           (string=? text "--recursive"))
+       (set! recursive? #t)]
+      [(or (string=? text "-f") (string=? text "--force"))
+       (set! force? #t)]
+      [(or (string=? text "-rf")
+           (string=? text "-fr")
+           (string=? text "-Rf")
+           (string=? text "-fR"))
+       (set! recursive? #t)
+       (set! force? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'rm "unsupported option" "option" text)]
+      [else
+       (set! paths (append paths (list (arg->path arg))))]))
+  (when (null? paths)
+    (raise-arguments-error 'rm "expected at least one path" "arguments" args))
+  (for ([path (in-list paths)])
+    (delete-path path recursive? force?)))
+
+(define (copy-directory source destination)
+  (copy-directory/files source destination))
+
+(define (coreutils-cp . args)
+  (define recursive? #f)
+  (define paths '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-r")
+           (string=? text "-R")
+           (string=? text "--recursive"))
+       (set! recursive? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'cp "unsupported option" "option" text)]
+      [else
+       (set! paths (append paths (list (arg->path arg))))]))
+  (unless (= (length paths) 2)
+    (raise-arguments-error 'cp
+                           "this version expects exactly source and destination"
+                           "arguments" args))
+  (define source (first paths))
+  (define destination (second paths))
+  (cond
+    [(directory-exists? source)
+     (unless recursive?
+       (raise-arguments-error 'cp
+                              "source is a directory; use -r"
+                              "source" source))
+     (copy-directory source destination)]
+    [(file-exists? source)
+     (copy-file source destination)]
+    [else
+     (raise-arguments-error 'cp "source does not exist" "source" source)]))
+
+(define (coreutils-mv . args)
+  (unless (= (length args) 2)
+    (raise-arguments-error 'mv
+                           "expected source and destination"
+                           "arguments" args))
+  (define source (arg->path (first args)))
+  (define destination (arg->path (second args)))
+  (rename-file-or-directory source destination))
+
+(define (coreutils-cat . args)
+  (when (null? args)
+    (copy-port (current-input-port) (current-output-port)))
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (when (string-prefix? text "-")
+      (raise-arguments-error 'cat "unsupported option" "option" text))
+    (call-with-input-file* (arg->path arg)
+      (λ (in)
+        (copy-port in (current-output-port))))))
+
+(define (coreutils-touch . args)
+  (when (null? args)
+    (raise-arguments-error 'touch "expected at least one file" "arguments" args))
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (when (string-prefix? text "-")
+      (raise-arguments-error 'touch "unsupported option" "option" text))
+    (define path (arg->path arg))
+    (if (file-exists? path)
+        (file-or-directory-modify-seconds path (current-seconds))
+        (call-with-output-file* path
+          (λ (out) (void))))))
+
+(define (coreutils-echo . args)
+  (displayln (string-join (map arg->string args) " ")))
+
+(define (coreutils-which . args)
+  (when (null? args)
+    (raise-arguments-error 'which "expected at least one command" "arguments" args))
+  (for ([arg (in-list args)])
+    (define executable (find-executable-path (arg->string arg)))
+    (if executable
+        (displayln (path->rash-string executable))
+        (raise-arguments-error 'which
+                               "command was not found on PATH"
+                               "command" (arg->string arg)))))

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)))))

private/env-support.rkt

@@ -0,0 +1,9 @@
+#lang racket/base
+
+(provide (struct-out environment-assignment)
+         current-coreutils-command-runner)
+
+(struct environment-assignment (name value) #:transparent)
+
+(define current-coreutils-command-runner
+  (make-parameter #f))

private/extended.rkt

@@ -0,0 +1,541 @@
+#lang racket/base
+
+(require gregor
+         racket/file
+         racket/format
+         racket/list
+         racket/path
+         racket/port
+         racket/set
+         racket/string
+         racket/system
+         "env-support.rkt"
+         "path-output.rkt")
+
+(provide coreutils-head
+         coreutils-tail
+         coreutils-wc
+         coreutils-sort
+         coreutils-uniq
+         coreutils-cut
+         coreutils-tee
+         coreutils-tr
+         coreutils-basename
+         coreutils-dirname
+         coreutils-realpath
+         coreutils-readlink
+         coreutils-stat
+         coreutils-du
+         coreutils-df
+         coreutils-mktemp
+         coreutils-printenv
+         coreutils-env
+         coreutils-date)
+
+(define (arg->string arg)
+  (cond
+    [(path? arg) (path->string arg)]
+    [(symbol? arg) (symbol->string arg)]
+    [(string? arg) arg]
+    [else (~a arg)]))
+
+(define (arg->path arg)
+  (string->path (arg->string arg)))
+
+(define (read-lines-from-arguments args)
+  (if (null? args)
+      (port->lines (current-input-port))
+      (append-map
+       (λ (arg)
+         (call-with-input-file* (arg->path arg) port->lines))
+       args)))
+
+(define (parse-n-option who args default)
+  (cond
+    [(and (pair? args)
+          (member (arg->string (car args)) '("-n" "--lines")))
+     (unless (pair? (cdr args))
+       (raise-arguments-error who "missing line count" "arguments" args))
+     (define n (string->number (arg->string (cadr args))))
+     (unless (and (exact-integer? n) (>= n 0))
+       (raise-arguments-error who "line count must be a non-negative integer"
+                              "count" (cadr args)))
+     (values n (cddr args))]
+    [else
+     (values default args)]))
+
+(define (coreutils-head . args)
+  (define-values (n files) (parse-n-option 'head args 10))
+  (define lines (read-lines-from-arguments files))
+  (for ([line (in-list (take lines (min n (length lines))))])
+    (displayln line)))
+
+(define (coreutils-tail . args)
+  (define-values (n files) (parse-n-option 'tail args 10))
+  (define lines (read-lines-from-arguments files))
+  (define count (length lines))
+  (for ([line (in-list (drop lines (max 0 (- count n))))])
+    (displayln line)))
+
+(define (bytes-for-arguments args)
+  (if (null? args)
+      (port->bytes (current-input-port))
+      (apply bytes-append
+             (for/list ([arg (in-list args)])
+               (file->bytes (arg->path arg))))))
+
+(define (coreutils-wc . args)
+  (define lines? #f)
+  (define words? #f)
+  (define bytes? #f)
+  (define files '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(string=? text "-l") (set! lines? #t)]
+      [(string=? text "-w") (set! words? #t)]
+      [(or (string=? text "-c") (string=? text "--bytes")) (set! bytes? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'wc "unsupported option" "option" text)]
+      [else (set! files (append files (list arg)))]))
+  (when (not (or lines? words? bytes?))
+    (set! lines? #t)
+    (set! words? #t)
+    (set! bytes? #t))
+  (define bs (bytes-for-arguments files))
+  (define text (bytes->string/utf-8 bs #\?))
+  (define results
+    (filter (λ (x) x)
+            (list (if lines? (number->string (length (regexp-match* #rx"\n" text))) #f)
+                  (if words? (number->string (length (regexp-match* #px"\\S+" text))) #f)
+                  (if bytes? (number->string (bytes-length bs)) #f))))
+  (displayln (string-join results " ")))
+
+(define (coreutils-sort . args)
+  (define reverse? #f)
+  (define numeric? #f)
+  (define files '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-r") (string=? text "--reverse")) (set! reverse? #t)]
+      [(or (string=? text "-n") (string=? text "--numeric-sort")) (set! numeric? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'sort "unsupported option" "option" text)]
+      [else (set! files (append files (list arg)))]))
+  (define (less? a b)
+    (if numeric?
+        (< (or (string->number a) +inf.0)
+           (or (string->number b) +inf.0))
+        (string<? a b)))
+  (define sorted (sort (read-lines-from-arguments files) less?))
+  (for ([line (in-list (if reverse? (reverse sorted) sorted))])
+    (displayln line)))
+
+(define (run-lengths lines)
+  (let loop ([rest lines] [current #f] [count 0] [result '()])
+    (cond
+      [(null? rest)
+       (reverse (if current (cons (cons current count) result) result))]
+      [(and current (string=? current (car rest)))
+       (loop (cdr rest) current (add1 count) result)]
+      [else
+       (loop (cdr rest)
+             (car rest)
+             1
+             (if current (cons (cons current count) result) result))])))
+
+(define (coreutils-uniq . args)
+  (define count? #f)
+  (define files '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-c") (string=? text "--count")) (set! count? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'uniq "unsupported option" "option" text)]
+      [else (set! files (append files (list arg)))]))
+  (for ([entry (in-list (run-lengths (read-lines-from-arguments files)))])
+    (if count?
+        (printf "~a ~a\n" (~a (cdr entry) #:min-width 7 #:align 'right) (car entry))
+        (displayln (car entry)))))
+
+(define (parse-field-spec text)
+  (define n (string->number text))
+  (unless (and (exact-positive-integer? n))
+    (raise-arguments-error 'cut "only one positive field number is supported"
+                           "field" text))
+  n)
+
+(define (coreutils-cut . args)
+  (define delimiter "\t")
+  (define field #f)
+  (define files '())
+  (let loop ([rest args])
+    (cond
+      [(null? rest) (void)]
+      [(member (arg->string (car rest)) '("-d" "--delimiter"))
+       (unless (pair? (cdr rest))
+         (raise-arguments-error 'cut "missing delimiter" "arguments" args))
+       (set! delimiter (arg->string (cadr rest)))
+       (loop (cddr rest))]
+      [(member (arg->string (car rest)) '("-f" "--fields"))
+       (unless (pair? (cdr rest))
+         (raise-arguments-error 'cut "missing field" "arguments" args))
+       (set! field (parse-field-spec (arg->string (cadr rest))))
+       (loop (cddr rest))]
+      [(string-prefix? (arg->string (car rest)) "-")
+       (raise-arguments-error 'cut "unsupported option" "option" (car rest))]
+      [else
+       (set! files (append files (list (car rest))))
+       (loop (cdr rest))]))
+  (unless field
+    (raise-arguments-error 'cut "expected -f FIELD" "arguments" args))
+  (for ([line (in-list (read-lines-from-arguments files))])
+    (define parts (string-split line delimiter #:trim? #f #:repeat? #f))
+    (when (<= field (length parts))
+      (displayln (list-ref parts (sub1 field))))))
+
+(define (coreutils-tee . args)
+  (define append? #f)
+  (define files '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-a") (string=? text "--append")) (set! append? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'tee "unsupported option" "option" text)]
+      [else (set! files (append files (list (arg->path arg))))]))
+  (define outputs
+    (for/list ([path (in-list files)])
+      (open-output-file path #:exists (if append? 'append 'truncate/replace))))
+  (dynamic-wind
+    void
+    (λ ()
+      (let loop ()
+        (define bs (read-bytes 4096 (current-input-port)))
+        (unless (eof-object? bs)
+          (write-bytes bs (current-output-port))
+          (for ([out (in-list outputs)]) (write-bytes bs out))
+          (loop))))
+    (λ ()
+      (for ([out (in-list outputs)]) (close-output-port out)))))
+
+(define (expand-character-set text)
+  (define chars (string->list text))
+  (let loop ([rest chars] [result '()])
+    (cond
+      [(null? rest)
+       (reverse result)]
+      [(and (pair? (cdr rest))
+            (pair? (cddr rest))
+            (char=? (cadr rest) #\-)
+            (char<=? (car rest) (caddr rest)))
+       (define start (char->integer (car rest)))
+       (define end (char->integer (caddr rest)))
+       (define expanded
+         (for/list ([code (in-range start (add1 end))])
+           (integer->char code)))
+       (loop (cdddr rest) (append (reverse expanded) result))]
+      [else
+       (loop (cdr rest) (cons (car rest) result))])))
+
+(define (squeeze-characters text chars)
+  (define squeeze? (list->seteq chars))
+  (list->string
+   (let loop ([rest (string->list text)] [previous #f] [result '()])
+     (cond
+       [(null? rest) (reverse result)]
+       [else
+        (define ch (car rest))
+        (if (and previous
+                 (char=? ch previous)
+                 (set-member? squeeze? ch))
+            (loop (cdr rest) previous result)
+            (loop (cdr rest) ch (cons ch result)))]))))
+
+(define (translate-characters text from to)
+  (when (null? to)
+    (raise-arguments-error 'tr "SET2 must not be empty" "SET2" to))
+  (define last-to (last to))
+  (define mapping
+    (for/hash ([ch (in-list from)] [i (in-naturals)])
+      (values ch (if (< i (length to)) (list-ref to i) last-to))))
+  (list->string
+   (for/list ([ch (in-string text)])
+     (hash-ref mapping ch ch))))
+
+(define (delete-characters text chars)
+  (define delete-set (list->seteq chars))
+  (list->string
+   (for/list ([ch (in-string text)]
+              #:unless (set-member? delete-set ch))
+     ch)))
+
+(define (coreutils-tr . args)
+  (define delete? #f)
+  (define squeeze? #f)
+  (define sets '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-d") (string=? text "--delete"))
+       (set! delete? #t)]
+      [(or (string=? text "-s") (string=? text "--squeeze-repeats"))
+       (set! squeeze? #t)]
+      [(or (string=? text "-ds") (string=? text "-sd"))
+       (set! delete? #t)
+       (set! squeeze? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'tr "unsupported option" "option" text)]
+      [else
+       (set! sets (append sets (list text)))]))
+  (define text (port->string (current-input-port)))
+  (cond
+    [(and delete? squeeze?)
+     (unless (= (length sets) 2)
+       (raise-arguments-error 'tr "expected SET1 SET2 with -ds" "arguments" args))
+     (define deleted
+       (delete-characters text (expand-character-set (first sets))))
+     (display
+      (squeeze-characters deleted (expand-character-set (second sets))))]
+    [delete?
+     (unless (= (length sets) 1)
+       (raise-arguments-error 'tr "expected one character set with -d" "arguments" args))
+     (display
+      (delete-characters text (expand-character-set (first sets))))]
+    [(and squeeze? (= (length sets) 1))
+     (display
+      (squeeze-characters text (expand-character-set (first sets))))]
+    [else
+     (unless (= (length sets) 2)
+       (raise-arguments-error 'tr "expected SET1 SET2" "arguments" args))
+     (define to (expand-character-set (second sets)))
+     (define translated
+       (translate-characters text
+                             (expand-character-set (first sets))
+                             to))
+     (display
+      (if squeeze?
+          (squeeze-characters translated to)
+          translated))]))
+
+(define (coreutils-basename . args)
+  (unless (= (length args) 1)
+    (raise-arguments-error 'basename "expected one path" "arguments" args))
+  (define name (file-name-from-path (arg->path (car args))))
+  (displayln (if name (path->string name) "")))
+
+(define (coreutils-dirname . args)
+  (unless (= (length args) 1)
+    (raise-arguments-error 'dirname "expected one path" "arguments" args))
+  (define-values (base name dir?) (split-path (arg->path (car args))))
+  (displayln
+   (cond
+     [(path? base) (path->rash-string base)]
+     [(eq? base 'relative) "."]
+     [else (path->rash-string (arg->path (car args)))])))
+
+(define (coreutils-realpath . args)
+  (unless (= (length args) 1)
+    (raise-arguments-error 'realpath "expected one path" "arguments" args))
+  (displayln (path->rash-string (simplify-path (path->complete-path (arg->path (car args))) #t))))
+
+(define (coreutils-readlink . args)
+  (unless (= (length args) 1)
+    (raise-arguments-error 'readlink "expected one path" "arguments" args))
+  (define path (arg->path (car args)))
+  (unless (link-exists? path)
+    (raise-arguments-error 'readlink "path is not a symbolic link" "path" path))
+  (displayln (path->rash-string (resolve-path path))))
+
+(define (coreutils-stat . args)
+  (when (null? args)
+    (raise-arguments-error 'stat "expected at least one path" "arguments" args))
+  (for ([arg (in-list args)])
+    (define path (arg->path arg))
+    (unless (or (file-exists? path) (directory-exists? path) (link-exists? path))
+      (raise-arguments-error 'stat "path does not exist" "path" path))
+    (printf "Path: ~a\n" (path->rash-string (path->complete-path path)))
+    (printf "Type: ~a\n"
+            (cond [(link-exists? path) "link"]
+                  [(directory-exists? path) "directory"]
+                  [else "file"]))
+    (when (file-exists? path) (printf "Size: ~a\n" (file-size path)))
+    (printf "Modified: ~a\n" (file-or-directory-modify-seconds path))))
+
+(define (path-size path)
+  (cond
+    [(file-exists? path) (file-size path)]
+    [(directory-exists? path)
+     (for/sum ([entry (in-list (directory-list path #:build? #t))])
+       (path-size entry))]
+    [else 0]))
+
+(define (human-size n)
+  (cond
+    [(>= n (* 1024 1024 1024)) (format "~aG" (~r (/ n (* 1024.0 1024 1024)) #:precision '(= 1)))]
+    [(>= n (* 1024 1024)) (format "~aM" (~r (/ n (* 1024.0 1024)) #:precision '(= 1)))]
+    [(>= n 1024) (format "~aK" (~r (/ n 1024.0) #:precision '(= 1)))]
+    [else (format "~aB" n)]))
+
+(define (coreutils-du . args)
+  (define human? #f)
+  (define paths '())
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-h") (string=? text "--human-readable")) (set! human? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'du "unsupported option" "option" text)]
+      [else (set! paths (append paths (list (arg->path arg))))]))
+  (when (null? paths) (set! paths (list (current-directory))))
+  (for ([path (in-list paths)])
+    (define size (path-size path))
+    (printf "~a\t~a\n" (if human? (human-size size) size) (path->rash-string path))))
+
+(define (coreutils-df . args)
+  (unless (null? args)
+    (raise-arguments-error 'df "this portable implementation does not accept arguments yet"
+                           "arguments" args))
+  (displayln "Filesystem")
+  (for ([root (in-list (filesystem-root-list))])
+    (displayln (path->rash-string root))))
+
+(define (coreutils-mktemp . args)
+  (define directory? #f)
+  (define template "tmp~a")
+  (for ([arg (in-list args)])
+    (define text (arg->string arg))
+    (cond
+      [(or (string=? text "-d") (string=? text "--directory")) (set! directory? #t)]
+      [(string-prefix? text "-")
+       (raise-arguments-error 'mktemp "unsupported option" "option" text)]
+      [else (set! template text)]))
+  (define result (make-temporary-file template (if directory? 'directory #f)))
+  (displayln (path->rash-string result)))
+
+(define (environment-name->string name)
+  (bytes->string/locale name))
+
+(define (environment-value->string value)
+  (bytes->string/locale value))
+
+(define (write-environment env)
+  (define names
+    (sort (environment-variables-names env)
+          string<?
+          #:key environment-name->string))
+  (for ([name (in-list names)])
+    (define value (environment-variables-ref env name))
+    (when value
+      (printf "~a=~a\n" (environment-name->string name) (environment-value->string value)))))
+
+(define (coreutils-printenv . args)
+  (define env (current-environment-variables))
+  (if (null? args)
+      (write-environment env)
+      (for ([arg (in-list args)])
+        (define name (string->bytes/locale (arg->string arg)))
+        (define value (environment-variables-ref env name))
+        (when value (displayln (environment-value->string value))))))
+
+(define assignment-rx #px"^([^=]+)=(.*)$")
+
+(define (value->environment-string value)
+  (cond
+    [(string? value) value]
+    [(path? value) (path->string value)]
+    [(symbol? value) (symbol->string value)]
+    [(bytes? value) (bytes->string/locale value)]
+    [else (~a value)]))
+
+(define (split-environment-arguments args)
+  (let loop ([rest args] [assignments '()])
+    (cond
+      [(null? rest)
+       (values (reverse assignments) '())]
+      [(environment-assignment? (car rest))
+       (define assignment (car rest))
+       (loop (cdr rest)
+             (cons (cons (environment-assignment-name assignment)
+                         (environment-assignment-value assignment))
+                   assignments))]
+      [else
+       (define text (arg->string (car rest)))
+       (define match (regexp-match assignment-rx text))
+       (if match
+           (loop (cdr rest)
+                 (cons (cons (list-ref match 1)
+                             (list-ref match 2))
+                       assignments))
+           (values (reverse assignments) rest))])))
+
+(define (run-external-environment-command command)
+  (define executable
+    (find-executable-path (arg->string (car command))))
+  (unless executable
+    (raise-arguments-error 'env "command was not found on PATH"
+                           "command" (car command)))
+  (define ok?
+    (apply system* executable (map arg->string (cdr command))))
+  (unless ok?
+    (raise-arguments-error 'env "command returned a non-zero exit status"
+                           "command" (car command))))
+
+(define (coreutils-env . args)
+  (define-values (assignments command)
+    (split-environment-arguments args))
+  (define env
+    (environment-variables-copy (current-environment-variables)))
+  (for ([assignment (in-list assignments)])
+    (environment-variables-set!
+     env
+     (string->bytes/locale (car assignment))
+     (string->bytes/locale
+      (value->environment-string (cdr assignment)))))
+  (if (null? command)
+      (write-environment env)
+      (parameterize ([current-environment-variables env])
+        (define runner (current-coreutils-command-runner))
+        (define handled?
+          (and runner (runner command)))
+        (unless handled?
+          (run-external-environment-command command)))))
+
+(define (coreutils-date . args)
+  (define utc? #f)
+  (define iso? #f)
+  (define timezone #f)
+  (define pattern #f)
+  (let loop ([rest args])
+    (cond
+      [(null? rest) (void)]
+      [(member (arg->string (car rest)) '("-u" "--utc"))
+       (set! utc? #t)
+       (loop (cdr rest))]
+      [(member (arg->string (car rest)) '("-I" "--iso" "--iso-8601"))
+       (set! iso? #t)
+       (loop (cdr rest))]
+      [(string=? (arg->string (car rest)) "--tz")
+       (unless (pair? (cdr rest))
+         (raise-arguments-error 'date "missing time zone" "arguments" args))
+       (set! timezone (arg->string (cadr rest)))
+       (loop (cddr rest))]
+      [(string=? (arg->string (car rest)) "--format")
+       (unless (pair? (cdr rest))
+         (raise-arguments-error 'date "missing CLDR format" "arguments" args))
+       (set! pattern (arg->string (cadr rest)))
+       (loop (cddr rest))]
+      [else
+       (raise-arguments-error 'date "unsupported argument" "argument" (car rest))]))
+  (define m
+    (cond
+      [utc? (now/moment/utc)]
+      [timezone (now/moment #:tz timezone)]
+      [else (now/moment)]))
+  (displayln
+   (cond
+     [pattern (~t m pattern)]
+     [iso? (moment->iso8601 m)]
+     [else (~t m "EEE MMM dd HH:mm:ss xxx yyyy")])))

private/help.rkt

@@ -0,0 +1,63 @@
+#lang racket/base
+
+(require racket/format
+         racket/system
+         "commands.rkt"
+         "racket-tools.rkt")
+
+(provide coreutils-help
+         coreutils-help-search-term
+         raco-executable)
+
+(define (arg->string arg)
+  (cond
+    [(string? arg) arg]
+    [(symbol? arg) (symbol->string arg)]
+    [else (~a arg)]))
+
+(define (arg->symbol arg)
+  (cond
+    [(symbol? arg) arg]
+    [(string? arg) (string->symbol arg)]
+    [else #f]))
+
+(define (coreutils-help-search-term value)
+  (define name (arg->symbol value))
+  (define command (and name (find-coreutils-command name)))
+  (if command
+      (symbol->string (coreutils-command-documentation-term command))
+      (arg->string value)))
+
+(define (raco-executable)
+  (find-raco-executable))
+
+(define (open-racket-documentation search-term)
+  (define ok?
+    (system* (raco-executable)
+             "docs"
+             "--"
+             search-term))
+  (unless ok?
+    (raise-arguments-error 'help
+                           "raco docs failed"
+                           "search term" search-term)))
+
+(define (write-command-list)
+  (displayln "rash-coreutils commands:")
+  (for ([command (in-list coreutils-commands)])
+    (printf "  ~a\n" (coreutils-command-name command)))
+  (newline)
+  (displayln "Use: help <command> or <command> --help")
+  (displayln "Other terms are passed to Racket's documentation search."))
+
+(define (coreutils-help . args)
+  (cond
+    [(null? args)
+     (write-command-list)]
+    [(= (length args) 1)
+     (open-racket-documentation
+      (coreutils-help-search-term (car args)))]
+    [else
+     (raise-arguments-error 'help
+                            "expected zero or one search term"
+                            "arguments" args)]))

private/path-output.rkt

@@ -0,0 +1,17 @@
+#lang racket/base
+
+(require racket/format
+         racket/path
+         racket/string)
+
+(provide path->rash-string)
+
+(define (path->rash-string path)
+  (define text
+    (cond
+      [(path? path) (path->string path)]
+      [(string? path) path]
+      [else (path->string (string->path (~a path)))]))
+  (if (eq? (system-type 'os) 'windows)
+      (string-replace text "\\" "/")
+      text))

private/racket-tools.rkt

@@ -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))

scrbl/rash-coreutils.scrbl

@@ -0,0 +1,220 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     (only-in rash-coreutils
+                              coreutils-pwd coreutils-ls coreutils-mkdir coreutils-rmdir
+                              coreutils-rm coreutils-cp coreutils-mv coreutils-cat
+                              coreutils-touch coreutils-echo coreutils-which coreutils-head
+                              coreutils-tail coreutils-wc coreutils-sort coreutils-uniq
+                              coreutils-cut coreutils-tee coreutils-tr coreutils-basename
+                              coreutils-dirname coreutils-realpath coreutils-readlink
+                              coreutils-stat coreutils-du coreutils-df coreutils-mktemp
+                              coreutils-printenv coreutils-env coreutils-date
+                              raco
+                              coreutils-raco)))
+
+@title{rash-coreutils}
+@author["Hans Dijkema / hans@dijkewijk.nl"]
+
+@defmodule[rash-coreutils]
+
+@bold{rash-coreutils} provides platform-independent Unix-style shell commands
+for Rash. The commands are implemented in Racket, so common shell utilities do
+not depend on @tt{cmd.exe}, PowerShell, or Unix executables being installed.
+
+Rash remains responsible for shell syntax such as pipelines, globbing, tilde
+expansion, variable expansion, and redirection. @bold{rash-coreutils} supplies
+the commands themselves plus Racket-specific additions such as regular-expression
+path selectors.
+
+@section{Commands}
+
+The package provides @tt{pwd}, @tt{ls}, @tt{mkdir}, @tt{rmdir}, @tt{rm},
+@tt{cp}, @tt{mv}, @tt{cat}, @tt{touch}, @tt{echo}, @tt{which}, @tt{head},
+@tt{tail}, @tt{wc}, @tt{sort}, @tt{uniq}, @tt{cut}, @tt{tee}, @tt{tr},
+@tt{basename}, @tt{dirname}, @tt{realpath}, @tt{readlink}, @tt{stat}, @tt{du},
+@tt{df}, @tt{mktemp}, @tt{printenv}, @tt{env}, @tt{date}, @tt{raco}, and @tt{help}.
+
+The option set is deliberately smaller than GNU coreutils. Unsupported options
+raise an error instead of silently approximating another command's behavior.
+
+@section{Racket procedures}
+
+Each shell command has an explicitly named Racket procedure. All procedures
+write to the normal current ports so Rash pipeline and redirection semantics
+continue to work.
+
+@index["rash-coreutils-pwd"]
+@defproc[(coreutils-pwd) void?]{Writes the current directory.}
+
+@index["rash-coreutils-ls"]
+@defproc[(coreutils-ls [arg any/c] ...) void?]{Lists paths. Supports @tt{-a}, @tt{-l}, and their long forms.}
+
+@index["rash-coreutils-mkdir"]
+@defproc[(coreutils-mkdir [arg any/c] ...) void?]{Creates directories. Supports @tt{-p}.}
+
+@index["rash-coreutils-rmdir"]
+@defproc[(coreutils-rmdir [arg any/c] ...) void?]{Removes empty directories.}
+
+@index["rash-coreutils-rm"]
+@defproc[(coreutils-rm [arg any/c] ...) void?]{Removes paths. Supports recursive and force options.}
+
+@index["rash-coreutils-cp"]
+@defproc[(coreutils-cp [arg any/c] ...) void?]{Copies a source to a destination. Directory copies require @tt{-r}.}
+
+@index["rash-coreutils-mv"]
+@defproc[(coreutils-mv [source any/c] [destination any/c]) void?]{Moves or renames a path.}
+
+@index["rash-coreutils-cat"]
+@defproc[(coreutils-cat [arg any/c] ...) void?]{Copies files, or standard input, to standard output.}
+
+@index["rash-coreutils-touch"]
+@defproc[(coreutils-touch [arg any/c] ...) void?]{Updates modification times or creates empty files.}
+
+@index["rash-coreutils-echo"]
+@defproc[(coreutils-echo [arg any/c] ...) void?]{Writes arguments separated by spaces.}
+
+@index["rash-coreutils-which"]
+@defproc[(coreutils-which [arg any/c] ...) void?]{Finds executables using Racket's executable search.}
+
+@index["rash-coreutils-head"]
+@defproc[(coreutils-head [arg any/c] ...) void?]{Writes the first lines of input. Supports @tt{-n}.}
+
+@index["rash-coreutils-tail"]
+@defproc[(coreutils-tail [arg any/c] ...) void?]{Writes the last lines of input. Supports @tt{-n}.}
+
+@index["rash-coreutils-wc"]
+@defproc[(coreutils-wc [arg any/c] ...) void?]{Counts lines, words, and bytes. Supports @tt{-l}, @tt{-w}, and @tt{-c}.}
+
+@index["rash-coreutils-sort"]
+@defproc[(coreutils-sort [arg any/c] ...) void?]{Sorts lines. Supports @tt{-r} and @tt{-n}.}
+
+@index["rash-coreutils-uniq"]
+@defproc[(coreutils-uniq [arg any/c] ...) void?]{Collapses adjacent duplicate lines. Supports @tt{-c}.}
+
+@index["rash-coreutils-cut"]
+@defproc[(coreutils-cut [arg any/c] ...) void?]{Selects one delimited field with @tt{-d} and @tt{-f}.}
+
+@index["rash-coreutils-tee"]
+@defproc[(coreutils-tee [arg any/c] ...) void?]{Copies standard input to standard output and files. Supports @tt{-a}.}
+
+@index["rash-coreutils-tr"]
+@defproc[(coreutils-tr [arg any/c] ...) void?]{Translates characters from standard input. Character ranges such as @tt{a-z}, @tt{A-Z}, and @tt{0-9} are expanded. @tt{-d} deletes characters and @tt{-s} squeezes repeated characters.}
+
+@index["rash-coreutils-basename"]
+@defproc[(coreutils-basename [path any/c]) void?]{Writes the final path component.}
+
+@index["rash-coreutils-dirname"]
+@defproc[(coreutils-dirname [path any/c]) void?]{Writes the directory portion of a path.}
+
+@index["rash-coreutils-realpath"]
+@defproc[(coreutils-realpath [path any/c]) void?]{Writes a complete simplified path.}
+
+@index["rash-coreutils-readlink"]
+@defproc[(coreutils-readlink [path any/c]) void?]{Resolves a symbolic link.}
+
+@index["rash-coreutils-stat"]
+@defproc[(coreutils-stat [path any/c] ...) void?]{Writes basic portable path metadata.}
+
+@index["rash-coreutils-du"]
+@defproc[(coreutils-du [arg any/c] ...) void?]{Calculates recursive file size. Supports @tt{-h}.}
+
+@index["rash-coreutils-df"]
+@defproc[(coreutils-df) void?]{Lists filesystem roots. Racket has no portable API for total and free filesystem capacity, so this initial implementation deliberately does not invent platform-specific subprocess fallbacks.}
+
+@index["rash-coreutils-mktemp"]
+@defproc[(coreutils-mktemp [arg any/c] ...) void?]{Creates a temporary file, or a directory with @tt{-d}, and writes its path.}
+
+@index["rash-coreutils-printenv"]
+@defproc[(coreutils-printenv [name any/c] ...) void?]{Writes environment variables.}
+
+@index["rash-coreutils-env"]
+@defproc[(coreutils-env [arg any/c] ...) void?]{Creates a copied environment, applies leading @tt{NAME=value} assignments, and either writes that environment or runs the remaining command in it. Racket values are converted to environment strings.}
+
+The Rash form can mix shell-style assignment names with Racket expressions:
+
+@verbatim{
+(define x 42)
+env ANSWER=(values x) printenv ANSWER
+}
+
+A parenthesized expression in Rash line mode is ordinary Racket code. Therefore
+the value after an empty @tt{NAME=} token can be a number, symbol, path, string,
+or another printable Racket value.
+
+@index["rash-coreutils-date"]
+@defproc[(coreutils-date [arg any/c] ...) void?]{Writes the current date and time using Gregor. Supports @tt{-u}/@tt{--utc}, @tt{-I}/@tt{--iso}, @tt{--tz ZONE}, and @tt{--format CLDR-PATTERN}. The format pattern follows Gregor's CLDR syntax rather than pretending to implement every GNU @tt{date} format escape.}
+
+@verbatim{
+date
+date --iso
+date --utc --iso
+date --tz Europe/Amsterdam --format "yyyy-MM-dd HH:mm:ss"
+}
+
+@index["rash-coreutils-raco"]
+@defproc[(raco [arg any/c] ...) void?]{Runs @tt{raco} from the current Racket installation. The executable is resolved from the active Racket installation before PATH is considered, so it also works on Windows when @tt{raco.exe} is not on PATH. Arguments may be strings, symbols, paths, numbers, or nested lists. With no arguments, the underlying @tt{raco} program is invoked without a subcommand.}
+
+@defproc[(coreutils-raco [arg any/c] ...) void?]{Explicit implementation name for @racket[raco].}
+
+@verbatim{
+raco setup rash-coreutils
+raco pkg show
+}
+
+The same @racket[raco] binding is a normal Racket procedure, so expression-mode code can use @racket[(raco '(setup rash-coreutils))]. The explicit implementation name @racket[coreutils-raco] is also exported.
+
+@section{Path selection}
+
+Shell-style argument expansion remains Rash's responsibility. The aliases expand
+back into Rash's @tt{=unix-pipe=} operator, preserving Rash globbing, tilde
+expansion, and @tt{$} expansion.
+
+@verbatim{
+ls *.rkt
+ls -l info*
+cat info*
+}
+
+Regular-expression values are an additional @bold{rash-coreutils} selector. A
+@racket[#rx""] or @racket[#px""] value is matched against entry names in the
+current directory.
+
+@verbatim{
+ls #px"^info[0-9]+[.]rkt$"
+}
+
+
+@section{Windows paths}
+
+On Windows, commands that write path names use forward slashes in their textual output. Rash treats backslashes as escape characters in line mode, so a printed path such as @tt{C:/Users/name/AppData/Local/Temp/file} can be copied directly into another Rash command. Racket path values themselves remain native and can be passed directly to a command through a Racket expression.
+
+@section{Help}
+
+@tt{help} uses Racket's documentation search through @tt{raco docs}. Registered
+commands use package-specific index terms such as @tt{rash-coreutils-ls}.
+
+@verbatim{
+help
+help ls
+ls --help
+help directory-list
+}
+
+@section{Capturing and redirecting output}
+
+Commands use normal ports. Rash can therefore capture or redirect them without
+special support in this package.
+
+@verbatim{
+(define git-path { which git |> read-line })
+ls &> listing.txt
+cat info.rkt &>! copy.rkt
+}
+
+@section{Compatibility scope}
+
+The command names and common options follow Unix conventions, but this package
+does not claim complete GNU coreutils compatibility. Platform-independent
+behavior, predictable Rash scripting, and useful integration with Racket values
+are the primary goals.

tests/acceptance-tests.rkt

@@ -0,0 +1,3 @@
+#lang rash
+
+(require rash-coreutils)

tests/coreutils.rkt

@@ -0,0 +1,166 @@
+#lang racket/base
+
+(require rackunit
+         racket/path
+         racket/file
+         racket/port
+         "../private/coreutils.rkt"
+         "../private/extended.rkt"
+         "../private/dispatcher.rkt"
+         "../private/help.rkt"
+         "../private/racket-tools.rkt"
+         "../private/env-support.rkt")
+
+(define (capture-output procedure . args)
+  (with-output-to-string
+    (λ ()
+      (apply procedure args))))
+
+(define (capture-filter input procedure . args)
+  (parameterize ([current-input-port (open-input-string input)])
+    (apply capture-output procedure args)))
+
+(define test-root (make-temporary-file "rash-coreutils-~a" 'directory))
+
+(dynamic-wind
+ void
+ (λ ()
+   (parameterize ([current-directory test-root])
+     (coreutils-mkdir "a")
+     (check-true (directory-exists? "a"))
+
+     (coreutils-mkdir "-p" "b/c")
+     (check-true (directory-exists? "b/c"))
+
+     (coreutils-touch "one.txt")
+     (check-true (file-exists? "one.txt"))
+
+     (call-with-output-file "one.txt"
+       #:exists 'truncate
+       (λ (out)
+         (display "hello\n" out)))
+     (check-equal? (capture-output coreutils-cat "one.txt") "hello\n")
+
+     (coreutils-cp "one.txt" "two.txt")
+     (check-true (file-exists? "two.txt"))
+
+     (coreutils-mv "two.txt" "three.txt")
+     (check-false (file-exists? "two.txt"))
+     (check-true (file-exists? "three.txt"))
+
+     (check-equal? (capture-output coreutils-echo "hello" "world")
+                   "hello world\n")
+
+     (check-true (regexp-match? #rx"one[.]txt"
+                                (capture-output coreutils-ls)))
+
+     (define long-listing (capture-output coreutils-ls "-l"))
+     (check-true (regexp-match? #rx"[-] +[0-9]+ +one[.]txt"
+                                long-listing))
+
+     (coreutils-touch ".hidden")
+     (define long-all-listing (capture-output coreutils-ls "-la"))
+     (check-true (regexp-match? #rx"[-] +[0-9]+ +[.]hidden"
+                                long-all-listing))
+
+     (coreutils-touch "info1.rkt")
+     (coreutils-touch "info22.rkt")
+     (coreutils-touch "other.rkt")
+
+     (define regexp-arguments
+       (expand-coreutils-arguments (list #px"^info[0-9]+[.]rkt$")))
+     (check-equal?
+      (sort (map (λ (path)
+                   (path->string (file-name-from-path path)))
+                 regexp-arguments)
+            string<?)
+      (list "info1.rkt" "info22.rkt"))
+
+     (define regexp-listing
+       (with-output-to-string
+         (λ ()
+           (dispatch-coreutils-command
+            'ls
+            #px"^info[0-9]+[.]rkt$"))))
+     (check-true (regexp-match? #rx"info1[.]rkt" regexp-listing))
+     (check-true (regexp-match? #rx"info22[.]rkt" regexp-listing))
+     (check-false (regexp-match? #rx"other[.]rkt" regexp-listing))
+
+     (define multiple-file-listing
+       (capture-output coreutils-ls "info1.rkt" "info22.rkt"))
+     (check-equal? multiple-file-listing
+                   "info1.rkt\ninfo22.rkt\n")
+
+     (check-equal? (coreutils-help-search-term 'ls) "rash-coreutils-ls")
+     (check-equal? (coreutils-help-search-term 'directory-list)
+                   "directory-list")
+     (check-equal? (coreutils-help-search-term 'raco) "rash-coreutils-raco")
+     (check-true (path? (find-raco-executable)))
+     (check-true (procedure? coreutils-raco))
+
+     (call-with-output-file "lines.txt"
+       #:exists 'truncate
+       (λ (out)
+         (display "one\ntwo\nthree\n" out)))
+     (check-equal? (capture-output coreutils-head "-n" "2" "lines.txt")
+                   "one\ntwo\n")
+     (check-equal? (capture-output coreutils-tail "-n" "1" "lines.txt")
+                   "three\n")
+     (check-equal? (capture-output coreutils-wc "-l" "lines.txt")
+                   "3\n")
+     (check-equal? (capture-output coreutils-basename "a/b/c.txt")
+                   "c.txt\n")
+     (check-equal? (capture-filter "abcde\n" coreutils-tr "a-z" "A-Z")
+                   "ABCDE\n")
+     (check-equal? (capture-filter "a1b2c3\n" coreutils-tr "-d" "0-9")
+                   "abc\n")
+     (check-equal? (capture-filter "a   b\n" coreutils-tr "-s" " ")
+                   "a b\n")
+     (check-true (regexp-match? #rx"a[/\\]b"
+                                (capture-output coreutils-dirname "a/b/c.txt")))
+
+     (define saved-env (getenv "RASH_COREUTILS_TEST"))
+     (define env-output
+       (parameterize ([current-coreutils-command-runner
+                       (λ (command)
+                         (and (equal? command '(printenv RASH_COREUTILS_VALUE))
+                              (begin
+                                (coreutils-printenv 'RASH_COREUTILS_VALUE)
+                                #t)))])
+         (capture-output
+          coreutils-env
+          (environment-assignment "RASH_COREUTILS_VALUE" 42)
+          'printenv
+          'RASH_COREUTILS_VALUE)))
+     (check-equal? env-output "42\n")
+
+     (dynamic-wind
+       void
+       (λ ()
+         (putenv "RASH_COREUTILS_TEST" "before")
+         (check-equal? (capture-output coreutils-printenv "RASH_COREUTILS_TEST")
+                       "before\n"))
+       (λ ()
+         (if saved-env
+             (putenv "RASH_COREUTILS_TEST" saved-env)
+             (putenv "RASH_COREUTILS_TEST" #f))))
+
+     (check-true (regexp-match? #rx"[0-9]{4}-[0-9]{2}-[0-9]{2}T"
+                                (capture-output coreutils-date "--iso")))
+
+     (check-exn
+      exn:fail?
+      (λ ()
+        (expand-coreutils-arguments (list #px"^does-not-exist$"))))
+
+     (coreutils-rm "three.txt")
+     (check-false (file-exists? "three.txt"))
+
+     (coreutils-rm "-r" "b")
+     (check-false (directory-exists? "b"))
+
+     (coreutils-rmdir "a")
+     (check-false (directory-exists? "a"))))
+ (λ ()
+   (when (directory-exists? test-root)
+     (delete-directory/files test-root))))

tests/rash-smoke.rkt

@@ -0,0 +1,21 @@
+#lang rash
+
+(require rash-coreutils)
+
+mkdir -p rash-coreutils-smoke/a
+
+echo hello from rash-coreutils
+ls -l rash-coreutils-smoke
+ls *.rkt
+ls #px"^info[.]rkt$"
+
+(define x 42)
+env RASH_COREUTILS_VALUE=(values x) printenv RASH_COREUTILS_VALUE
+
+echo one two three | wc -w
+echo c b a | sort
+
+date --iso
+raco help
+help
+rm -r rash-coreutils-smoke