Welcome to the CHICKEN Scheme pasting service

(module live-coding
  (export define-once
          autoreload
          reload-source-files
          register-source-file
          unbound-variable?)
  (import scheme chicken)

(use (only posix current-directory file-modification-time))
(use (only srfi-1 filter-map))
(use (only filepath
           filepath:combine
           filepath:make-relative
           filepath:take-directory))

(use logging)

(define source-files '())
(define *source-root* (get-environment-variable "LIVE_SOURCE_ROOT"))
(define *target-root* (get-environment-variable "LIVE_TARGET_ROOT"))

(define-syntax define-once
  (syntax-rules ()
    ((define-once name value)
     (define name (if (unbound-variable? 'name)
                      value
                      name)))))

(define (unbound-variable? s)
  (eq? (##sys#slot s 0)
       (##sys#slot '##sys#arbitrary-unbound-symbol 0)))

(define-syntax autoreload
  (syntax-rules (compiling live)
    ((autoreload source)
     (cond-expand
       (compiling (cond-expand
                    (live (register-source-file source))
                    (else (void))))
       (else (void))))))

(define-record SourceFile file modtime)

(define (register-source-file file)
  (define (maybe-replace-root pathname)
    (if *source-root*
      (filepath:combine *target-root* (filepath:make-relative *source-root* pathname))
      pathname))
  (define (source-file pathname)
    (make-SourceFile pathname (file-modification-time pathname)))

  (and-let* ((pathname (file-exists? (maybe-replace-root file))))
    (debug-log log-level/debug "registering live source: " pathname)
    (handle-exceptions e
      (begin
        (debug-log log-level/debug "error file-stat: " pathname ", " e)
        #f)
      (set! source-files
        (cons (source-file pathname) source-files)))))

(define (reload-source-files)
  (for-each reload-source-file source-files))

(define (reload-source-file source)
  (let* ((file (SourceFile-file source))
         (t1 (SourceFile-modtime source))
         (t2 (file-modification-time file)))
    (when (< t1 t2)
          (debug-log log-level/debug "reloading '" file "' ...")
          ; this is needed to resolve relative paths in include forms
          (current-directory (filepath:take-directory file))
          (let ((start-time (current-milliseconds)))
            (load file)
            (debug-log log-level/debug "reloading finished: '" file "', " (- (current-milliseconds) start-time) " ms [ok]")
            (SourceFile-modtime-set! source t2)))))

)