#!/bin/sh
#| -*- mode: scheme -*-
exec csi -s $0 "$@"
|#

(use matchable posix filepath srfi-1)

(define builtin-extensions '("chicken" "csi" "types" "tcp" "srfi-13" "srfi-4" "extras" "foreign" "srfi-69" "ports" "srfi-1"))

(define chicken-coop (or (get-environment-variable "CHICKENS") "~/chickens"))

(define (printf-error msg . args)
  (display "ERROR: " (current-error-port))
  (apply fprintf (current-error-port) msg args)
  (newline (current-error-port)))

(define (fail msg . args)
  (apply printf-error msg args)
  (newline (current-error-port))
  (exit 1))

(define (remove-builtins eggs)
  (remove (cut member <> builtin-extensions) eggs))

(define (extract-eggs-from libs)
  (delete-duplicates
   (remove-builtins
    (map
     (o string-downcase
        filepath:drop-extension
        filepath:drop-extension ; drop .import if there is one
        filepath:take-file-name)
     libs))))

(define (find-eggs dir)
  (let ((abi-dirs (glob (conc dir "/*"))))
    (append-map
     (lambda (abi-dir)
       (glob (conc abi-dir "/*")))
     abi-dirs)))

(define (discover-eggs-for version)
  (let ((chicken-dir (conc chicken-coop "/" version)))
    (unless (directory? chicken-dir)
      (fail "Could not find directory for CHICKEN ~a" version))
    (extract-eggs-from (find-eggs (conc chicken-dir "/lib/chicken")))))

(define (install-egg name keep-going)
  (receive (_ success? status)
      (process-wait (process-run "chicken-install" (list name)))
    (if (and (not (and success? (zero? status))) (not keep-going))
      (fail "Could not install '~a'" name))))

(define (install-eggs-from version #!optional (keep-going #f))
  (for-each (cut install-egg <> keep-going) (discover-eggs-for version)))

(define (main)
  (define (usage)
    (printf "Usage: ~A [OPTION ...] VERSION ...
Rebuild eggs from a given CHICKEN version

Options:
  -k, --keep-going
    don't exit if the installation of an egg fails

  -h, --help
    show this help"
              (filepath:take-file-name (program-name))))

  (let ((keep-going #f)
        (versions '()))
    (let loop ((args (command-line-arguments)))
      (match args
        (()
         (when (null? versions)
           (usage)
           (exit 1)))
        (((or "-h" "--help") rest ...)
         (usage)
         (exit))
        (((or "-k" "--keep-going") rest ...)
         (set! keep-going #t)
         (loop rest))
        ((version rest ...)
         (set! versions (cons version rest)))))
    (for-each (cut install-eggs-from <> keep-going) versions)))

(main)