#lang racket/base

(require file/glob
         racket/file
         racket/list
         racket/path
         racket/string
         racket/system
         setup/dirs
         "engine.rkt")

(provide run
         raco
         rm-f
         rm-rf
         cleanup
         list-dir/files
         list-files
         list-dirs)

(define (recipe-value who parameter description)
  (define value (parameter))
  (unless value
    (error who "~a is only available while a target recipe is running" description))
  value)

(define (command-item->strings who value)
  (cond
    [(eq? value '$target)
     (list (recipe-value who current-target "$target"))]
    [(eq? value '$deps)
     (recipe-value who current-dependencies "$deps")]
    [(eq? value '$<)
     (define first (current-first-dependency))
     (unless first
       (error who "$< is not available: this target has no dependencies"))
     (list first)]
    [(symbol? value) (list (symbol->string value))]
    [(path? value) (list (path->string value))]
    [(string? value) (list value)]
    [(number? value) (list (number->string value))]
    [(list? value) (append-map (lambda (item) (command-item->strings who item)) value)]
    [else
     (raise-argument-error
      who
      "command item (string, symbol, path, number, or list)"
      value)]))

(define (run command)
  (unless (list? command)
    (raise-argument-error 'run "list?" command))
  (define arguments
    (append-map (lambda (item) (command-item->strings 'run item)) command))
  (when (null? arguments)
    (error 'run "empty command"))
  (define program (car arguments))
  (define executable
    (or (find-executable-path program)
        (and (file-exists? program) (path->complete-path program))
        (error 'run "executable not found: ~a" program)))
  (printf "> ~a\n" (string-join arguments " "))
  (unless (apply system* executable (cdr arguments))
    (error 'run "command failed: ~a" program))
  (void))


(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 reported by the current Racket
  ;; installation. This does not depend on PATH and therefore also works for
  ;; typical Windows installations under Program Files.
  (define console-bin
    (with-handlers ([exn:fail? (lambda (_) #f)])
      (find-console-bin-dir)))
  (define from-console-bin
    (existing-raco-in console-bin))

  ;; A useful fallback for portable/non-standard installations: raco normally
  ;; lives alongside the currently running racket executable.
  (define exec-file
    (with-handlers ([exn:fail? (lambda (_) #f)])
      (find-system-path 'exec-file)))
  (define from-exec-dir
    (and exec-file
         (existing-raco-in (path-only exec-file))))

  ;; PATH is intentionally last; it might refer to a different Racket install.
  (or from-console-bin
      from-exec-dir
      (find-executable-path (raco-executable-name))
      (error 'raco "cannot find raco for the current Racket installation")))

(define (raco command)
  (unless (list? command)
    (raise-argument-error 'raco "list?" command))
  (define arguments
    (append-map (lambda (item) (command-item->strings 'raco item)) command))
  (when (null? arguments)
    (error 'raco "empty 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" (car arguments)))
  (void))

(define (rm-f . paths)
  (for ([path (in-list paths)])
    (case (file-or-directory-type path #f)
      [(file link) (delete-file path)]
      [(directory-link) (delete-directory path)]
      [(directory)
       (error 'rm-f "refusing to remove directory without recursion: ~a" path)]
      [else (void)]))
  (void))

(define (rm-rf . paths)
  (for ([path (in-list paths)])
    (delete-directory/files path #:must-exist? #f))
  (void))

(define (cleanup directory patterns)
  (unless (list? patterns)
    (raise-argument-error 'cleanup "list?" patterns))
  (for* ([pattern (in-list patterns)]
         [path (in-glob (build-path directory pattern))])
    (case (file-or-directory-type path #f)
      [(file link) (rm-f path)]
      [else (void)]))
  (void))

(define (list-dir/files directory regexp #:recursive [recursive #f])
  (filter (lambda (path)
            (let ((fn (file-name-from-path path)))
              (regexp-match? regexp fn)))
          (if recursive
              (for/list ([path (in-directory directory)])
                path)
              (directory-list directory #:build? #t))))

(define (list-files directory regexp #:recursive [recursive #f])
  (filter file-exists?
          (list-dir/files directory regexp #:recursive recursive)))

(define (list-dirs directory regexp #:recursive [recursive #f])
  (filter directory-exists?
          (list-dir/files directory regexp #:recursive recursive)))