Merge pull request #52 from cgay/dev

Simplify dylan publish and dylan build

commands/build.dylan

@@ -35,11 +35,6 @@ define constant $build-subcommand
 define method execute-subcommand
     (parser :: <command-line-parser>, subcmd :: <build-subcommand>)
  => (status :: false-or(<int>))
-  // Blow up early if not in a workspace.
-
-  // TODO: Support lack of workspace.json by looking for _build/ or registry/
-  // instead? If no registry directory exists, need to pass the .lid file on
-  // the command line.
   let workspace = ws/load-workspace();
   let library-names = get-option-value(subcmd, "libraries") | #[];
   let all? = get-option-value(subcmd, "all");
@@ -70,12 +65,25 @@ define method execute-subcommand
                                 name),
                          #f);
     debug("Running command %=", command);
+    let env = make-compilation-environment(workspace);
     let exit-status
       = os/run-application(command,
+                           environment: env, // adds to the existing environment
                            under-shell?: #f,
                            working-directory: ws/workspace-directory(workspace));
     if (exit-status ~== 0)
       error("Build of %= failed with exit status %=.", name, exit-status);
     end;
   end for;
 end method;
+
+define function make-compilation-environment (ws :: ws/<workspace>) => (env :: <table>)
+  let val = as(<string>, ws/workspace-registry-directory(ws));
+  let var = "OPEN_DYLAN_USER_REGISTRIES";
+  let odur = os/environment-variable(var);
+  if (odur)
+    // TODO: export $environment-variable-delimiter from os/.
+    val := concat(val, iff(os/$os-name == #"win32", ";", ":"), odur);
+  end;
+  tabling(<string-table>, var => val)
+end function;

commands/publish.dylan

@@ -11,54 +11,50 @@ define constant $publish-subcommand
   = make(<publish-subcommand>,
          options:
            list(make(<positional-option>,
-                     names: #("package"),
-                     variable: "PKG",
-                     help: "Name of the package for which to publish a release.")));
+                     names: #("catalog-directory"),
+                     help: "Directory where you cloned pacman-catalog.")));
 
 define method execute-subcommand
     (parser :: <command-line-parser>, subcmd :: <publish-subcommand>)
  => (status :: false-or(<int>))
   let workspace = ws/load-workspace();
