;;;; dynamic-import.scm  -*- Scheme -*-
;;;; Kon Lovett, Feb '22

;inspired by Feb 12 '22 #chicken irc - http-client & openssl eggs

(module dynamic-import

(;export
  (dynamic-import dynamic-import-body))

(import scheme)
(import (chicken base))
(import (chicken syntax))
(import (chicken condition))
(import (only (srfi 1) make-list))

;FIXME more elegant defaults specification/handling

(define-syntax dynamic-import
  (syntax-rules ()
    ;multiple identifier
    ;w/o default
    ((dynamic-import (?id0 ...) (?md0 ...))
      (define-values (?id0 ...)
                     (dynamic-import-body '(?id0 ...) '(?md0 ...))) )
    ;w/ default
    ((dynamic-import (?id0 ...) (?md0 ...) ?df)
      (define-values (?id0 ...)
                     (dynamic-import-body '(?id0 ...) '(?md0 ...) ?df)) )
    ;single identifier
    ;w/o default
    ((dynamic-import ?id (?md0 ...))
      (dynamic-import (?id) (?md0 ...)) )
    ;w/o default
    ((dynamic-import ?id ?md)
      (dynamic-import (?id) (?md)) )
    ;w/ default
    ((dynamic-import ?id (?md0 ...) ?df)
      (dynamic-import (?id) (?md0 ...) ?df) )
    ;w/ default
    ((dynamic-import ?id ?md ?df)
      (dynamic-import (?id) (?md) ?df) ) ) )

(define (dynamic-import-body ids mds #!optional (df (void)))
  (define (dfs)
    (cond ((list? df) df)
          ((procedure? df) (df ids))
          (else (make-list (length ids) df))))
  (let ((idvals `(values ,@ids)))
    (let loop ((mds mds))
      (if (null? mds)
          (error 'dynamic-import-body "empty module list" ids mds df)
          (let ((expr `(let () (import ,(car mds)) ,idvals)))
            (if (null? (cdr mds))
                ;then last module, any default?
                (if (eq? df (void))
                    ;then system-error on failure
                    (eval expr)
                    ;else defaults on failure
                    (handle-exceptions
                     exn (apply values (dfs))
                     (eval expr)) )
                ;else try next module on failure
                (handle-exceptions
                 exn (loop (cdr mds))
                 (eval expr)) ) ) ) ) ) )

) ;module dynamic-import