two-servers.rkt

#lang racket/base

(require racket/function)

(struct command (subproc stdout stdin))

(define (start cmd-str . args)
  (define-values (subp out in _err)
    (if (null? args)
        ; 'new is important - without it, killing the subprocess will not
        ; kill any of its subprocesses
        (subprocess #f #f 'stdout 'new cmd-str)
        (apply subprocess #f #f 'stdout 'new cmd-str args)))
  (command subp out in))

(define (flush/close cmd flush-proc #:kill? [kill? #f])
  (when kill? (subprocess-kill (command-subproc cmd) #t))
  (flush-proc (command-stdout cmd))
  (close-input-port (command-stdout cmd))
  (close-output-port (command-stdin cmd)))

(define read-avail-string
  (let ([buffer-bytes (make-bytes 1000 65)])
    (λ (p)
      (define bcount (read-bytes-avail! buffer-bytes p))
      (if (eof-object? bcount) "" (bytes->string/utf-8 (subbytes buffer-bytes 0 bcount))))))

(define (handle-port-data! p)
  (display (read-avail-string p)))

(define current-command (void))
(define current-monitor-thread (void))

(define (start/monitor cmd-str . args)
  (set! current-command (apply start cmd-str args))
  (define stdout (command-stdout current-command))
    
  (set! current-monitor-thread
        (thread
         (thunk
          (with-handlers
              ([exn:break?
                (thunk* (flush/close current-command handle-port-data! #:kill? #t)
                        (display "🛑\n"))])
            (let loop ()
              (sync/enable-break
               (handle-evt stdout (λ (p) (handle-port-data! p) (loop)))
               (handle-evt (command-subproc current-command)
                           (thunk* (flush/close current-command handle-port-data!)
                                   (display "🟦\n"))))))))))

(define cmds
  #hasheq((pollen . ("pollen" "start"))
          (sw . ("static-web"))))

(define dirs
  #hasheq((pollen . "/Users/joel/code/try-pollen")
          (sw . "/Users/joel/code/joeldueckdotcom/jdcom/publish")))

(define (go [v 'sw])
  (current-directory (hash-ref dirs v))
  (apply start/monitor "/Applications/Racket v8.7/bin/raco" (hash-ref cmds v)))

(define (end)
  (break-thread current-monitor-thread))

Contrast with: