bug fixes, more tests

scaffold/expand.rkt

@@ -65,13 +65,13 @@
 
 (define (expand-matches str start end matches out context missing-value-handler)
   (if (or (false? matches) (empty? matches))
-      str
+      (display (substring str start end) out)
       (let next-match ([last start]
                        [pos-list (first matches)]
                        [more (rest matches)]
                        [skip-to #f])
         (cond
-          [(and skip-to (equal? skip-to pos-list))
+          [(and skip-to (equal? (first skip-to) pos-list))
            (set! skip-to #f)]
           [(not skip-to)
            (let-values ([(prefix value) (prefix-and-value str pos-list)])
@@ -97,21 +97,30 @@
                                             #f)))])
                            (cond
                              [(equal? end #f)
-                              (error "no end tag for block")]
+                              (error (format "no end tag for block ~a" value))]
                              [(let ([content (ref context value blank-missing-value-handler)])
                                 (or (and (equal? prefix "#") content)
                                     (and (equal? prefix "^") (not content))))
                               (let ([new-context (ref context value blank-missing-value-handler)]
                                     [sub-matches (take more (index-of more (first end)))])
-                                (when (list? new-context)
-                                  (for ([item new-context])
-                                    (expand-matches str
-                                                    (t-end (first pos-list))
-                                                    (t-start (first (first end)))
-                                                    sub-matches
-                                                    out
-                                                    item
-                                                    missing-value-handler))))])
+                                (cond
+                                  [(list? new-context)
+                                   (for ([item new-context])
+                                     (expand-matches str
+                                                     (t-end (first pos-list))
+                                                     (t-start (first (first end)))
+                                                     sub-matches
+                                                     out
+                                                     item
+                                                     missing-value-handler))]
+                                  [else
+                                   (expand-matches str
+                                                   (t-end (first pos-list))
+                                                   (t-start (first (first end)))
+                                                   sub-matches
+                                                   out
+                                                   (if (hash? new-context) new-context context)
+                                                   missing-value-handler)]))])
                            (set! skip-to end))
                          ""]
                         [(equal? prefix "/")
@@ -125,10 +134,11 @@
                         [else (ref context
                                    value
                                    missing-value-handler)])
-                      out))])
+                      out))]
+          [else (log-debug "skipping over ~a" (substring str last (t-end (first pos-list))))])
         (if (empty? more)
             (display (substring str (t-end (first pos-list)) end) out)
-            (next-match (t-end (third pos-list)) (first more) (rest more) skip-to))
+            (next-match (t-end (first pos-list)) (first more) (rest more) skip-to))
         (get-output-string out))))
 
 (define (t-start pair) (car pair))

scaffold/main.rkt

@@ -8,7 +8,6 @@
 ;; ---------- Requirements
 
 (require racket/cmdline
-         racket/date
          racket/list
          racket/logging
          racket/match
@@ -21,39 +20,19 @@
          planet/private/command
          ; Here is the internal API
          scaffold/planks
-         scaffold/system)
+         )
 
 ;; ---------- Internal parameters
 
-(define argument-hash
-  (make-hash (list (cons "content-name" "")
-                   (cons "content-description" "")
-                   (cons "module-language" "racket/base")
-                   (cons "package-dir" "")
-                   (cons "package-version" "0.1")
-                   (cons "package-license" "MIT")
-                   (cons "package-readme" "markdown")
-                   (cons "package-include-private" #t)
-                   (cons "package-include-travis" #t)
-                   (cons "package-structure" "multi")
-                   (cons "scribble-structure" "multi")
-                   (cons "user-id"
-                         (find-user-id))
-                   (cons "user-name"
-                         (find-user-name))
-                   (cons "user-email"
-                         (system-value "git config --global user.email"))
-                   (cons "user-keys" (make-hash))
-                   (cons "year"
-                         (number->string (date-year (current-date)))))))
+(define argument-hash (plank-argument-defaults))
 
 (define (set-argument name value)
   (hash-set! argument-hash name value))
 
 (define (add-argument key-value)
   (define kv-list (string-split key-value "="))
   (when (= (length kv-list) 2)
-    (hash-set! (hash-ref argument-hash "user-keys") (first kv-list) (second kv-list))))
+    (hash-set! (hash-ref argument-hash "user-args") (first kv-list) (second kv-list))))
 
 ;; ---------- Implementation
 
