#lang scheme

(require scribble/manual
         (for-label scheme)
         (for-syntax scheme/require-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))))]))))

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