#!/usr/bin/csi -s

(use srfi-1 posix ports)
(include "chicken-env")

(assert-chicken-coop-exists)

(define verbose? #f)

(unless (null? (command-line-arguments))
  (if (equal? "-v" (car (command-line-arguments)))
      (set! verbose? #t)
      (fail "Invalid arguments: ~S" (command-line-arguments))))

(define (available-chickens)
  (filter (lambda (p) (not (equal? chicken-link p)))
          (directory chicken-coop)))

(define (current-chicken path link)
  (let ((p (make-pathname path link)))
    (and (symbolic-link? p)
         (read-symbolic-link p))))

(define (set-current-chicken chicken link)
  (let ((symlink (make-pathname chicken-coop link)))
    (when (file-exists? symlink)
      (delete-file symlink))
    (create-symbolic-link chicken symlink)))

(define (print-chicken-version chicken)
  (let* ((csi (make-pathname chicken-coop chicken))
         (csi (make-pathname csi "bin"))
         (csi (make-pathname csi "csi")))
    (receive (in out pid)
        (process csi '("-p" "(chicken-version #t)"))
      (port-for-each 
       (lambda (line)
         (printf "     ~A~%" line)) 
       (lambda () (read-line in)))
      (close-output-port out)
      (close-input-port in))))

(let* ((all-chicks (available-chickens))
       (current (list-index (cut equal? (current-chicken chicken-coop chicken-link) <>) all-chicks)))
  (let select ((abort #f))
    (if (equal? abort #\return)
        (begin
          (print "Aborted.")
          (exit 0))
        (begin
          (for-each (lambda (c n)
                      (printf "~a ~a: ~a~%"
                              (if (equal? n current) "*" " ")
                              n c)
                      (when verbose?
                        (print-chicken-version c)))
                    all-chicks
                    (iota (length all-chicks)))
          (newline)
          (print* "Select a new Chicken, press ENTER to abort: ")
          (let ((choice-raw (read-line)))
            (if (equal? choice-raw "")
                (exit)
                (let ((num (string->number choice-raw)))
                  (if (and
                       num
                       (<= 0 num)
                       (< num (length all-chicks)))
                      (begin
                        (print "Setting current Chicken to " (list-ref all-chicks num))
                        (set-current-chicken (list-ref all-chicks
                                                       num)
                                             chicken-link))
                      (select choice-raw)))))))))