@@ -69,11 +48,11 @@
 
 (define (validate-arguments)
   (unless (member (string-downcase (hash-ref argument-hash "package-license"))
-                  '("apache" "gplv3" "mit"))
-    (error "not a valid license type"))
+                  (map string-downcase license-types))
+    (error (format "~a is not a valid license type" (hash-ref argument-hash "package-license"))))
   (unless (member (string-downcase (hash-ref argument-hash "package-readme"))
-                  '("markdown" "text"))
-    (error "not a valid readme type")))
+                  (map string-downcase (hash-keys readme-types)))
+    (error (format "~a is not a valid readme type" (hash-ref argument-hash "package-readme")))))
 
 (define (expand-content name)
   (with-logging-to-port
@@ -91,7 +70,8 @@
       (log-info "expand-content: expecting to expand ~a ~a" content-type name)
       (define fixed-args (make-immutable-hash (hash->list argument-hash)))
       (match content-type
-        ["package" (expand-package fixed-args)]
+        ["package" (expand-package (hash-set fixed-args
+                                             "parent-package-name" name))]
         ["collection" (expand-collection fixed-args)]
         ["module" (expand-module fixed-args)]
         ["testmodule" (expand-test-module fixed-args)]
@@ -162,7 +142,7 @@
                                      (set-argument "package-structure" "single")]
             #:once-each
             [("--single-scribble") "Create a single-page Scribble doc"
-                                   (set-argument "scribble-structure" "single")]
+                                   (set-argument "scribble-structure" "'()")]
             #:once-any
             [("-u" "--user") user "User name"
                              (set-argument "user-id" user)]

scaffold/plank-files/README.md

@@ -1,9 +1,9 @@
 # Racket package {{content-name}}
 
 [![GitHub release](https://img.shields.io/github/release/{{user-id}}/{{content-name}}.svg?style=flat-square)](https://github.com/{{user-id}}/{{content-name}}/releases)
-[![Travis Status](https://travis-ci.org/{{user-id}}/{{content-name}}.svg)](https://www.travis-ci.org/{{user-id}}/{{content-name}})
+{{#package-include-travis}}[![Travis Status](https://travis-ci.org/{{user-id}}/{{content-name}}.svg)](https://www.travis-ci.org/{{user-id}}/{{content-name}})
 [![Coverage Status](https://coveralls.io/repos/github/{{user-id}}/{{content-name}}/badge.svg?branch=master)](https://coveralls.io/github/{{user-id}}/{{content-name}}?branch=master)
-[![raco pkg install {{content-name}}](https://img.shields.io/badge/raco%20pkg%20install-rml--core-blue.svg)](http://pkgs.racket-lang.org/package/{{content-name}})
+{{/package-include-travis}}[![raco pkg install {{content-name}}](https://img.shields.io/badge/raco%20pkg%20install-rml--core-blue.svg)](http://pkgs.racket-lang.org/package/{{content-name}})
 [![Documentation](https://img.shields.io/badge/raco%20docs-rml--core-blue.svg)](http://docs.racket-lang.org/{{content-name}}/index.html)
 [![GitHub stars](https://img.shields.io/github/stars/{{user-id}}/{{content-name}}.svg)](https://github.com/{{user-id}}/{{content-name}}/stargazers)
 ![{{package-license}} License](https://img.shields.io/badge/license-{{package-license}}-118811.svg)

scaffold/plank-files/README.txt

@@ -44,9 +44,9 @@ Links
 
 GitHub
   https://github.com/{{user-id}}/{{content-name}}/releases
-
+{{#package-include-travis}}
 Travis
-  https://www.travis-ci.org/{{user-id}}/{{content-name}}
+  https://www.travis-ci.org/{{user-id}}/{{content-name}}{{/package-include-travis}}
 
 Racket Package
   http://pkgs.racket-lang.org/package/{{content-name}}

scaffold/plank-files/module.rkt

@@ -7,6 +7,8 @@
 
 ;; Racket Style Guide: http://docs.racket-lang.org/style/index.html
 
+(require racket/contract)
+
 (provide
  (contract-out))
 

scaffold/plank-files/test-doc-complete.rkt

@@ -0,0 +1,37 @@
+#lang racket/base
+;;
+;; {{parent-package-name}} - Test Documentation Coverage.
+;;
+;; Copyright (c) {{year}} {{user-name}} ({{user-email}}).
+
+(require racket/contract)
+
+(provide
+
+ (contract-out
+
+  [test-doc-coverage
+   (-> (listof string?) any)]))
+
+;; ---------- Requirements
+
+(require racket/string
+         rackunit
+         rackunit/docs-complete)
+
+;; ---------- Test Utilities
+
+(define (test-doc-coverage module-list)
+  (for ([module module-list])
+    (test-case
+     (format "test for documentation in ~a" module)
+     (let ([s (open-output-string)])
+       (parameterize ([current-error-port s])
+         (check-docs module))
+       (define out (get-output-string s))
+       (when (non-empty-string? out)
+         (displayln out))
+       (check-eq? (string-length out) 0)))))
+
+(module+ main
+  (test-doc-coverage {{content-name}}))

scaffold/planks.rkt

@@ -35,16 +35,21 @@
    (-> hash? void?)]
 
   [list-planks
-   (-> (listof string?))]))
+   (-> (listof string?))]
+
+  [plank-argument-defaults
+   (-> hash?)]))
 
 ;; ---------- Requirements
 
-(require racket/function
+(require racket/date
+         racket/function
          racket/logging
          racket/match
          racket/port
          racket/string
-         scaffold/expand)
+         scaffold/expand
+         scaffold/system)
 
 ;; ---------- Internal Configuration
 
@@ -102,8 +107,7 @@
                                       "content-name"
                                       (format "~a-test" (hash-ref arguments "content-name")))))]
 
-      [else (error "invalid package structure")]))
-  )
+      [else (error "invalid package structure")])))
 
 (define (expand-info type arguments)
   (log-debug "expand-info")
@@ -133,6 +137,9 @@
                                (hash-set arguments "file-name" collection-file)
                                "private"))
           (expand-test-module arguments)
+          (expand-plank-file "test-doc-complete.rkt"
+                             (hash-set arguments "file-name" "test-doc-complete.rkt")
+                             "test")
           (expand-scribblings arguments)))))
 
 (define (expand-module arguments)
@@ -144,19 +151,16 @@
 (define (expand-test-module arguments)
   (log-debug "expand-test-module")
   (expand-plank-file "test-module.rkt"
-                     arguments
+                     (hash-set arguments "file-ext" "rkt")
                      "test"))
 
 (define (expand-scribblings arguments)
   (log-debug "expand-scribblings")
-  (unless (file-exists? "scribblings/scribblings.scrbl")
-    (expand-plank-file "scribble-top.scrbl"
-                       (hash-set arguments "file-name" "scribblings.scrbl")
-                       "scribblings"))
+  (expand-plank-file "scribble-top.scrbl"
+                     (hash-set arguments "file-name" "scribblings.scrbl")
+                     "scribblings")
   (expand-plank-file "scribble-module.scrbl"
-                     (hash-set arguments
-                               "file-name"
-                               (format "~a.scrbl" (hash-ref arguments "content-name")))
+                     (hash-set arguments "file-ext" "scrbl")
                      "scribblings"))
 
 (define (expand-a-plank arguments)
@@ -179,20 +183,50 @@
     (list-planks-in package-path)
     (list-planks-in local-path))))
 
