gxpkg new command

configure

@@ -61,8 +61,9 @@ std_disable_feature() {
 }
 
 readonly gerbil_version="v$(git describe --tags --always)"
+readonly gerbil_targets=""
 readonly default_gambit_tag=v4.9.5
-readonly default_gambit_config="--enable-targets='' --enable-single-host --enable-dynamic-clib --enable-default-runtime-options=t8,f8,-8 --enable-trust-c-tco"
+readonly default_gambit_config="--enable-targets=${gerbil_targets} --enable-single-host --enable-dynamic-clib --enable-default-runtime-options=t8,f8,-8 --enable-trust-c-tco"
 prefix="/opt/gerbil"
 readonly cflags_opt="-foptimize-sibling-calls"
 readonly ldflags_rpath="-Wl,-rpath"

src/gerbil/main.ss

@@ -52,42 +52,55 @@ package: gerbil
     "gerbil/compiler/ssxi"
     "gerbil/compiler"))
 
-(def builtin-tools
-  '("pkg"
-    "test"
-    "tags"
-    "prof"
-    "ensemble"))
-
-(def builtin-tools-synonyms
-  '(("compile" . "gxc")
-    ("interactive" . "gxi")))
-
-(def builtin-tools-subcommand-synonyms
-  '(("build" "gxpkg" "build")))
+(def builtin-tool-commands
+  '(("new"         "gxpkg" "new")
+    ("build"       "gxpkg" "build")
+    ("clean"       "gxpkg" "clean")
+    ("pkg"         "gxpkg")
+    ("test"        "gxtest")
+    ("tags"        "gxtags")
+    ("prof"        "gxprof")
+    ("ensemble"    "gxensemble")
+    ("interactive" "gxi")
+    ("compile"     "gxc")))
+
+(def builtin-tool-help
+  '(("new"         "gxpkg" "help" "new")
+    ("build"       "gxpkg" "help" "build")
+    ("clean"       "gxpkg" "help" "clean")
+    ("pkg"         "gxpkg" "help")
+    ("test"        "gxtest" "-h")
+    ("tags"        "gxtags" "-h")
+    ("prof"        "gxprof" "-h")
+    ("ensemble"    "gxensemble" "help")
+    ("interactive" "gxi" "-h")
+    ("compile"     "gxc" "-h")))
 
 (def (print-usage! program-name)
   (displayln "Usage: " program-name " [option ...] arguments ...")
   (displayln)
   (displayln "Options: ")
-  (displayln "  -h|--help|help                   display this help message exit")
+  (displayln "  -h|--help                        display this help message exit")
   (displayln "  -v|--version|version             display the system version and exit")
   (displayln)
   (displayln "Arguments: ")
-  (displayln "  <tool> tool-arg ...              execute a builtin gerbil tool")
+  (displayln "  <cmd> cmd-arg ...                execute a builtin tool command")
   (displayln "  arg ...                          drop to the gerbil interpreter")
   (displayln)
-  (displayln "Builtin Tools:")
-  (displayln "  interactive                      the gerbil interpreter (gxi)")
-  (displayln "  compile                          the gerbil compiler (gxc)")
-  (displayln "  build                            the gerbil build tool (gxkpg build)")
-  (displayln "  pkg                              the gerbil package manager (gxpkg)")
-  (displayln "  test                             the gerbil test runner (gxtest)")
-  (displayln "  tags                             the gerbil tag generator (gxtags)")
-  (displayln "  prof                             the gerbil profiler (gxprof)")
-  (displayln "  ensemble                         the gerbil actor ensemble manager (gxensemble)")
+  (displayln "Commands:")
+  (displayln "  new                              create a new project template (gxpkg new)")
+  (displayln "  build                            build a gerbil package (gxpkg build)")
+  (displayln "  clean                            clean build artifactacts for a package (gxpkg clean)")
+  (displayln "  pkg                              invoke the gerbil package manager (gxpkg)")
+  (displayln "  test                             run tests (gxtest)")
+  (displayln "  tags                             create emacs tags (gxtags)")
+  (displayln "  prof                             profile a dynamic executable module (gxprof)")
+  (displayln "  ensemble                         invoke the gerbil actor ensemble manager (gxensemble)")
+  (displayln "  interactive                      invoke the gerbil interpreter (gxi)")
+  (displayln "  compile                          invoke the gerbil compiler (gxc)")
+  (displayln "  help <cmd>                       display help for a tool command")
   (displayln)
-  (displayln "Try " program-name " <tool> [-h|--help|help] for help on tool usage" ))
+  (displayln "Try " program-name " help <cmd> for help on tool command usage" ))
 
 (extern namespace: #f
   gerbil-runtime-init!)
