(module require mzscheme
  (require (lib "etc.ss"))
  (require-for-syntax (lib "stx.ss" "syntax")
                      (lib "etc.ss")
                      "require-ct.ss")
  (provide define-module
           define-library
           hygienic:define-module
           hygienic:define-library)

  ;; define-module

  (define-for-syntax (make-here-expr stx)
    (datum->syntax-object stx `(,#'this-expression-source-directory) stx stx))

  (define-syntax (define-module stx)
    (syntax-case stx ()
      [(_ name mod-spec ...)
       (begin
         (unless (identifier? #'name)
           (raise-syntax-error 'define-module "expected identifier" #'name))
         (for-each (lambda (ms)
                     (unless (or (absolute-mod-spec? ms) (relative-mod-spec? ms))
                       (raise-syntax-error 'define-module "bad module spec" ms)))
                   (syntax->list #'(mod-spec ...)))
         (with-syntax ([name
                        (datum->syntax-object #'name
                                              (join 'require- #'name)
                                              #'name)]
                       [dynamic-name
                        (datum->syntax-object #'name
                                              (join 'dynamic-require- #'name)
                                              #'name)]
                       [name4stx
                        (datum->syntax-object #'name
                                              (join 'require-for-syntax- #'name)
                                              #'name)]
                       [name4templ
                        (datum->syntax-object #'name
                                              (join 'require-for-template- #'name)
                                              #'name)])
           #`(begin
               (hygienic:define-module name name4stx name4templ mod-spec ...)
               #,(syntax-case #'(mod-spec ...) ()
                   [(mod-spec1)
                    (with-syntax ([here-expr (make-here-expr #'mod-spec1)])
                      #'(define (dynamic-name x)
                          (parameterize ((current-load-relative-directory here-expr))
                            (dynamic-require 'mod-spec1 x))))]
                   [_
                    #'(begin)]))))]))

  (define-syntax (hygienic:define-module stx)
    (syntax-case stx ()
      [(_ name name4stx name4templ mod-spec ...)
       #'(begin
           (define-require-form name require mod-spec ...)
           (define-require-form name4stx require-for-syntax mod-spec ...)
           (define-require-form name4templ require-for-template mod-spec ...))]))

  (define-for-syntax (adjust-mod-specs relative-to mod-specs)
    (define (adjust mod-spec)
      (cond [(pair? mod-spec)
             ;; Absolute mod-spec
             mod-spec]
            [else
             ;; Relative; needs adjusting
             `(file ,(path->string (build-path relative-to mod-spec)))]))
    (map adjust mod-specs))

  (define-syntax (define-require-form stx)
    (syntax-case stx ()
      [(_ name require-form mod-spec ...)
       (with-syntax ([here-expr (make-here-expr #'name)])
         #`(begin
             (define-syntax (name x)
               (syntax-case x ()
                 [(name)
                  (let ([relative-to here-expr])
                    (let ([specs (adjust-mod-specs relative-to '(mod-spec ...))])
                      (datum->syntax-object x `(,#'require-form ,@specs))))]))
             #,(if (eq? (syntax-local-context) 'module)
                   #'(provide name)
                   #'(begin))))]))
  
  ;; define-library
  (define-syntax (define-library stx)
    (syntax-case stx ()
      [(_ name pkg-spec)
       (begin
         (unless (identifier? #'name)
           (raise-syntax-error 'define-library "expected identifier" #'name))
         (unless (absolute-mod-spec? #'pkg-spec)
           (raise-syntax-error 'define-library "bad absolute module spec" #'pkg-spec))
         (with-syntax ([name
                        (datum->syntax-object #'name (join 'require- #'name))]
                       [name4stx
                        (datum->syntax-object #'name (join 'require-for-syntax- #'name))]
                       [name4templ
                        (datum->syntax-object #'name (join 'require-for-template- #'name))]
                       [dynamic-name
                        (datum->syntax-object #'name (join 'dynamic-require- #'name))])
           #'(begin
               (hygienic:define-library name name4stx name4templ pkg-spec)
               (define (dynamic-name modname thing)
                 (dynamic-require (combine-mod-spec 'pkg-spec modname) thing)))))]))

  (define-syntax (hygienic:define-library stx)
    (syntax-case stx ()
      [(_ name name4stx name4templ abs-mod-spec)
       #'(begin 
           (define-require-abstraction name require abs-mod-spec)
           (define-require-abstraction name4stx require-for-syntax abs-mod-spec)
           (define-require-abstraction name4templ require-for-template abs-mod-spec))]))

  (define-syntax (define-require-abstraction stx)
    (syntax-case stx ()
      [(_ name require-form abs-mod-spec)
       #`(begin
           #,(if (eq? (syntax-local-context) 'module)
                 #'(provide name)
                 #'(begin))
           #,(syntax-case #'abs-mod-spec (lib planet file)
               [(lib dir0 subdir ...)
                (eq? 'lib (syntax-e #'lib))
                #`(define-syntax (name x)
                    (syntax-case x ()
                      [(name module-file . morepaths)
                       (datum->syntax-object
                        x
                        `(#,#'require-form 
                            (lib ,#'module-file dir0 subdir ... . ,#'morepaths)))]))]
               [(planet pkg subdir ...)
                (eq? 'planet (syntax-e #'planet))
                #`(define-syntax (name x)
                    (syntax-case x  ()
                      [(name module-file . morepaths)
                       (datum->syntax-object
                        x
                        `(#,#'require-form 
                            (planet ,#'module-file pkg subdir ... . ,#'morepaths)))]))]
               [(file abspath)
                (eq? 'file (syntax-e #'file))
                #'(define-syntax (name x)
                    (syntax-case x ()
                      [(name module-file . morepaths)
                       (datum->syntax-object
                        x
                        `(#,#'require-form
                            (file ,(path->string
                                    (build-path (apply build-path abspath 
                                                       (map syntax-e (syntax->list #'morepaths)))
                                                (syntax-e #'module-file))))))]))]))]))

  (define (combine-mod-spec abs-mod-spec mod-name)
    (case (car abs-mod-spec)
      ((lib)
       `(lib ,mod-name ,@(cdr abs-mod-spec)))
      ((planet)
       `(planet ,mod-name ,@(cdr abs-mod-spec)))
      ((file)
       `(file ,(build-path (cadr abs-mod-spec) mod-name)))))

;  (define-module sb (planet "syntax-browser.ss" ("ryanc" "syntax-browser.plt" 1)))
;  (define-module list (lib "list.ss"))
;  (define-library schemeunit (planet ("schematics" "schemeunit.plt" 1 2)))
;  (define-library stx (lib "syntax"))
  
  )