;; vi: set ft=scheme :

(parentheses-synonyms #f)

(define standard-input-port
  (let ((p (current-input-port)))
    (lambda () p)))

(define standard-output-port
  (let ((p (current-output-port)))
    (lambda () p)))

(define standard-error-port
  (let ((p (current-error-port)))
    (lambda () p)))

(define-syntax try-import
  (er-macro-transformer
   (lambda (e r c)
     (import (chicken condition))
     (handle-exceptions _ #f (eval `(import ,@(cdr e))) #t))))

(define (pp-string x)
  (import (chicken port))
  (import (chicken pretty-print))
  (import (chicken string))
  (string-chomp (with-output-to-string (lambda () (pp x)))))

(try-import (chicken-doc))
(try-import (beaker system))

(let ()
  (import (chicken pathname))
  (import (chicken process-context))
  (when (try-import (srfi-18) (breadline) (breadline-scheme-completion))
    (history-file (make-pathname (get-environment-variable "HOME") ".csi_history"))
    (stifle-history! 100000)
    (completer-word-break-characters-set! "\"\'`;|()[]{}#")
    (completer-set! scheme-completer)
    (basic-quote-characters-set! "\"|")
    (variable-bind! "blink-matching-paren" "on")
    (paren-blink-timeout-set! 500000)
    (event-hook-set! (lambda () (thread-yield!)))
    (current-input-port (make-readline-port))))

(define (tcp-port-available? n)
  (import (chicken tcp))
  (condition-case (and (tcp-close (tcp-listen n)) #t)
    ((exn i/o net) #f)))

(define (random-tcp-port n)
  (import (chicken random))
  (let ((n (+ (pseudo-random-integer 1000) n)))
    (or (and (tcp-port-available? n) n)
        (random-tcp-port))))

(define (next-available-tcp-port n)
  (do ((n n (add1 n)))
      ((tcp-port-available? n) n)))

(define nrepl-port
  (let ()
    (import (chicken process-context))
    (make-parameter
     (or (and-let* ((p (get-environment-variable "NREPL_PORT")))
           (string->number p))
         (next-available-tcp-port 9000)))))

(let ()
  (import (chicken condition))
  (import (chicken platform))
  (import (chicken repl))
  (when (try-import (breadline) (nrepl) (srfi-18))
    (let ((n (nrepl-port)))
      (print "; listening on " n)
      (thread-start!
       (lambda ()
         (nrepl n (lambda ()
                    (close-output-port (current-error-port))
                    (close-output-port (current-output-port))
                    (parameterize ((current-error-port (standard-error-port))
                                   (current-output-port (standard-output-port)))
                      (let loop ()
                        (handle-exceptions e
                          (begin
                            (print-error-message e (current-error-port) "Error in nrepl")
                            (loop))
                          (repl (lambda (x)
                                  (insert-text (pp-string x))
                                  (redisplay)
                                  (stuff-char #\newline)
                                  (void)))))))))))))