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