;;;
;;; Time-stamp: <05/10/28 11:40:45 nhw>
;;;
;;; Copyright (C) 2005 by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; Web testingis distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with Web testing; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:

(module namespace mzscheme

  (require (lib "file.ss")
           (planet "aif.ss" ("schematics" "macro.plt" 1))
           (lib "plt-match.ss"))

  (provide (all-defined))

  (define-struct (exn:namespace exn) ())

  ;; macro with-namespace : namespace expr ...
  ;;
  ;; Execute exprs with current-namespace parameterised to
  ;; namespace
  (define-syntax with-namespace
    (syntax-rules ()
                  ((_ space expr ...)
                   (parameterize ((current-namespace space))
                     expr ...))))

  ;; file-name->module-name : string -> symbol
  ;;
  ;; Convert a file name to the symbol that the module name
  ;; is expected to be.  Essentially the extension is
  ;; trimmed from the file name.  Raise exn:namespace if
  ;; there is no file or it is invalid.
  (define (file-name->module-name path)
    (aif file-name (file-name-from-path path)
         (aif module-name
              (regexp-match
               #rx"^[^.]+"
               (path->string (file-name-from-path file-name)))
              (string->symbol (car module-name))
              (raise
               (make-exn:namespace
                (string->immutable-string
                 (format "Invalid file-name ~s~n" file-name))
                (current-continuation-marks))))
         (raise
          (make-exn:namespace
           (string->immutable-string
            (format
             "Path does not contain a valid file name ~s~n" path))
           (current-continuation-marks)))))

  ;; require-spec-file : sexp -> string
  ;;
  ;; Extract the file (unix-relative-path-string,
  ;; path-string, or filename-string) from a require-spec.
  ;; Raises exn:namespace if no file is present or the
  ;; require-spec is malformed.  The syntax of a
  ;; require-spec is given in section 5.2 of the MzScheme
  ;; manual.
  (define (require-spec-file require-spec)
    (define (module-name-file module-name)
      (match module-name
             [(? string? file) file]
             [(list 'file (? string? file)) file]
             [(list 'lib (? string? file) path ...) file]
             [_ (raise (make-exn:namespace
                        (string->immutable-string
                         (format "Invalid module-name ~a~n"
                                 module-name))
                        (current-continuation-marks)))]))
    (match require-spec
           [(list 'prefix id module-name)
            (module-name-file module-name)]
           [(list 'all-except module-name id ...)
            (module-name-file module-name)]
           [(list 'prefix-all-except prefix module-name id ...)
            (module-name-file module-name)]
           [(list 'rename module-name local export)
            (module-name-file module-name)]
           [module-name (module-name-file module-name)]))

  ;; namespace-attach/require : namespace sexp -> #void
  ;;
  ;; Attach and require the module specified by require-spec
  ;; to the given namespace.  If you want to share a module
  ;; between the current namespace and the namespace you
  ;; have created this is the way to do it. You might choose
  ;; to do this so changes in state in the module are
  ;; visible between namespaces, or to reduce memory usage.
  ;; The module must have been already required in the
  ;; current namespace.  The current-namespace and
  ;; current-module-name-resolver are used to resolve the
  ;; require-spec to a module.
  (define (namespace-attach/require namespace require-spec)
    (let* ((default-resolver (current-module-name-resolver))
           (default-namespace (current-namespace))
           (module (default-resolver
                     require-spec
                     (file-name->module-name
                      (require-spec-file require-spec))
                     #f)))
      (with-namespace
       namespace
       (namespace-attach-module
        default-namespace
        module)
       (namespace-require require-spec))))

)