-  let name = get-option-value(subcmd, "package");
-  let active-packages = ws/workspace-active-packages(workspace);
-  let publish-release
-    = find-element(active-packages,
-                   method (rel)
-                     string-equal-ic?(pm/package-name(rel), name)
-                   end);
-  let catalog-release
-    = find-element(active-packages,
-                   method (rel)
-                     string-equal-ic?(pm/package-name(rel), "pacman-catalog")
-                   end);
-  if (~publish-release)
-    note("Package %= is not an active package.", name);
-    1
-  elseif (~catalog-release)
-    let ws-dir = ws/workspace-directory(ws/load-workspace());
-    note(#:string:'
-"pacman-catalog" is not an active package in this workspace.  For now, the way
-packages are published is by making a pull request to the "pacman-catalog"
-repository. This command will make the necessary changes for you, but you must
-clone pacman-catalog first, using these commands:
-
-  cd %s
-  git clone https://github.com/dylan-lang/pacman-catalog
-  cd pacman-catalog
-  git checkout -t -b publish
-
-Then re-run this command. Once the changes have been made, commit them and submit
-a pull request. The GitHub continuous integration will verify the changes for you.
-', ws-dir);
-    1
+  let release = ws/workspace-release(workspace);
+  let cat-dir = as(<directory-locator>,
+                   get-option-value($publish-subcommand, "catalog-directory"));
+  let cat = pm/catalog(directory: cat-dir);
+  let name = pm/package-name(release);
+  let latest = pm/find-package-release(cat, name, pm/$latest);
+  if (release <= latest)
+    // Have to use format-to-string here because error() uses simple-format
+    // which doesn't call print-object methods.
+    let message
+      = format-to-string(
+          "The latest published release of %= is %s. Increment the version"
+          " in %s (and commit it) in order to publish a new version.",
+          name, pm/release-version(release), ws/$dylan-package-file-name);
+    error(message);
+  end;
+  if (yes-or-no?(format-to-string("About to publish %s, ok? ", release)))
+    let file = pm/publish-release(cat, release);
+    note("Package file written to %s. Commit the changes and submit a"
+           " pull request.", file);
   else
-    // Looks good, let's publish...
-    let release = pm/load-dylan-package-file(ws/active-package-file(workspace, name));
-    os/environment-variable("DYLAN_CATALOG")
-      := as(<byte-string>,
-            ws/active-package-directory(workspace, pm/package-name(catalog-release)));
-    let catalog = pm/catalog();
-    pm/publish-release(catalog, release);
-    0
-  end
+    note("Aborted.");
+  end;
 end method;
+
+define function yes-or-no? (prompt :: <string>) => (yes? :: <bool>)
+  block (return)
+    while (#t)
+      format-out("\n%s", prompt);
+      force-out();
+      let answer = strip(read-line(*standard-input*));
+      if (~member?(answer, #["yes", "no", "ok"], test: string-equal-ic?))
+        format-out("Please enter yes or no.\n");
+        force-out();
+      else
+        return(member?(answer, #["yes", "ok"], test: string-equal-ic?))
+      end;
+    end while;
+  end
+end function;

documentation/source/index.rst

@@ -633,14 +633,16 @@ dylan publish
 The "publish" subcommand adds a new release of a package to the package
 catalog.
 
-Synopsis: ``dylan publish <package-name>``
+Synopsis: ``dylan publish <pacman-catalog-directory>``
 
-.. note:: For now, until a fully automated solution is implemented, it works by
-   modifying the local copy of the catalog so that you can manually run the
-   `pacman-catalog`_ tests and submit a pull request. This eliminates a lot of
-   possibilities for making mistakes while editing the catalog by hand.
+.. note:: For now, until a fully automated solution is implemented, the publish
+   command works by modifying a local copy of the catalog so that you can
+   manually submit a pull request. This eliminates a lot of possibilities for
+   making mistakes while editing the catalog by hand.
 
-This command may (as usual) be run from anywhere inside a workspace. Once
+This command publishes a package associated with the current workspace. It
+searches up from the current directory to find :file:`dylan-package.json`. Note
+that this means you can't be in the root of a multi-package workspace. Once
 you're satisfied that you're ready to release a new version of your package
 (tests pass, doc updated, etc.) follow these steps:
 
@@ -650,31 +652,28 @@ you're satisfied that you're ready to release a new version of your package
 #.  Update any dependencies in :file:`dylan-package.json` as needed. Normally
     this will happen naturally during development as you discover you need
     newer package versions, but this is a good time to review deps and update
-    get bug fixes.  **Remember to `dylan update`_ and re-run your tests if you
-    change deps!**
+    to get bug fixes if desired.  **Remember to `dylan update`_ and re-run your
+    tests if you change deps!**
 
 #.  Make a new release on GitHub with a tag that matches the release version.
     For example, if the ``"version"`` attribute in :file:`dylan-package.json`
     is ``"0.5.0"`` the GitHub release should be tagged ``v0.5.0``.
 
-#.  Clone https://github.com/dylan-lang/pacman-catalog in the same Dylan
-    workspace, so that it is an active package and make a new Git branch in it.
-    In the next step the `dylan publish`_ command will make changes there for
-    you.
+#.  Clone https://github.com/dylan-lang/pacman-catalog somewhere.  In the next
+    step the `dylan publish`_ command will make changes there for you.
 
-    If you already had pacman-catalog as an active packgae, **make sure to pull
-    the latest changes.**
+    If you had already cloned pacman-catalog, **make sure to pull the latest
+    changes.**
 
-#.  Run ``dylan publish my-package``.  (If `pacman-catalog`_ isn't already an
-    active package in your workspace the command will abort and give you
-    instructions how to fix it.)
+#.  Run :command:`dylan publish /path/to/pacman-catalog`, pointing to where you
+    just cloned the pacman-catalog.
 
 #.  Commit the changes to `pacman-catalog`_ and submit a pull request.  The
     tests to verify the catalog will be run automatically by the GitHub CI.
 
 #.  Once your PR has been merged, verify that the package is available in the
-    catalog by running ``dylan install my-package@0.5.0``, substituting your
-    new release name and version.
+    catalog by running :command:`dylan install my-package@0.5.0`, substituting
+    your new package name and release version.
 
 #.  It's generally good practice to update the version immediately after
     publishing a release so that it reflects the *next* release's version

dylan-package.json

@@ -1,6 +1,6 @@
 {
     "name": "dylan-tool",
-    "version": "0.7.0",
+    "version": "0.8.0",
     "category": "language-tools",
     "contact": "dylan-lang@googlegroups.com",
     "description": "Manage Dylan workspaces, packages, and registries",

library.dylan

@@ -163,7 +163,9 @@ define module workspaces
     update,
     workspace-active-packages,
     workspace-default-library-name,
-    workspace-directory;
+    workspace-directory,
+    workspace-registry-directory,
+    workspace-release;
 end module;
 
 define module %workspaces

pacman/catalog.dylan

@@ -76,11 +76,11 @@ define variable *override-logged?* = #f;
 // catalog's cache. If the DYLAN_CATALOG environment variable is set then that
 // directory is used and no attempt is made to download the latest catalog.
 define function catalog
-    () => (c :: <catalog>)
+    (#key directory) => (c :: <catalog>)
   if (*catalog*)
     *catalog*
   else
-    let override = os/environment-variable($catalog-env-var);
+    let override = directory | os/environment-variable($catalog-env-var);
     let directory
       = if (override)
           if (~*override-logged?*)
@@ -224,12 +224,13 @@ end function;
 
 // Write a package to the catalog in JSON format.
 define function write-package-file
-    (cat :: <catalog>, package :: <package>) => ()
+    (cat :: <catalog>, package :: <package>) => (file :: <file-locator>)
   let file = package-locator(cat.catalog-directory, package);
   fs/ensure-directories-exist(file);
   fs/with-open-file (stream = file, direction: #"output", if-exists: #"replace")
     print-json(package, stream, indent: 2, sort-keys?: #t);
   end;
+  file
 end function;
 
 // Generate a locator for the given package (or package name). `root` is the
@@ -352,7 +353,7 @@ end method;
 // given release. Signals <catalog-error> if the release is not newer than any
 // existing releases for the package.
 define function publish-release
-    (cat :: <catalog>, release :: <release>) => ()
+    (cat :: <catalog>, release :: <release>) => (file :: <file-locator>)
   let name = package-name(release);
   let old-package = find-package(cat, name);
   let new-package = release-package(release);
@@ -374,5 +375,5 @@ define function publish-release
   // package-level attributes from dylan-package.json (e.g., "description")
   // will overwrite the package-level attributes from the catalog, if they're
   // different.
-  write-package-file(cat, new-package);
+  write-package-file(cat, new-package)
 end function;

pacman/versions.dylan

@@ -109,11 +109,12 @@ end method;
 
 
 
-// <latest> is a special version representing whatever the latest <semantic-version> for
-// a package. There is no way to compare <latest> to <branch-version>, and there is no
-// need to compare it to <semantic-version> since semantic versions in the catalog are
-// always sorted newest to oldest. <latest> is only allowed as a dependency in
-// dylan-package.json files, not in the catalog.
+// <latest> is a special version representing whatever the latest
+// <semantic-version> is for a package. There is no way to compare <latest> to
+// <branch-version>, and there is no need to compare it to <semantic-version>
+// since semantic versions in the catalog are always sorted newest to
+// oldest. <latest> is only allowed as a dependency in dylan-package.json
+// files, not in the catalog.
 define class <latest> (<version>, <singleton-object>) end;
 
 define constant $latest :: <latest> = make(<latest>);

workspaces/workspaces-test.dylan

@@ -25,7 +25,7 @@ define test test-find-workspace-directory ()
   // On github this test runs inside the dylan-tool checkout, so there's
   // a dylan-package.json file outside the test-temp-directory(), hence
   // the prefix check. Succeed as long as the ws-dir is outside tmp.
-  assert-true(ws-dir = bottom
+  assert-true(~ws-dir
                 | begin
                     let wdir = as(<string>, ws-dir);
                     let tmps = as(<string>, tmp);

workspaces/workspaces.dylan

@@ -102,8 +102,17 @@ define class <workspace> (<object>)
     init-keyword: default-library-name:;
   constant slot multi-package-workspace? :: <bool> = #f,
     init-keyword: multi-package?:;
+  // The <release> that was loaded from dylan-package.json, if any.
+  constant slot workspace-release :: false-or(pm/<release>) = #f,
+    init-keyword: release:;
 end class;
 
+define function workspace-registry-directory
+    (ws :: <workspace>) => (dir :: <directory-locator>)
+  let registry = ws.workspace-registry;
+  subdirectory-locator(registry.root-directory, "registry")
+end function;
+
 // Loads the workspace definition by looking up from `directory` to find the
 // workspace root and loading the workspace.json file. If no workspace.json
 // file exists, the workspace is created using the dylan-package.json file (if
@@ -113,10 +122,16 @@ end class;
 define function load-workspace
     (#key directory :: <directory-locator> = fs/working-directory())
  => (workspace :: <workspace>)
-  let ws-dir = find-workspace-directory(directory);
+  let ws-file = find-workspace-file(directory);
+  let dp-file = find-dylan-package-file(directory);
+  ws-file
+    | dp-file
+    | workspace-error("Can't find %s or %s. Not inside a workspace?",
+                      $workspace-file-name, $dylan-package-file-name);
+  let ws-dir = locator-directory(ws-file | dp-file);
   let registry = make(<registry>, root-directory: ws-dir);
   let active-packages = find-active-packages(ws-dir);
-  let ws-json = load-workspace-file(directory);
+  let ws-json = ws-file & load-json-file(ws-file);
   let default-library
     = ws-json & element(ws-json, $default-library-key, default: #f);
   if (~default-library & active-packages.size = 1)
@@ -128,40 +143,33 @@ define function load-workspace
        active-packages: active-packages,
        directory: ws-dir,
        registry: registry,
+       release: dp-file & pm/load-dylan-package-file(dp-file),
        default-library-name: default-library,
-       multi-package?: begin
-                         let ws-file = find-workspace-file(directory);
-                         let dp-file = find-dylan-package-file(directory);
-                         ws-file
-                           & dp-file
-                           & (ws-file.locator-directory ~= dp-file.locator-directory)
-                       end)
+       multi-package?: ws-file
+                         & dp-file
+                         & (ws-file.locator-directory ~= dp-file.locator-directory))
 end function;
 
-define function load-workspace-file (directory) => (config :: false-or(<table>))
-  let ws-file = find-workspace-file(directory);
-  if (ws-file)
-    fs/with-open-file(stream = ws-file, if-does-not-exist: #f)
-      let object = parse-json(stream, strict?: #f, table-class: <istring-table>);
-      if (~instance?(object, <table>))
-        workspace-error("Invalid workspace file %s, must contain at least {}", ws-file);
-      end;
-      object
-    end
+define function load-json-file (file :: <file-locator>) => (config :: false-or(<table>))
+  fs/with-open-file(stream = file, if-does-not-exist: #f)
+    let object = parse-json(stream, strict?: #f, table-class: <istring-table>);
+    if (~instance?(object, <table>))
+      workspace-error("Invalid JSON file %s, must contain at least {}", file);
+    end;
+    object
   end
 end function;
 
 // Find the workspace directory. The nearest directory containing
 // workspace.json always takes precedence. Otherwise the nearest directory
 // containing dylan-package.json.
 define function find-workspace-directory
-    (start :: <directory-locator>) => (dir :: <directory-locator>)
+    (start :: <directory-locator>) => (dir :: false-or(<directory-locator>))
   let ws-file = find-workspace-file(start);
   (ws-file & ws-file.locator-directory)
     | begin
         let pkg-file = find-dylan-package-file(start);
-        (pkg-file & pkg-file.locator-directory)
-          | start
+        pkg-file & pkg-file.locator-directory
       end
 end function;