#lang racket/base

(require (prefix-in main: "main.ss")
         srfi/8
         unstable/pretty
         racket/system)

(define (open-output-nowhere)
  (define-values (input output) (make-pipe))
  (thread
   (λ ()
     (define buf (make-bytes 1024))
     (let loop ()
       (when (not (eof-object? (read-bytes! buf input)))
         (loop)))))
  output)

(define racket (find-executable-path "racket"))
(define gracket (find-executable-path "gracket"))
(define chmod (find-executable-path "chmod"))

(define (build-path-hack d f)
  (let ((f (if (path? f) f (build-path f))))
    (if (absolute-path? f) f
        (build-path d f))))

(define (generate filename)
  (let ((filename (build-path-hack (current-directory) filename)))
    (define needs-gui? (not (parameterize
                                ((current-error-port (open-output-nowhere)))
                              (system* racket "-l" "racket/base" "-t" (path->string filename)))))
    (receive (base name is-dir?) (split-path filename)
      (let* ((that-mod (path->string name))
             (this-mod (string->symbol (string-append "run-" that-mod)))
             (wrapper (build-path base (regexp-replace #rx"\\.[^\\.]*" that-mod ""))))
        (with-output-to-file wrapper
          #:exists 'replace
          (λ ()
            (display (format "#!~a -t-" (path->string (if needs-gui? gracket racket))))
            (newline)
            (display
             (pretty-format/write
              `(module ,this-mod racket/base
                 (require (prefix-in main: (planet synx/main:1))
                          (prefix-in sub: (file ,(path->string filename))))
                          (main:run))))
                     (newline)))
        (system* chmod "+x" (path->string wrapper)))))
   (void))

(main:register! generate)

(provide generate)