racket-makefile/main.rkt

#lang racket/base

(require (except-in racket #%module-begin)
         (only-in racket/base [#%module-begin racket-module-begin])
         (for-syntax racket/base)
         "private/commands.rkt"
         "private/engine.rkt"
         git-cli
         package-zipper
         )

(provide (all-from-out racket)
         (rename-out [makefile-module-begin #%module-begin])
         target
         deps
         phony
         default-target
         make
         refresh-makefile
         run
         raco
         rm-f
         rm-rf
         cleanup
         list-dir/files
         list-files
         list-dirs
         $target
         $deps
         $<
         (all-from-out git-cli)
         (all-from-out package-zipper)
         )


;; The makefile module currently loaded in this Racket process.  Keeping only
;; its source path is enough: target state lives in the engine and is rebuilt
;; when the makefile module is evaluated again.
(define loaded-makefile #f)

(define (remember-makefile! path)
  (set! loaded-makefile path)
  (void))

(define-for-syntax (remember-source-form stx)
  (define source (syntax-source stx))
  (if (path? source)
      #`(remember-makefile! (string->path #,(path->string source)))
      #'(void)))

(define (refresh-makefile)
  (unless loaded-makefile
    (error 'refresh-makefile "no racket-makefile has been loaded"))
  (define source loaded-makefile)
  (define directory (or (path-only source) (current-directory)))
  ;; Load the edited makefile as a fresh module in the same namespace. Its
  ;; required modules therefore reuse their existing module instances, while
  ;; the makefile body itself runs again and re-registers all targets.
  (define refresh-source
    (make-temporary-file "racket-makefile-refresh~a.rkt" #f directory))
  (copy-file source refresh-source #t)
  ;; With #lang racket, main.rkt is only required and our custom module-begin
  ;; does not run. Reset explicitly so removed/renamed targets disappear too.
  (reset-makefile!)
  (dynamic-wind
    void
    (lambda ()
      (dynamic-require refresh-source #f))
    (lambda ()
      ;; Loading the temporary copy also runs remember-makefile!. Keep the
      ;; original source as the file to use for the next refresh.
      (set! loaded-makefile source)
      (delete-file refresh-source)))
  (void))

;; For target declarations we want a bound identifier to remain an ordinary
;; Racket expression. This makes generated targets such as (target obj ...)
;; possible inside a for loop. An unbound identifier is a literal target name.
(define-for-syntax (literal-name-or-expression stx)
  (if (and (identifier? stx)
           (not (identifier-binding stx)))
      (datum->syntax stx `(quote ,(syntax-e stx)) stx stx)
      stx))

;; For interactive make invocations a bare identifier is always a literal
;; target name. Thus (make compile) means the target named "compile" even if
;; Racket happens to provide a binding named compile.
(define-for-syntax (literal-make-name stx)
  (if (identifier? stx)
      (datum->syntax stx `(quote ,(syntax-e stx)) stx stx)
      stx))

(define-syntax (makefile-module-begin stx)
  (syntax-case stx ()
    [(_ form ...)
     #'(racket-module-begin
        (reset-makefile!)
        (remember-makefile!
         (variable-reference->module-source (#%variable-reference)))
        form ...
        ;; Re-export make so that `racket -t Makefile.rkt -e "(make all)"`
        ;; imports the make form into the command-line evaluation namespace.
        (provide make refresh-makefile quote #%top-interaction #%app #%datum #%top))]))

(define-syntax (deps stx)
  (raise-syntax-error 'deps "only valid as the dependency clause of target" stx))

(define-syntax (target stx)
  (syntax-case stx (deps)
    [(_ name (deps dependency ...) body ...)
     (with-syntax ([target-name (literal-name-or-expression #'name)]
                   [(target-dependency ...)
                    (map literal-name-or-expression
                         (syntax->list #'(dependency ...)))])
       (with-syntax ([remember-source (remember-source-form stx)])
         #'(begin
             remember-source
             (register-target!
              target-name
              (list target-dependency ...)
              (lambda () body ... (void))))))]
    [(_ name body ...)
     (with-syntax ([target-name (literal-name-or-expression #'name)]
                   [remember-source (remember-source-form stx)])
       #'(begin
           remember-source
           (register-target!
            target-name
            '()
            (lambda () body ... (void)))))]))

(define-syntax (phony stx)
  (syntax-case stx ()
    [(_ name ...)
     (with-syntax ([(target-name ...)
                    (map literal-name-or-expression
                         (syntax->list #'(name ...)))]
                   [remember-source (remember-source-form stx)])
       #'(begin
           remember-source
           (mark-phony! target-name ...)))]))

(define-syntax (default-target stx)
  (syntax-case stx ()
    [(_ name)
     (with-syntax ([target-name (literal-name-or-expression #'name)]
                   [remember-source (remember-source-form stx)])
       #'(begin
           remember-source
           (set-default-target! target-name)))]))

(define-syntax (make stx)
  (syntax-case stx ()
    [(_ name ...)
     (with-syntax ([(target-name ...)
                    (map literal-make-name
                         (syntax->list #'(name ...)))])
       #'(make-targets! target-name ...))]))

(define-syntax $target
  (syntax-id-rules ()
    [$target
     (or (current-target)
         (error '$target "$target is only available while a target recipe is running"))]))

(define-syntax $deps
  (syntax-id-rules ()
    [$deps
     (or (current-dependencies)
         (error '$deps "$deps is only available while a target recipe is running"))]))

(define-syntax $<
  (syntax-id-rules ()
    [$<
     (or (current-first-dependency)
         (error '$< "$< is only available while a target recipe with dependencies is running"))]))