private/planet.ss
#lang scheme

(require scribble/manual
         (for-label scheme)
         (for-syntax planet/util))

(define-for-syntax (build-planet-string suffix)
  (format "~a/~a:~a:~a~a"
          (this-package-version-owner)
          (regexp-replace "\\.plt$" (this-package-version-name) "")
          (this-package-version-maj)
          (this-package-version-min)
          suffix))

(define-for-syntax (build-planet-id stx id)
  (datum->syntax
   stx
   (string->symbol
    (build-planet-string
     (if id (format "/~a" (syntax-e id)) "")))))

(define-syntax (this-package-version-id stx)
  (syntax-case stx ()
    [(tpvi) (build-planet-id stx #f)]
    [(tpvi name)
     (identifier? #'name)
     (build-planet-id stx #'name)]))

(define-syntax (scheme/this-package stx)
  (syntax-case stx ()
    [(sp)
     (quasisyntax/loc stx
       (scheme (planet #,(build-planet-id stx #f))))]
    [(sp name)
     (identifier? #'name)
     (quasisyntax/loc stx
       (scheme (planet #,(build-planet-id stx #'name))))]))

(define-syntax (defmodule/this-package stx)
  (syntax-case stx ()
    [(dmp)
     (quasisyntax/loc stx
       (defmodule (planet #,(build-planet-id stx #f))))]
    [(dmp name)
     (identifier? #'name)
     (quasisyntax/loc stx
       (defmodule (planet #,(build-planet-id stx #'name))))]))

(provide this-package-version-id scheme/this-package defmodule/this-package)