Recompile and restart

#lang racket/gui

;;; Recompile and restart test
;;; Author: Laurent Orseau <laurent orseau gmail com> -- 2013-01-11
;;; License: WTFPL - http://www.wtfpl.net

(require racket/runtime-path
         mzlib/os ; for getpid (warning: deprecated)
         compiler/cm
         )

; TODO: Shouldn't we wait for the parent to finish?

(define pid (getpid))

(define-runtime-path this-file (syntax-source-module #'here #t))

(define (dprintf fmt . lstr)
  (apply printf (string-append "[" (number->string pid) "] " fmt) lstr))

(define (wait-msg str)
  (dprintf "~a... " str))

(define (ok)
  (printf "Ok.\n"))

(define (recompile-restart)
  (define this-file-string (path->string this-file))

  (wait-msg "Modifying file")
  (display-lines-to-file
   (list (~s `(dprintf ,(string-append "Ancestor: " (number->string pid) "\n"))))
   this-file #:exists 'append)
  (ok)

  (with-handlers ([exn:fail?
                   (λ(e)
                     (dprintf "Something went wrong during recompile & restart:\n")
                     (displayln (exn-message e))
                     (dprintf "Aborting procedure.\n"))])
    ; Recompile this file (like "raco make ....")
    (wait-msg "Recompiling")
    (managed-compile-zo this-file)
    (ok)

    (wait-msg "Running child")
    (define-values (sp a b c)
      (subprocess (current-output-port) (current-input-port) (current-error-port)
                  (find-executable-path (find-system-path 'exec-file))
                  this-file-string))
    (ok)

    ; I don't think I need to close the ports since we use our parent's ones
    ;(displayln (list sp a b c))

    ; If all went ok, terminate program by hiding the frame
    (wait-msg "Closing frame")
    (send my-frame show #f)
    (ok)

    (newline)
    ; Make sure to exit in case anything hangs (like some non-closed frame%)
    (exit)
    ))

;;; A simple GUI
(define my-frame (new frame% [label "my-frame"] [min-width 200] [min-height 200]))
(define bt (new button% [parent my-frame] [label "Recompile && Restart"]
                [callback (λ(bt ev)(recompile-restart))]))


(send my-frame show #t)
(dprintf "I'm alive!\n")