@@ -188,14 +201,21 @@ package: gerbil
   (match args
     ([hd . rest]
      (cond
-      ((member hd builtin-tools)
-       (tool-main (string-append "gx" hd) rest))
-      ((assoc hd builtin-tools-synonyms)
-       => (lambda (p) (tool-main (cdr p) rest)))
-      ((assoc hd builtin-tools-subcommand-synonyms)
-       => (lambda (sub) (tool-main (cadr sub) (append (cdr sub) rest))))
-      ((member hd '("-h" "--help" "help"))
+      ((member hd '("-h" "--help"))
        (print-usage! program-name))
+      ((equal? "help" hd)
+       (match rest
+         ([cmd]
+          (cond
+           ((assoc cmd builtin-tool-help)
+            => (lambda (help-cmd) (tool-main (cadr help-cmd) (cddr help-cmd))))
+           (else
+            (displayln "no help for topic " cmd)
+            (print-usage! program-name))))
+         (else
+          (print-usage! program-name))))
+      ((assoc hd builtin-tool-commands)
+       => (lambda (cmd) (tool-main (cadr cmd) (append (cddr cmd) rest))))
       ((member hd '("-v" "--version" "version"))
        (displayln (gerbil-system-version-string)))
       (else

src/tools/gxpkg.ss

@@ -28,6 +28,7 @@
         :std/pregexp
         :std/net/request
         :std/misc/process
+        :std/misc/template
         (only-in :std/srfi/13 string-trim)
         :gerbil/gambit/os
         :gerbil/gambit/exceptions)
@@ -64,10 +65,22 @@
     (command 'build help: "rebuild one or more packages and their dependents"
       (flag 'build-release "-R" "--release" help: "build released (static) executables")
       (flag 'build-optimized "-O" "--optimized" help: "build full program optimized executables")
-      (rest-arguments 'pkg help: "package to build; all for all packages")))
+      (rest-arguments 'pkg help: "package to build; all for all packages, omit to build in current directory")))
   (def clean-cmd
     (command 'clean help: "clean compilation artefacts from one or more packages"
-             (rest-arguments 'pkg help: "package to clean")))
+      (rest-arguments 'pkg help: "package to clean; all for all packages, omit to clean in current directory")))
+  (def new-cmd
+    (command 'new help: "Create a new package template in the current directory"
+      (option 'package "-p" "--package"
+        help: "The package prefix for your project; defaults to the current username"
+        default: (getenv "USER"))
+      (option 'name "-n" "--name"
+        help: "The package name; defaults to the current directory name"
+        default: (path-strip-directory
+                  (let (path (path-normalize (current-directory)))
+                    (substring path 0 (1- (string-length path))))))
+      (option 'link "-l" "--link"
+        help: "Optionally link this package with a public package name; for example: github.com/your-user/your-package")))
   (def list-cmd
     (command 'list help: "list installed packages"))
   (def retag-cmd
@@ -79,34 +92,37 @@
   (call-with-getopt gxpkg-main args
     program: "gxpkg"
     help: "The Gerbil Package Manager"
+    new-cmd
+    build-cmd
+    clean-cmd
+    link-cmd
+    unlink-cmd
     install-cmd
     uninstall-cmd
     update-cmd
-    link-cmd
-    unlink-cmd
-    build-cmd
-    clean-cmd
     list-cmd
     retag-cmd
     search-cmd))
 
 (def (gxpkg-main cmd opt)
   (let-hash opt
     (case cmd
+      ((new)
+       (pkg-new .package .name .link))
+      ((build)
+       (build-pkgs .pkg .?release .?optimized))
+      ((clean)
+       (clean-pkgs .pkg))
+      ((link)
+       (link-pkg .pkg .src))
+      ((unlink)
+       (unlink-pkgs .pkg .?force))
       ((install)
        (install-pkgs .pkg))
       ((uninstall)
        (uninstall-pkgs .pkg .?force))
       ((update)
        (update-pkgs .pkg))
-      ((link)
-       (link-pkg .pkg .src))
-      ((unlink)
-       (unlink-pkgs .pkg .?force))
-      ((build)
-       (build-pkgs .pkg .?release .?optimized))
-      ((clean)
-       (clean-pkgs .pkg))
       ((list)
        (list-pkgs))
       ((retag)
@@ -206,6 +222,28 @@
       (force once)
       +pkg-root-dir+)))
 
+(def (pkg-new prefix name maybe-link)
+  (def (create-template file template . args)
+    (call-with-output-file file
+      (lambda (output)
+        (apply write-template template output args))))
+
+  (create-template "gerbil.pkg" gerbil.pkg-template
+                   package: prefix)
+  (create-directory name)
+  (create-template (path-expand "main.ss" name) main.ss-template
+                   name: name)
+  (create-template (path-expand "lib.ss" name) lib.ss-template)
+  (create-template [path: "build.ss" permissions: #o755] build.ss-template
+                   name: name)
+  (create-template ".gitignore" gitignore-template)
+
+  ;; TODO create Makefile template
+  ;; ...
+
+  (when maybe-link
+    (pkg-link maybe-link (current-directory))))
+
 (def (pkg-install pkg)
   (def (git-clone-url pkg)
     (string-append "https://" pkg ".git"))
@@ -487,3 +525,72 @@
 (def (file-symbolic-link? path)
   (eq? (file-info-type (file-info path #f))
        'symbolic-link))
+
+;;; templates
+(def gerbil.pkg-template #<<END
+(package: ${package})
+
+END
+)
+
+(def main.ss-template #<<END
+;;; -*- Gerbil -*-
+(import :std/sugar
+        :std/getopt
+        ./lib)
+(export main)
+
+(def (main . args)
+  (call-with-getopt ${name}-main args
+    program: "${name}"
+    help: "A one line description of your program"
+    ;; commands/options/flags for your program; see :std/getopt
+    ;; ...
+    ))
+
+(def* ${name}-main
+  ((opt)
+   (${name}-main/options opt))
+  ((cmd opt)
+   (${name}-main/command cmd opt)))
+
+;;; Implement this if your CLI doesn't have commands
+(def (${name}-main/options opt)
+  (error "Implement me!"))
+
+;;; Implement this if your CLI has commands
+(def (${name}-main/command cmd opt)
+  (error "Implement me!"))
+
+END
+)
+
+(def lib.ss-template #<<END
+;;; -*- Gerbil -*-
+(import :std/sugar)
+(export #t)
+
+;;; Your library support code
+;;; ...
+
+END
+)
+
+(def build.ss-template #<<END
+#!/usr/bin/env gxi
+;;; -*- Gerbil -*-
+(import :std/build-script)
+
+(defbuild-script
+  '("${name}/lib"
+    (exe: "${name}/main" bin: "${name}")))
+
+END
+)
+
+(def gitignore-template #<<END
+*~
+build-deps
+
+END
+)