#lang scheme

(require scribble/manual
         (for-label scheme)
         (for-syntax scheme/require-transform
                     scheme/provide-transform
                     planet/util
                     "syntax.ss"))

(define-syntax (this-package-version-symbol stx)
  (syntax-case stx ()
    [(tpvi)
     (quasisyntax/loc stx
       '#,(syntax-source-planet-package-symbol stx #f))]
    [(tpvi name)
     (identifier? #'name)
     (quasisyntax/loc stx
       '#,(syntax-source-planet-package-symbol stx #'name))]))

(define-syntax (defmodule/this-package stx)
  (syntax-case stx ()
    [(_ #:use-sources [this-src ...] [src ...])
     (with-syntax ([(planet-src ...)
                    (map (lambda (id)
                           (quasisyntax/loc stx
                             (planet
                              #,(syntax-source-planet-package-symbol stx id))))
                         (syntax->list #'(this-src ...)))])
       (quasisyntax/loc stx
         (defmodule
           (planet
            #,(syntax-source-planet-package-symbol stx #f))
           #:use-sources [planet-src ...])))]
    [(_)
     (syntax/loc stx
       (defmodule/this-package #:use-sources [] []))]
    [(_ name #:use-sources [this-src ...] [src ...])
     (with-syntax ([(planet-src ...)
                    (map (lambda (id)
                           (quasisyntax/loc stx
                             (planet
                              #,(syntax-source-planet-package-symbol stx id))))
                         (syntax->list #'(this-src ...)))])
       (quasisyntax/loc stx
         (defmodule
           (planet
            #,(syntax-source-planet-package-symbol stx #'name))
           #:use-sources [planet-src ...])))]
    [(_ name)
     (syntax/loc stx
       (defmodule/this-package name #:use-sources [] []))]))

(define-syntax (declare-exporting/this-package stx)
  (syntax-case stx ()
    [(_ [this-mod ...] [mod ...] #:use-sources [this-src ...] [src ...])
     (with-syntax ([(planet-mod ...)
                    (map (lambda (id)
                           (quasisyntax/loc stx
                             (planet
                              #,(syntax-source-planet-package-symbol stx id))))
                         (syntax->list #'(this-mod ...)))]
                   [(planet-src ...)
                    (map (lambda (id)
                           (quasisyntax/loc stx
                             (planet
                              #,(syntax-source-planet-package-symbol stx id))))
                         (syntax->list #'(this-src ...)))])
       (syntax/loc stx
         (declare-exporting planet-mod ... mod ...
                            #:use-sources [planet-src ... src ...])))]
    [(_ [this-mod ...] [mod ...])
     (syntax/loc stx
       (declare-exporting/this-package [this-mod ...] [mod ...]
                                       #:use-sources [] []))]))

(define-syntax (schememodname/this-package stx)
  (syntax-case stx ()
    [(_)
     (quasisyntax/loc stx
       (schememodname
        (planet #,(syntax-source-planet-package-symbol stx))))]
    [(_ path)
     (quasisyntax/loc stx
       (schememodname
        (planet #,(syntax-source-planet-package-symbol stx #'path))))]))

(define-syntax this-package-in
  (make-require-transformer
   (lambda (stx)
     (syntax-case stx ()
       [(_ file)
        (expand-import
         (datum->syntax
          stx
          (list #'planet
                (syntax-source-planet-package-symbol stx #'file))))]))))

(define-syntax this-package-out
  (make-provide-transformer
   (lambda (stx modes)
     (syntax-case stx ()
       [(_ file)
        (expand-export
         (datum->syntax
          stx
          (list #'all-from-out
                (list #'planet
                      (syntax-source-planet-package-symbol stx #'file))))
         modes)]))))

(define-syntax (require/provide/this-package stx)
  (syntax-case stx ()
    [(_ path ...)
     (with-syntax ([(in-spec ...)
                    (map (lambda (a-path)
                           (datum->syntax stx
                                          (list #'this-package-in a-path)
                                          stx))
                         (syntax->list #'(path ...)))]
                   [(out-spec ...)
                    (map (lambda (a-path)
                           (datum->syntax stx
                                          (list #'this-package-out a-path)
                                          stx))
                         (syntax->list #'(path ...)))])
       (syntax/loc stx
         (begin
           (require in-spec ...)
           (provide out-spec ...))))]))

(provide this-package-version-symbol
         this-package-in
         this-package-out
         require/provide/this-package
         defmodule/this-package
         schememodname/this-package
         declare-exporting/this-package)