+(define (plank-argument-defaults)
+  (make-hash (list (cons "content-name" "")
+                   (cons "content-description" "")
+                   (cons "module-language" "racket/base")
+                   (cons "package-dir" "")
+                   (cons "package-version" "0.1")
+                   (cons "package-license" "MIT")
+                   (cons "package-readme" "markdown")
+                   (cons "package-include-private" #t)
+                   (cons "package-include-travis" #t)
+                   (cons "package-structure" "multi")
+                   (cons "scribble-structure" "multi-page")
+                   (cons "user-id"
+                         (find-user-id))
+                   (cons "user-name"
+                         (find-user-name))
+                   (cons "user-email"
+                         (system-value "git config --global user.email"))
+                   (cons "user-args" (make-hash))
+                   (cons "year"
+                         (number->string (date-year (current-date)))))))
+
 ;; ---------- Internal procedures
 
+(define (output-file-name arguments)
+  (or (hash-ref arguments "file-name" #f)
+      (if (hash-ref arguments "file-ext")
+          (format "~a.~a"
+                  (hash-ref arguments "content-name")
+                  (hash-ref arguments "file-ext"))
+           #f)
+      (hash-ref arguments "content-name")))
+
 (define (expand-plank-file file-name arguments [output-dir "."])
   (log-info "expand-plank-file: plank ~a" file-name)
   (log-info "expand-plank-file: output-dir ~a -> ~a" (current-directory) output-dir)
   (unless (directory-exists? output-dir)
     (make-directory output-dir))
   (define output-file (format "~a/~a"
                               output-dir
-                              (or (hash-ref arguments "file-name" #f)
-                                  (hash-ref arguments "content-name"))))
+                              (output-file-name arguments)))
   (log-info "expand-plank-file: output-file ~a" output-file)
   (if (file-exists? output-file)
-      (error (format "cannot overwrite existing file ~a" output-file))
+      (log-error "cannot overwrite existing file ~a" output-file)
       (expand-file (plank-file-path file-name)
                    output-file
                    arguments)))

scaffold/scribblings/scaffold.scrbl

@@ -98,7 +98,7 @@ Invoking the @tt{package} sub-command, as shown in the command-line below,
 
 @verbatim[#:indent 2]|{
 $ raco scaffold package -d "Some new package" -V "1.0" -l MIT -r markdown \
-         -L "racket/base" -u "me" -e "me@example.com"
+         -L "racket/base" -u "me" -e "me@example.com" my-name
 }|
 
 results in the @bold{Multi-Collection Package}  package structure shown
@@ -236,6 +236,9 @@ scribblings/
 @;{============================================================================}
 @subsection[]{Command-Line Flags}
 
+The following summarizes all of the command-line flags and the sub-commands
+that make use of them.
+
 @tabular[#:style 'boxed
          #:sep @hspace[1]
 ;         #:column-properties '(right-border right-border right-border ())
@@ -418,8 +421,10 @@ The following table lists the arguments passed into the functions in
                      @smaller{--single-collection, --triple-collection})
                (list @smaller{package-version} @racket[string?] @smaller{0.1}
                      @smaller{-V})
-               (list @smaller{scribble-structure} @smaller{"", multi} @smaller{multi}
+               (list @smaller{scribble-structure} @smaller{"'()", multi-page} @smaller{multi-page}
                      @smaller{--single-scribble})
+               (list @smaller{user-args} @smaller{key=value} ""
+                     @smaller{-k})
                (list @smaller{user-email} @racket[string?] ""
                      @smaller{-e, -E})
                (list @smaller{user-id} @racket[string?] "" "")