From bfbce313829341823afa6144428db9952c49b0a7 Mon Sep 17 00:00:00 2001 From: Leif Andersen Date: Wed, 22 Oct 2014 11:51:01 -0400 Subject: [PATCH] Add raco pkg new utility for creating new packages --- .../racket-doc/pkg/scribblings/apis.scrbl | 1 + .../pkg/scribblings/getting-started.scrbl | 14 +- .../racket-doc/pkg/scribblings/lib.scrbl | 8 + .../racket-doc/pkg/scribblings/pkg.scrbl | 7 + .../racket-test/tests/pkg/tests-new.rkt | 39 ++++ racket/collects/pkg/lib.rkt | 3 + racket/collects/pkg/main.rkt | 6 + racket/collects/pkg/private/new.rkt | 217 ++++++++++++++++++ 8 files changed, 294 insertions(+), 1 deletion(-) create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/tests-new.rkt create mode 100644 racket/collects/pkg/private/new.rkt diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl index 005bd3d0c2..1ea91dd2e5 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl @@ -34,6 +34,7 @@ to the @exec{raco pkg} sub-subcommands. @defthing[pkg-install-command procedure?]{Implements @command-ref{install}.} @defthing[pkg-update-command procedure?]{Implements @command-ref{update}.} @defthing[pkg-remove-command procedure?]{Implements @command-ref{remove}.} +@defthing[pkg-new-command procedure?]{Implements @command-ref{new}.} @defthing[pkg-show-command procedure?]{Implements @command-ref{show}.} @defthing[pkg-migrate-command procedure?]{Implements @command-ref{migrate}.} @defthing[pkg-config-command procedure?]{Implements @command-ref{config}.} diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl index 26fcba84b9..baee369078 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl @@ -266,7 +266,17 @@ A package normally starts life as a directory containing module files and grows up to become a Git repository that is registered with a @tech{package catalog}. -So, to create a package, first make a directory and select its name, +@subsection[#:tag "automatic-creation"]{Automatic Creation} + +As a convenience, @command-ref{new} can automatically create single +collection packages. +To create @nonterm{pkg-name}: + +@commandline{raco pkg new @nonterm{pkg-name}} + +@subsection[#:tag "manual-creation"]{Manual Creation} + +To create a package manually, first make a directory and select its name, @nonterm{pkg-name}: @commandline{mkdir @nonterm{pkg-name}} @@ -297,6 +307,8 @@ it to a @tech{multi-collection package} by restructuring the package directory, so you don't have to worry much about the choice when you get started. +@subsection[#:tag "working-new-pkgs"]{Working with New Packages} + Whether creating a @tech{single-collection package} or a @tech{multi-collection package}, the next step is to link your development directory as a locally installed package. Use diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index 69ad15b895..b0765a888e 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -301,6 +301,14 @@ specific command-line flags for @command-ref{remove}. The package lock must be held; see @racket[with-pkg-lock].} +@defproc[(pkg-new [name path-string?]) + (void?)]{ +Implements @racket[pkg-new-command]. + +The @racket[name] parameter is the name of the new package. +} + + @defproc[(pkg-show [indent string?] [#:directory show-dir? boolean? #f]) void?]{ diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index e3aa65350f..faf1dbaba5 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -581,6 +581,13 @@ the given @nonterm{pkg}s. ] } +@subcommand{@command/toc{new} @nonterm{package} --- +Populates a directory with the stubs for a new racket package, where +@nonterm{package} is the name of the new package. +If @nonterm{package} already exists as a folder in the current directory, no new +package is created. +} + @subcommand{@command/toc{show} @nonterm{option} ... --- Print information about currently installed packages. By default, packages are shown for all @tech{package scopes}, but only for packages not marked as auto-installed to fulfill dependencies. diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-new.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-new.rkt new file mode 100644 index 0000000000..384fbba4a4 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-new.rkt @@ -0,0 +1,39 @@ +#lang racket/base +(require racket/file + "shelly.rkt" + "util.rkt") + +(this-test-is-run-by-the-main-test) + +(pkg-tests + (shelly-begin + (shelly-case + "new" + + (define tmp-dir (path->directory-path (make-temporary-file "pkg~a" 'directory))) + + (parameterize ([current-directory tmp-dir]) + (shelly-case + "new test-blah" + $ "raco pkg new test-blah" + $ "raco pkg install test-blah/" + $ "racket test-blah/main.rkt" + $ "racket -e \"(require test-blah)\"" + $ "raco pkg remove test-blah") + + (shelly-case + "modify package" + $ "raco pkg new test-foo" + $ "raco pkg install test-foo/" + $ "echo \"#lang racket/base\n(provide c)\n(define c 5)\" > test-foo/main.rkt" + $ "racket -e \"(require test-foo)\" -e \"c\"" =stdout> "5\n" + $ "raco pkg remove test-foo") + + (shelly-case + "invalid collection name" + $ "raco pkg new foo/bar" =exit> 1) + + (shelly-case + "folder already exists" + $ "raco pkg new repeat" + $ "raco pkg new repeat" =exit> 1))))) diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 0c5547c882..5b3ef7a2fa 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -13,6 +13,7 @@ "private/catalog.rkt" "private/remove.rkt" "private/install.rkt" + "private/new.rkt" "private/stage.rkt" "private/show.rkt" "private/config.rkt" @@ -68,6 +69,8 @@ (->* (boolean? (listof string?)) (#:from-command-line? boolean?) void?)] + [pkg-new + (-> path-string? void?)] [pkg-create (->* ((or/c 'zip 'tgz 'plt 'MANIFEST) path-string?) diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index dde7efaa01..a5a68c2980 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -285,6 +285,12 @@ #:force? force))) (setup "removed" no-setup #f setup-collects jobs)))] ;; ---------------------------------------- + [new + "Populate a new directory with the stubs of a package" + #:args (pkg) + (parameterize ([current-pkg-error (pkg-error 'new)]) + (pkg-new pkg))] + ;; ---------------------------------------- [show "Show information about installed packages" #:once-each diff --git a/racket/collects/pkg/private/new.rkt b/racket/collects/pkg/private/new.rkt new file mode 100644 index 0000000000..8c4320dd63 --- /dev/null +++ b/racket/collects/pkg/private/new.rkt @@ -0,0 +1,217 @@ +#lang racket/base + +(provide pkg-new) + +(require racket/match + racket/port + racket/system + racket/string + racket/date + setup/collection-name + "print.rkt") + +(define (pkg-new name) + + ;; Useful strings + (define user + (string-trim + (with-output-to-string + (lambda () + (match (system-type) + [(or 'unix 'macosx) + (system "whoami")] + ['windows + (system "echo %username%")] + [else (pkg-error "not supported")]))))) + + (define ==== + (make-string (string-length name) #\=)) + + (define year + (number->string (date-year (current-date)))) + + ;; Because I wish I had @-expressions + (define (expand/display str [table (hash #"name" name #"user" user + #"====" ==== #"year" year)]) + (let ([in (open-input-string str)]) + (let loop () + (let ([m (regexp-match #rx"<<([^>]*)>>" in 0 #f (current-output-port))]) + (when m + (display (hash-ref table (cadr m))) + (loop)))))) + + ;; Initialize the new package + (cond + [(directory-exists? name) + (pkg-error (format "cannot make package, folder exists~n path: ~a" name))] + [(not (collection-name-element? name)) + (pkg-error (format "cannot make package, invalid collection name~n name: ~a" + name))] + [else + (make-directory name) + (parameterize ([current-directory name]) + + ;; LICENSE.txt + (with-output-to-file "LICENSE.txt" + (lambda () (expand/display #<> +Copyright (c) <> <> + +This package is distributed under the GNU Lesser General Public +License (LGPL). This means that you can link <> into proprietary +applications, provided you follow the rules stated in the LGPL. You +can also modify this package; if you distribute a modified version, +you must distribute it under the terms of the LGPL, which in +particular means that you must release the source code for the +modified software. See http://www.gnu.org/copyleft/lesser.html +for more information. + +EOS +))) + + ;; .gitignore + (with-output-to-file ".gitignore" + (lambda () (display #<>` to install any required +# packages without it getting stuck on a confirmation prompt. +script: + - /usr/racket/bin/raco make main.rkt + - /usr/racket/bin/raco test -x . + +# NOTE: If your repo is a Racket package with an info.rkt that +# includes some `deps`, the following is more elegant: +# +# script: +# - cd .. # Travis did a cd into the dir. Back up, for the next: +# - /usr/racket/bin/raco pkg install --deps search-auto --link <> +# - /usr/racket/bin/raco test -x -p <> + +after_script: + +EOS +))) + ;; info.rkt + (with-output-to-file "info.rkt" + (lambda () (expand/display #<>") +(define deps '("base" + "rackunit-lib")) +(define build-deps '("scribble-lib" "racket-doc")) +(define scribblings '(("scribblings/<>.scrbl" ()))) +(define pkg-desc "Description Here") +(define version "0.0") +(define pkg-authors '(<>)) + +EOS +))) + + ;; README.md + (with-output-to-file "README.md" + (lambda () (expand/display #<> +<<====>> +README text here. + +EOS +))) + + ;; main.rkt + (with-output-to-file "main.rkt" +(lambda () (display #<> +;; To uninstall: +;; $ raco pkg remove <> +;; To view documentation: +;; $ raco doc <> +;; +;; For your convenience, we have included a LICENSE.txt file, which links to +;; the GNU Lesser General Public License. +;; If you would prefer to use a different license, replace LICENSE.txt with the +;; desired license. +;; +;; Some users like to add a `private/` directory, place auxiliary files there, +;; and require them in `main.rkt`. +;; +;; See the current version of the racket style guide here: +;; http://docs.racket-lang.org/style/index.html + +;; Code here + +(module+ test + ;; Tests to be run with raco test + ) + +(module+ main + ;; Main entry point, executed when run with racket executable or DrRacket. + ) + +EOS +))) + (make-directory "scribblings") + (parameterize ([current-directory "scribblings"]) + + ;; scribblings/name.scrbl + (with-output-to-file (format "~a.scrbl" name) + (lambda () (expand/display #<> + racket/base]] + +@title{<>} +@author{<>} + +@defmodule[<>] + +Package Description Here + +EOS +)))))]))