#lang racket/base

(require racket/list)

(provide register-target!
         mark-phony!
         set-default-target!
         reset-makefile!
         run-selected-target!
         current-target
         current-dependencies
         current-first-dependency)

(struct target-definition (name dependencies recipe) #:transparent)

(define targets (make-hash))
(define phony-targets (make-hash))
(define target-order '())
(define default-target-name #f)

(define current-target (make-parameter #f))
(define current-dependencies (make-parameter #f))
(define current-first-dependency (make-parameter #f))

(define (target-key value)
  (cond
    [(symbol? value) (symbol->string value)]
    [(path? value) (path->string value)]
    [(string? value) value]
    [else (raise-argument-error 'target "(or/c symbol? path-string?)" value)]))

(define (reset-makefile!)
  (hash-clear! targets)
  (hash-clear! phony-targets)
  (set! target-order '())
  (set! default-target-name #f))

(define (target-keys value)
  (if (list? value)
      (append-map target-keys value)
      (list (target-key value))))

(define (register-target! name dependencies recipe)
  (define key (target-key name))
  (unless (hash-has-key? targets key)
    (set! target-order (append target-order (list key))))
  (hash-set! targets
             key
             (target-definition key
                                (append-map target-keys dependencies)
                                recipe))
  (void))

(define (mark-phony! . names)
  (for* ([name (in-list names)]
         [key (in-list (target-keys name))])
    (hash-set! phony-targets key #t))
  (void))

(define (set-default-target! name)
  (set! default-target-name (target-key name))
  (void))

(define (phony? name)
  (hash-ref phony-targets name #f))

(define (path-modify-seconds path)
  (file-or-directory-modify-seconds path #f (lambda () #f)))

(define (dependency-time name built-results)
  (cond
    [(phony? name) +inf.0]
    [(hash-has-key? targets name)
     (define result (hash-ref built-results name #f))
     (or (path-modify-seconds name)
         (and result +inf.0)
         #f)]
    [else
     (or (path-modify-seconds name)
         (error 'racket-makefile "dependency does not exist and has no target: ~a" name))]))

(define (needs-build? definition built-results)
  (define name (target-definition-name definition))
  (cond
    [(phony? name) #t]
    [else
     (define target-time (path-modify-seconds name))
     (cond
       [(not target-time) #t]
       [else
        (for/or ([dependency (in-list (target-definition-dependencies definition))])
          (define dep-time (dependency-time dependency built-results))
          (and dep-time (> dep-time target-time)))])]))

(define (execute-target! definition)
  (define name (target-definition-name definition))
  (define dependencies (target-definition-dependencies definition))
  (printf "racket-makefile: ~a\n" name)
  (parameterize ([current-target name]
                 [current-dependencies dependencies]
                 [current-first-dependency (and (pair? dependencies) (car dependencies))])
    ((target-definition-recipe definition))))

(define (build-target! name built-results visiting)
  (define key (target-key name))
  (cond
    [(hash-has-key? built-results key)
     (hash-ref built-results key)]
    [(hash-has-key? visiting key)
     (error 'racket-makefile "dependency cycle involving target: ~a" key)]
    [else
     (define definition
       (hash-ref targets key
                 (lambda ()
                   (error 'racket-makefile "unknown target: ~a" key))))
     (hash-set! visiting key #t)
     (for ([dependency (in-list (target-definition-dependencies definition))])
       (if (hash-has-key? targets dependency)
           (build-target! dependency built-results visiting)
           (unless (path-modify-seconds dependency)
             (error 'racket-makefile
                    "dependency does not exist and has no target: ~a"
                    dependency))))
     (define rebuilt? (needs-build? definition built-results))
     (when rebuilt?
       (execute-target! definition))
     (hash-remove! visiting key)
     (hash-set! built-results key rebuilt?)
     rebuilt?]))

(define (selected-targets)
  (define args (vector->list (current-command-line-arguments)))
  (cond
    [(pair? args) args]
    [default-target-name (list default-target-name)]
    [(pair? target-order) (list (car target-order))]
    [else '()]))

(define (run-selected-target!)
  (define names (selected-targets))
  (when (null? names)
    (error 'racket-makefile "no target defined"))
  (define built-results (make-hash))
  (define visiting (make-hash))
  (for ([name (in-list names)])
    (build-target! name built-results visiting))
  (void))