(module module-utils mzscheme

  (require (lib "contract.ss")
           (planet "syntax-utils.ss" ("cce" "syntax-utils.plt" 1 3))
           (planet "contract-utils.ss" ("cobbe" "contract-utils.plt" 3 0)))

  ;; A ModuleHandle is (make-module-handle path namespace)
  ;; where path is a require-spec s-expression
  ;; and namespace is a namespace to which the module is attached
  (define-struct module-handle (path namespace))

  (define flag/c (one-of/c 'initial 'empty))

  (provide/contract
   [module-handle? (-> any/c boolean?)]
   [get-module (-> any/c module-handle?)]
   [module-path (-> module-handle? any/c)]
   [module-attach (-> module-handle? namespace? void?)]
   [module-resolve (-> module-handle? symbol?)]
   [module->external-namespace (-> module-handle? namespace?)]
   [module->internal-namespace (-> module-handle? namespace?)]
   [module-exported-names (-> module-handle? (listof symbol?))]
   [module->eval (-> module-handle? (-> any/c any))]
   [eval-in/top-level (-> module-handle? (nelistof/c any/c) any)]
   [eval-in/module (-> module-handle? (nelistof/c any/c) any)])

  (define (get-module path)
    (define attach-namespace (make-namespace 'initial))
    (parameterize ([current-namespace attach-namespace])
      (namespace-require path))
    (make-module-handle path attach-namespace))

  (define (module-path mod)
    (module-handle-path mod))

  (define (module-resolve mod)
    (let* ([ns (module-handle-namespace mod)]
           [path (module-handle-path mod)]
           [source (syntax-source-module-name #'here)]
           [resolver (current-module-name-resolver)])
      (parameterize ([current-namespace ns])
        (resolver path source #f #f))))

  (define (module-attach mod ns)
    (namespace-attach-module (module-handle-namespace mod)
                             (module-handle-path mod)
                             ns))

  (define (module->external-namespace mod)
    (define external-namespace (make-namespace 'empty))
    (module-attach mod external-namespace)
    (parameterize ([current-namespace external-namespace])
      (namespace-require (module-handle-path mod)))
    external-namespace)

  (define (module->internal-namespace mod)
    (parameterize ([current-namespace (module-handle-namespace mod)])
      (module->namespace (module-handle-path mod))))

  (define (module-exported-names mod)
    (namespace-mapped-symbols (module->external-namespace mod)))

  (define (module->eval mod)
    (let* ([ns (module->external-namespace mod)])
      (lambda (expr)
        (parameterize ([current-namespace ns])
          (eval expr)))))

  (define (eval-in/top-level mod forms)
    (let* ([eval-in (module->eval mod)])
      (let loop ([forms forms])
        (if (null? (cdr forms))
            (eval-in (car forms))
            (begin (eval-in (car forms))
                   (loop (cdr forms)))))))

  (define (eval-in/module mod forms)
    (let* ([new-ns (make-namespace 'initial)]
           [symbol (gensym 'eval)]
           [mod-path (module-path mod)]
           [mod-ns (module-handle-namespace mod)])
      (parameterize ([current-namespace new-ns])
        (namespace-attach-module mod-ns mod-path)
        (eval `(module ,symbol ,mod-path (#%module-begin ,@forms)))
        (eval `(require ,symbol)))))

  )