#lang scheme/base

(require (for-syntax scheme/base "wrapper.ss")
         "event.ss")

(provide provide/dracula provide-from provide-all-from)

(define-syntax (define-wrapper stx)
  (syntax-case stx ()
    [(_ wrapper name1 name2)
     (syntax/loc stx
       (define-syntax (name2 stx*)
         (wrapper
          (syntax-case stx* ()
            [(_ . rest) (syntax/loc stx* (name1 . rest))]
            [_ (syntax/loc stx* name1)]))))]))

(define-syntax (define-wrappers stx)
  (syntax-case stx ()
    [(_ wrapper [name1 name2] ...)
     (syntax/loc stx (begin (define-wrapper wrapper name1 name2) ...))]))

(define-syntax (provide/dracula stx)
  (syntax-case stx ()
    [(_ path [wrapper name0 ...] ...)
     (with-syntax ([((name1 ...) ...)
                    (map generate-temporaries
                         (syntax->list #'((name0 ...) ...)))]
                   [((name2 ...) ...)
                    (map generate-temporaries
                         (syntax->list #'((name0 ...) ...)))])
       (syntax/loc stx
         (begin
           (require (only-in path [name0 name1] ... ...))
           (define-wrappers wrapper [name1 name2] ...) ...
           (provide (rename-out [name2 name0] ... ...)))))]))

(define-syntax (provide-from stx)
  (syntax-case stx ()
    [(_ path [name1 name2] ...)
     (with-syntax ([(name3 ...) (generate-temporaries #'(name1 ...))])
       (syntax/loc stx
         (begin
           (require (only-in path [name1 name3] ...))
           (provide (rename-out [name3 name2] ...)))))]))

(define-syntax (provide-all-from stx)
  (syntax-case stx ()
    [(_ path ...)
     (syntax/loc stx
       (begin
         (require path ...)
         (provide (all-from-out path ...))))]))