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