Repository: amperity/lein-monolith Branch: main Commit: 0ca55add7740 Files: 52 Total size: 151.8 KB Directory structure: gitextract_zz72azj6/ ├── .circleci/ │ └── config.yml ├── .cljstyle ├── .github/ │ └── CODEOWNERS ├── .gitignore ├── .java-version ├── CHANGELOG.md ├── LICENSE ├── README.md ├── doc/ │ ├── config.md │ └── releasing.md ├── example/ │ ├── .gitignore │ ├── apps/ │ │ └── app-a/ │ │ ├── .gitignore │ │ ├── project.clj │ │ ├── src/ │ │ │ └── project_a/ │ │ │ └── core.clj │ │ └── test/ │ │ └── project_a/ │ │ └── core_test.clj │ ├── libs/ │ │ ├── lib-a/ │ │ │ ├── .gitignore │ │ │ ├── project.clj │ │ │ ├── src/ │ │ │ │ └── lib_a/ │ │ │ │ └── core.clj │ │ │ └── test/ │ │ │ └── lib_a/ │ │ │ └── core_test.clj │ │ ├── lib-b/ │ │ │ ├── .gitignore │ │ │ ├── project.clj │ │ │ ├── src/ │ │ │ │ └── lib_b/ │ │ │ │ └── core.clj │ │ │ └── test/ │ │ │ └── lib_b/ │ │ │ └── core_test.clj │ │ ├── lib-d/ │ │ │ ├── project.clj │ │ │ └── src/ │ │ │ └── lib_d/ │ │ │ └── core.clj │ │ └── subdir/ │ │ └── lib-c/ │ │ ├── .gitignore │ │ ├── project.clj │ │ └── src/ │ │ └── lib_c/ │ │ └── core.clj │ └── project.clj ├── project.clj ├── src/ │ ├── lein_monolith/ │ │ ├── color.clj │ │ ├── config.clj │ │ ├── dependency.clj │ │ ├── plugin.clj │ │ ├── target.clj │ │ └── task/ │ │ ├── checkouts.clj │ │ ├── each.clj │ │ ├── fingerprint.clj │ │ ├── graph.clj │ │ ├── info.clj │ │ ├── util.clj │ │ └── with_dependency_set.clj │ └── leiningen/ │ └── monolith.clj └── test/ ├── example-tests.sh └── lein_monolith/ ├── config_test.clj ├── dependency_test.clj ├── monolith_test.clj ├── plugin_test.clj ├── task/ │ ├── each_test.clj │ ├── util_test.clj │ └── with_dependency_set_test.clj └── test_utils.clj ================================================ FILE CONTENTS ================================================ ================================================ FILE: .circleci/config.yml ================================================ version: 2.1 # Common executor configuration executors: clojure: docker: - image: circleci/clojure:openjdk-11-lein-2.9.1 working_directory: ~/repo # Job definitions jobs: style: executor: clojure steps: - checkout - run: name: Install cljstyle CLI environment: CLJSTYLE_VERSION: 0.15.0 command: | wget https://github.com/greglook/cljstyle/releases/download/${CLJSTYLE_VERSION}/cljstyle_${CLJSTYLE_VERSION}_linux.zip unzip cljstyle_${CLJSTYLE_VERSION}_linux.zip - run: name: Check source formatting command: "./cljstyle check --report" lint: executor: clojure steps: - checkout - run: name: Install clj-kondo environment: CLJ_KONDO_VERSION: 2022.05.27 command: | wget https://github.com/clj-kondo/clj-kondo/releases/download/v${CLJ_KONDO_VERSION}/clj-kondo-${CLJ_KONDO_VERSION}-linux-amd64.zip unzip clj-kondo-${CLJ_KONDO_VERSION}-linux-amd64.zip - run: name: Lint source code command: "./clj-kondo --lint src test" test: executor: clojure steps: - checkout - restore_cache: keys: - v1-test-{{ checksum "project.clj" }} - v1-test- - run: lein deps - run: lein check - run: lein install - run: lein with-profile +ci test2junit - run: rm -r ~/.m2/repository/lein-monolith - store_test_results: path: test-results - save_cache: key: v1-test-{{ checksum "project.clj" }} paths: - ~/.m2 examples: executor: clojure steps: - checkout - restore_cache: keys: - v1-test-{{ checksum "project.clj" }} - v1-test- - run: name: Run Example Tests command: ./test/example-tests.sh # Workflow definitions workflows: version: 2 build: jobs: - style - lint - test - examples: requires: - test ================================================ FILE: .cljstyle ================================================ ;; Clojure formatting rules ;; vim: filetype=clojure {:files {:ignore #{"checkouts" "target"}} :rules {:indentation {:indents {config/debug-profile [[:block 1]] d/future-with [[:block 1]]}}}} ================================================ FILE: .github/CODEOWNERS ================================================ * @amperity/open-source ================================================ FILE: .gitignore ================================================ target/ /classes /checkouts /.lein-* /.nrepl-port pom.xml pom.xml.asc *.class *.jar test-results build.xml .lsp/ .clj-kondo/ !.clj-kondo/config.edn .calva/ ================================================ FILE: .java-version ================================================ 1.8 ================================================ FILE: CHANGELOG.md ================================================ Change Log ========== All notable changes to this project will be documented in this file, which follows the conventions of [keepachangelog.com](http://keepachangelog.com/). This project adheres to [Semantic Versioning](http://semver.org/). ## Unreleased ... ## [1.11.0] - 2026-04-17 ### Added - `deps-on` now supports a `:transitive` option to show all transitive dependents, not just direct ones. Each entry shows the linking dependency that connects it to the tree. [#108](https://github.com/amperity/lein-monolith/pull/108) ### Fixed - `deps-of` now correctly filters out external dependencies in non-transitive mode, showing only internal subprojects. - `deps-of` now correctly parses the `:transitive` option from the command line. ## [1.10.4] - 2025-02-16 ### Fixed - Fix performance bottleneck in writing fingerprints files. [#105](https://github.com/amperity/lein-monolith/pull/105) ## [1.10.3] - 2025-08-25 ### Fixed - Attempted to fix non-deterministic errors in `each :parallel ` by synchronizing namespace loading. These errors existed before, but were made much more likely to occur by to [#102](https://github.com/amperity/lein-monolith/pull/102). [#103](https://github.com/amperity/lein-monolith/pull/103) ## [1.10.2] - 2025-08-25 ### Fixed - Fixed a bug where `each :parallel ` would run tasks sequentially for the first 10 seconds. [#102](https://github.com/amperity/lein-monolith/pull/102) ## [1.10.1] - 2024-10-15 ### Changed - Subproject `:clean-targets` will automatically be updated with absolute paths to support running the `clean` task as part of `lein monolith each`. [#99](https://github.com/amperity/lein-monolith/pull/99) ## [1.10.0] - 2024-06-03 ### Added - Adds higher order task, `with-dependency-set`, that allows running a task with a dependency set defined in the metaproject. [#97](https://github.com/amperity/lein-monolith/pull/97) ### Changed - Dependency sets declared in a subproject profile.clj will override the project `:managed-dependencies` rather than concatenating with the metaproject `:managed-dependencies`. [#97](https://github.com/amperity/lein-monolith/pull/97) ## [1.9.1] - 2024-04-17 ### Fixed - Subproject fingerprints now include `:jar-exclusions` in the calculation. [#95](https://github.com/amperity/lein-monolith/pull/95) ## [1.9.0] - 2023-12-07 ### Added - Dependency sets can now be defined in the metaproject, and projects can opt into them with the `:monolith/dependency-set` key. [#93](https://github.com/amperity/lein-monolith/pull/93) ## [1.8.0] - 2022-07-13 ### Added - Running `lein monolith changed :debug` will now print lots of extra information about what fingerprint values have changed and why. [#89](https://github.com/amperity/lein-monolith/pull/89) - New `lein monolith show-fingerprints` command will print out detailed information about the fingerprint calculations for one or more projects, compared to an existing mark. [#91](https://github.com/amperity/lein-monolith/pull/91) ### Changed - Renamed the `master` branch to `main`. - Dependency fingerprints are now built from normalized hash trees, so changes to the ordering of dependencies or profiles will no longer change the dependency fingerprint. [#90](https://github.com/amperity/lein-monolith/pull/90) ## [1.7.1] - 2021-06-11 ### Changed - Bump dependency versions. ## [1.7.0] - 2021-06-11 ### Added - The `:project-dirs` pattern can now support recursive subdirectories with a double-wildcard `.../**` syntax. [#85](https://github.com/amperity/lein-monolith/pull/85) ### Fixed - Fingerprinting will now correctly track Java files as project source files. [#87](https://github.com/amperity/lein-monolith/pull/87) ## [1.6.1] - 2020-10-09 ### Changed - The `lint` task now only considers dependency names and versions for detecting conflicts, which should improve the signal-to-noise ratio. [#73](https://github.com/amperity/lein-monolith/pull/73) - The `unlink` task will now only remove internal checkouts by default. It also accepts an `:all` option to remove external checkouts, as well as a list of project names to specifically unlink. [#66](https://github.com/amperity/lein-monolith/issues/66) [#80](https://github.com/amperity/lein-monolith/pull/80) ### Fixed - When the `each` task provides a command to resume execution, the arguments will be properly quoted for shells. [#27](https://github.com/amperity/lein-monolith/issues/27) [#72](https://github.com/amperity/lein-monolith/pull/72) - The `each` task is now compatible with composite profiles. [#29](https://github.com/amperity/lein-monolith/issues/29) [#77](https://github.com/amperity/lein-monolith/pull/77) - When `each` is used with `:parallel`, task aliases are now correctly resolved before iteration starts. [#36](https://github.com/amperity/lein-monolith/issues/36) [#74](https://github.com/amperity/lein-monolith/pull/74) ### Added - The monolith settings can now use `:inherit-raw` and `:inherit-leaky-raw` to list keys which should be inherited without interpretation from the metaproject. This is useful for inheriting source paths without them being canonicalized. [#68](https://github.com/amperity/lein-monolith/issues/68) [#75](https://github.com/amperity/lein-monolith/pull/75) - The `each` task supports a new `:silent` option, which will suppress task output for successful projects. This can be useful in large CI builds where the output is only consulted in the event of failure. [#37](https://github.com/amperity/lein-monolith/issues/37) [#81](https://github.com/amperity/lein-monolith/pull/81) ## [1.5.0] - 2020-09-17 ### Added - Subproject fingerprints now includes the Java version in the calculation. [#71](https://github.com/amperity/lein-monolith/pull/71) ## [1.4.0] - 2019-11-08 ### Fixed - When an exception is thrown during an `each :endure` iteration, the stack trace is printed immediately instead of swallowing the error. - When an exception is thrown during an `each :output` iteration, the stack trace is printed in the output file in addition to the combined output. [#56](https://github.com/amperity/lein-monolith/pull/56) - Subtasks of `do` are resolved before parallel execution, which should ensure they are fully loaded before they are called. - Prevent a potential race condition when combining the `:parallel` and `:output` options in the `each` subtask. ### Added - The `graph` subtask supports an `:image-path` option to explicitly specify the graph image output, as well as a `:dot-path` option to also write the raw dot definition for the graph. - New `deps` subtask supports listing all project dependencies in the monorepo. The output should be suitable for other tooling to consume. ## [1.3.2] - 2019-10-21 ### Fixed - Subproject dependency calculation now includes dependencies declared in the project's profiles. [#51](https://github.com/amperity/lein-monolith/pull/51) ## [1.3.1] - 2019-10-14 ### Fixed - Subproject fingerprints now include the project's artifact version in the calculation. ### Added - Subprojects may include a `:monolith/fingerprint-seed` value as a way to force fingerprint invalidations when desired. ## [1.3.0] - 2019-10-07 ### Changed - Remove dependency on `puget` for colorized output and canonical printing. This avoids pulling in `fipp` which is problematic to use in Leiningen on Java 9+. [#49](https://github.com/amperity/lein-monolith/pull/49) ### Added - Allow ANSI color output to be disabled by setting the `LEIN_MONOLITH_COLOR` environment variable to `no`, `false`, or `off`. ## [1.2.2] - 2019-09-11 ### Fixed - Ensure projects are not initialized concurrently to guard against "unbound fn" errors. [#15](https://github.com/amperity/lein-monolith/issues/15) [#48](https://github.com/amperity/lein-monolith/pull/48) ### Changed - Adopted cljfmt style rules and added CI style checks. ## [1.2.1] - 2019-04-25 ### Added - Allow the `graph` subtask to take specific targeting options. [#43](https://github.com/amperity/lein-monolith/pull/43) ### Fixed - The `each` subtask couldn't be composed with subsequent tasks if it had no work to do. [#44](https://github.com/amperity/lein-monolith/pull/44) ## [1.2.0] - 2019-01-08 ### Changed - The `each` subtask no longer fails when zero projects are selected. ### Added - The `each` subtask supports `:refresh` and `:changed` to perform incremental runs over the projects. - New `changed`, `mark-fresh`, and `clear-fingerprints` subtasks inspect and manipulate the underlying fingerprints used to perform incremental runs. ### Fixed - `link` could try to link a project to itself and fail. [#41](https://github.com/amperity/lein-monolith/pull/41) - Bumped puget version to 1.0.3 to support JDK 11. ## [1.1.0] - 2018-08-17 ### Added - The `link` subtask accepts a list of projects to target, allowing you to select which checkout links get created. ### Fixed - The `graph` subtask could throw an exception when clusters exist at the root of the metaproject. [#31](https://github.com/amperity/lein-monolith/pull/31) ## [1.0.1] - 2017-05-22 ### Added - Metaprojects can specify an `:inherit-leaky` vector to generate a leaky profile for inclusion in subprojects' built artifacts. ## [1.0.0] This release marks the first stable major release of the plugin. Actual feature changes are small, but `lein-monolith` has seen enough production use to be considered a mature project. ### Added - New `:output` option to `each` task allows saving individual subproject output to separate files under the given directory. ### Fixed - Tasks run with `each` now use the subproject's root as the working directory, rather than the monolith root. [#21](https://github.com/amperity/lein-monolith/issues/21) ## [0.3.2] - 2017-03-21 ### Changed - Abstracted targeting options to generalize to multiple tasks. ### Added - The `info` task supports targeting options. - The `with-all` task supports targeting options. ### Removed - Drop deprecated `:subtree` targeting option. ## [0.3.1] - 2016-12-14 ### Added - Options taking a subproject name now support omitting the namespace component if only one project has that name. - The `each` task supports additional dependency closure selection options, including `:in `, `:upstream`, `:upstream-of `, `:downstream`, and `:downstream-of `. - Multiple `:project-selectors` can be provided to `each` in order to chain the filters applied to the targeted projects. ### Changed - Option parsing is handled more uniformly within the plugin. - The `:subtree` option to `each` is deprecated. ### Fixed - Resolved a potential issue where filtering the targeted subprojects could result in invalid parallel execution order. ## [0.3.0] - 2016-09-16 ### Added - Add `:report` option to the `each` task to print out detailed timing once `each` completes. - Add `each :parallel ` option to run tasks on subprojects concurrently. Tasks still run in dependency order, but mutually independent projects are run simultaneously on a fixed-size thread pool. ### Changed - Modify `each` to print a completion message after subproject tasks finish running. This improves output during parallel execution. ## [0.2.3] - 2016-08-15 ### Added - The `each` task supports an `:endure` option to continue iteration in the event of subproject failures. This supports better CI usage for testing. ## [0.2.2] - 2016-08-08 ### Added - The `each` task now adds a `:monolith/index` key to project maps passed to the project-selector function to enable mod-distribution logic. ## [0.2.1] - 2016-08-05 ### Changed - Split up subtasks into separate namespaces to improve code readability. ### Fixed - Fix bug where options to `each` weren't output in the continuation command. ### Added - Add `:deep` option to the `link` task to link checkouts for all transitive dependencies. - Add explicit request for garbage-collection before running subproject tasks in `each` iteration. - Warn when `with-all` is used in a subproject. ## [0.2.0] - 2016-07-20 This release contains a **breaking change** in how the plugin is configured! All options are now contained in a required metaproject at the repository root instead of a separate `monolith.clj` file. This should also be much faster to run due to lazily initializing subprojects instead of loading them all before running any commands. ### Changed - Moved monolith configuration into metaproject definition. - Subprojects are loaded lazily, resulting in dramatically reduced latency before plugin tasks are executed. - The merged profile now includes `:resource-paths` from each subproject. - The merged profile no longer merges all dependencies; instead, each subproject is included in the profile and dependencies are resolved transitively. ### Added - Metaproject configuration may be inherited using the `:monolith/inherit` key in subprojects and `:monolith {:inherit [...]}` in the metaproject. - New `lint` subtask runs the dependency conflict checks which previously ran during every merged profile task. - Added unit tests and continuous-integration via CircleCI. - `each` task supports `:skip ` and `:select ` options. ### Removed - Setting the `:monolith` key in a project no longer automatically includes the merged profile; instead, it is used for general plugin configuration. ## [0.1.1] - 2016-07-08 ### Fixed - Fixed a bug in which `each :subtree` would show the wrong number of total subprojects while printing its progress. - Internal projects are now implicit dependencies of the merged monolith profile. ## 0.1.0 - 2016-07-07 Initial project release [Unreleased]: https://github.com/amperity/lein-monolith/compare/1.11.0...HEAD [1.11.0]: https://github.com/amperity/lein-monolith/compare/1.10.4...1.11.0 [1.10.4]: https://github.com/amperity/lein-monolith/compare/1.10.3...1.10.4 [1.10.3]: https://github.com/amperity/lein-monolith/compare/1.10.2...1.10.3 [1.10.2]: https://github.com/amperity/lein-monolith/compare/1.10.1...1.10.2 [1.10.1]: https://github.com/amperity/lein-monolith/compare/1.10.0...1.10.1 [1.10.0]: https://github.com/amperity/lein-monolith/compare/1.9.1...1.10.0 [1.9.1]: https://github.com/amperity/lein-monolith/compare/1.9.0...1.9.1 [1.9.0]: https://github.com/amperity/lein-monolith/compare/1.8.0...1.9.0 [1.8.0]: https://github.com/amperity/lein-monolith/compare/1.7.1...1.8.0 [1.7.1]: https://github.com/amperity/lein-monolith/compare/1.7.0...1.7.1 [1.7.0]: https://github.com/amperity/lein-monolith/compare/1.6.1...1.7.0 [1.6.1]: https://github.com/amperity/lein-monolith/compare/1.5.0...1.6.1 [1.5.0]: https://github.com/amperity/lein-monolith/compare/1.4.0...1.5.0 [1.4.0]: https://github.com/amperity/lein-monolith/compare/1.3.2...1.4.0 [1.3.2]: https://github.com/amperity/lein-monolith/compare/1.3.1...1.3.2 [1.3.1]: https://github.com/amperity/lein-monolith/compare/1.3.0...1.3.1 [1.3.0]: https://github.com/amperity/lein-monolith/compare/1.2.2...1.3.0 [1.2.2]: https://github.com/amperity/lein-monolith/compare/1.2.1...1.2.2 [1.2.1]: https://github.com/amperity/lein-monolith/compare/1.2.0...1.2.1 [1.2.0]: https://github.com/amperity/lein-monolith/compare/1.1.0...1.2.0 [1.1.0]: https://github.com/amperity/lein-monolith/compare/1.0.1...1.1.0 [1.0.1]: https://github.com/amperity/lein-monolith/compare/1.0.0...1.0.1 [1.0.0]: https://github.com/amperity/lein-monolith/compare/0.3.2...1.0.0 [0.3.2]: https://github.com/amperity/lein-monolith/compare/0.3.1...0.3.2 [0.3.1]: https://github.com/amperity/lein-monolith/compare/0.3.0...0.3.1 [0.3.0]: https://github.com/amperity/lein-monolith/compare/0.2.3...0.3.0 [0.2.3]: https://github.com/amperity/lein-monolith/compare/0.2.2...0.2.3 [0.2.2]: https://github.com/amperity/lein-monolith/compare/0.2.1...0.2.2 [0.2.1]: https://github.com/amperity/lein-monolith/compare/0.2.0...0.2.1 [0.2.0]: https://github.com/amperity/lein-monolith/compare/0.1.1...0.2.0 [0.1.1]: https://github.com/amperity/lein-monolith/compare/0.1.0...0.1.1 ================================================ FILE: LICENSE ================================================ Copyright 2016-2022 Amperity, Inc. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. ================================================ FILE: README.md ================================================ lein-monolith ============= [![CircleCI](https://circleci.com/gh/amperity/lein-monolith.svg?style=shield&circle-token=e57a92e79aa9113f1950498cbeeb0880c3f587d3)](https://circleci.com/gh/amperity/lein-monolith/tree/main) `lein-monolith` is a Leiningen plugin to work with multiple projects inside a monorepo. At a high level, the plugin gives you a way to: - Share configuration across subprojects, such as `:repositories`, `:managed-dependencies`, `:env`, etc. - Run tasks across a multiple projects matching sophisticated selection criteria. - Run tasks across a globally-merged view of multiple projects. - Query dependencies, generate graphs, and other utilities. For a more detailed introduction to the project and some motivation, see this [2016 Seajure presentation](https://docs.google.com/presentation/d/1jqYG2N2YalWdVG4oDqs1mua4hOyxVD_nejANrg6h8to/present). ## Installation Library releases are published on Clojars. To use the latest version with Leiningen, add the following plugin to your user profile or project definitions: [![Clojars Project](http://clojars.org/lein-monolith/lein-monolith/latest-version.svg)](http://clojars.org/lein-monolith/lein-monolith) ## Configuration The `monolith` task provides several commands to make working with monorepos easier. In order to use them, you'll need to create some configuration telling the plugin where your subprojects are. The configuration is provided by a _metaproject_, which lives in the repository root and must contain a value for the `:monolith` project key. Create a top-level [`project.clj`](example/project.clj) file and add the plugin and monolith entries. See the [configuration docs](doc/config.md) for more details about the available options. ## Usage `lein-monolith` can be used inside the individual projects within the monorepo, or you can use it from the repository root to operate on all the subprojects together. ### Targeting Options Many tasks which operate on multiple projects accept targeting options, which generally select or filter the command to a subset of the subprojects. - `:in ` Add the named projects directly to the targets. - `:upstream` Add the transitive dependencies of the current project to the targets. - `:upstream-of ` Add the transitive dependencies of the named projects to the targets. - `:downstream` Add the transitive consumers of the current project to the targets. - `:downstream-of ` Add the transitive consumers of the named projects to the targets. - `:select ` Use a selector from the config to filter target projects. - `:skip ` Exclude one or more projects from the target set. Each `` argument can contain multiple comma-separated project names, and all the targeting options may be provided multiple times. ### Subproject Info To see a list of all the projects that lein-monolith knows about, you can use the `info` task: ``` lein monolith info [:bare] [targets] ``` This will print out the config file location, coordinates of every subproject found, and a relative path to their location within the repo. For scripting, you can pass the `:bare` flag, which will restrict the output to just the project name and path. The plugin also provides the `deps-on` task to query which subprojects have a certain dependency: ``` lein monolith deps-on lib-b ``` Or you can go the other way with `deps-of` to find the subprojects which a certain project depends on: ``` lein monolith deps-of app-a ``` ### Subproject Iteration A useful higher-order task is `each`, which will run the following commands on every subproject in the repo, in dependency order. That means that projects which don't depend on any other internal projects will run first, letting you do things like: ``` lein monolith each check lein monolith each :upstream :parallel 4 install lein monolith each :start my-lib/foo do check, test lein monolith each :select :deployable uberjar ``` In addition to targeting options, `each` accepts: - `:start ` provide a starting point for the subproject iteration. - `:parallel` run subproject tasks concurrently, up to the number of specified threads. - `:endure` continue applying the task to every subproject, even if one fails. If any projects fail, the command will still exit with a failure status. This is useful in situations such as CI tests, where you don't want a failure to halt iteration. - `:report` show a detailed timing report after the tasks finish executing. - `:silent` suppress task output for successful projects. - `:output` path to a directory to save individual build output in. #### Incremental Builds The `:refresh` option only visits projects that have changed since the last `:refresh`. This allows incrementally building your projects: ``` lein monolith each :refresh ci/build install ``` The project is only considered refreshed if the task is successful. This means you can run tests over the projects that have changed since the last _successful_ test run: ``` lein monolith each :refresh ci/test test ``` Behind the scenes, lein-monolith is storing hashed fingerprints of each project, which you can inspect and manually manipulate: ``` lein monolith changed lein monolith mark-fresh :upstream ci/build lein monolith clear-fingerprints ci/test ``` ### Merged Source Profile The plugin can create a profile with `:resource-paths`, `:source-paths` and `:test-paths` updated to include the source and test files from multiple projects in the monorepo. The profile also sets `:dependencies` on each internal project, giving you a closure of all dependencies across all the subprojects. This can be useful for running lint and tests on multiple subprojects at once: ``` lein monolith with-all [targeting] test ``` ### Checkout Links The `link` task creates [checkout](https://github.com/technomancy/leiningen/blob/stable/doc/TUTORIAL.md#checkout-dependencies) symlinks to all the internal packages that this project depends on. The plugin also includes an `unlink` task as a convenience method for removing checkout dependencies. To link checkouts for all transitive dependencies, you can pass the `:deep` option. If you have existing checkout links which conflict, you'll get warnings. To override them, you can pass the `:force` option. ``` lein monolith link [:deep :force] [project...] lein monolith unlink [:all] [project...] ``` In general, it's recommended to only link between the projects you're actually actively working on, otherwise Leiningen has to recursively trace the full tree of checkouts before running things. ## License Licensed under the Apache License, Version 2.0. See the [LICENSE](LICENSE) file for rights and restrictions. ================================================ FILE: doc/config.md ================================================ Monolith Configuration ====================== This document lays out the various configuration options available in `lein-monolith`. ## Subproject Locations The `:project-dirs` key tells monolith where to find the projects inside the repo by giving a vector of relative paths. Each entry should point to either a direct subproject directory (containing a `project.clj` file) such as `apps/app-a`, or end with a wildcard `*` to indicate that all child directories should be searched for projects, like `libs/*`. Note that this only works with a single level of wildcard matching at the end of the path. If you would like to search recursively you can indicate that using `lib/**` and it will search for all subdirectories containing a `project.clj` file. ## Config Inheritance In order to share common project definition entries, you can also set the `:inherit` key to a vector of attributes which should be inherited by subprojects. In each subproject where you want this behavior, add a `:monolith/inherit` key. A value of `true` will merge in a profile with the attributes set in the metaproject. Alternately, you can provide a vector of additional keys to merge from the metaproject. Attaching `^:replace` metadata will cause the vector to override the attributes set in the metaproject. Some metaproject settings are only useful if they are still present in the generated build artifacts for the subprojects. The primary examples of these are `:repositories` and `:managed-dependencies`. For these, you can specify a second key in the metaproject called `:inherit-leaky`, which follows the format of `:inherit` above. Properties in this profile will be included in the built JAR and pom files for the subproject. Lastly, `lein-monolith` supports inheriting unprocessed values, via `:inherit-raw` and `:inherit-leaky-raw`. These are of particular use when inheriting paths, as Leiningen absolutizes paths upon processing a project map. By using raw inheritance, you can safely inherit paths, e.g. `:test-paths` or `:source-paths`. ## Dependency Sets The `:dependency-sets` key can be configured in the metaproject to provide child projects with a curated set of managed dependencies to opt into instead of using a single list of managed dependencies in the metaproject. This should be a map of dependency set names and their dependencies. For example, in the metaproject file we can define a dependency set called `:set-a` as follows: ```clj (defproject lein-monolith.example/all "MONOLITH" ... :monolith {:dependency-sets {:set-a [[amperity/greenlight "0.7.1"] [org.clojure/spec.alpha "0.3.218"]]} ... ) ``` The `:monolith/dependency-set` key can then be used to a opt child project into `:set-a` as follows: ```clj (defproject lein-monolith.example/app-a "MONOLITH-SNAPSHOT" ... :monolith/dependency-set :set-a ... ) ``` By selecting a dependency set from the metaproject with `:monolith/dependency-set`, you will merge in a profile with `:managed-dependencies` set to the dependencies within the dependency set. If you also configure the child project to use inherited profiles, this profile will be merged in *before* the inherited profiles. This means that dependency versions in a dependency set will have precedence over versions in an inherited `:managed-dependencies` key. Dependency set evaluation can also be forced using the `with-dependency-set` task: ```sh lein monolith with-dependency-set :foo ... ``` This works by adding and activating a profile that will replace the `:managed-dependencies` profile with the named set dependency coordinates, similar to adding the `:monolith/dependency-set` key to the project file. This can be combined with other higher-order tasks (e.g., `each`) to do preliminary testing throughout the entire repository without having to manually change each project file. For combining with other monolith tasks, `with-dependency-set` should be a sub-task of the task you want to do. For example: ```sh lein monolith each ... monolith with-dependency-set :foo test ``` It is also useful to run on the metaproject for tasks that inspect dependencies, e.g. [antq](https://github.com/liquidz/antq) or [lein-ancient](https://github.com/xsc/lein-ancient), but are not aware of monolith dependency set definitions. For example, scanning the example project with `antq`, we will see the `:current` version of the dependency set that override the managed dependencies declared in the project: ```sh lein antq [##################################################] 15/15 | :file | :name | :current | :latest | |-------------+-----------------------------+-----------------+---------| | project.clj | amperity/greenlight | 0.6.0 | 0.7.1 | # Older version | | com.amperity/vault-clj | 2.1.583 | 2.2.586 | # Not in dependency set | | org.clojure/clojure | 1.10.1 | 1.11.3 | # Global dependency lein monolith with-dependency-set :set-outdated antq [##################################################] 15/15 | :file | :name | :current | :latest | |-------------+-----------------------------+-----------------+---------| | project.clj | amperity/greenlight | 0.7.0 | 0.7.1 | # Version from dependency set | | org.clojure/spec.alpha | 0.2.194 | 0.5.238 | # Added dependency from set | | org.clojure/clojure | 1.10.1 | 1.11.3 | # Retains global dependency ``` ================================================ FILE: doc/releasing.md ================================================ # Releasing 1. Update the version number in these places: - [project.clj](./project.clj) - [example/project.clj](./example/project.clj) 1. Update [CHANGELOG.md](./CHANGELOG.md). We follow the guidelines from [keepachangelog.com](http://keepachangelog.com/) and [Semantic Versioning](http://semver.org/) 1. Commit changes, create a PR, merge the PR into `main`. 1. Create a signed tag at the release commit. `git tag -s X.X.X -m "X.X.X Release" && git push X.X.X` 1. From the release commit, run `lein deploy clojars`, which will build and upload the plugin jar to the Clojars repository. You will need to be a member of the `lein-monolith` [Clojars group](https://clojars.org/groups/lein-monolith). ================================================ FILE: example/.gitignore ================================================ /target /checkouts /.lein-* /.nrepl-port /*.bak ================================================ FILE: example/apps/app-a/.gitignore ================================================ /target /classes /checkouts pom.xml pom.xml.asc *.jar *.class /.lein-* /.nrepl-port ================================================ FILE: example/apps/app-a/project.clj ================================================ (defproject lein-monolith.example/app-a "MONOLITH-SNAPSHOT" :description "Example project with internal and external dependencies." :monolith/inherit true :monolith/dependency-set :set-a :deployable true :dependencies [[org.clojure/clojure "1.10.1"] [commons-io "2.5"] [lein-monolith.example/lib-a "MONOLITH-SNAPSHOT"] [lein-monolith.example/lib-b "MONOLITH-SNAPSHOT"]] :profiles {:shared {:source-paths ["bench"]} :dev [:shared {:dependencies [[clj-stacktrace "0.2.8"]]}] :uberjar [:shared {:dependencies [[commons-net "3.6"]]}]}) ================================================ FILE: example/apps/app-a/src/project_a/core.clj ================================================ (ns project-a.core) (defn foo "I don't do a whole lot." [x] (println x "Hello, World!")) ================================================ FILE: example/apps/app-a/test/project_a/core_test.clj ================================================ (ns project-a.core-test (:require [clojure.test :refer :all] [project-a.core :refer :all])) (deftest a-app-test (is true)) ================================================ FILE: example/libs/lib-a/.gitignore ================================================ /target /classes /checkouts pom.xml pom.xml.asc *.jar *.class /.lein-* /.nrepl-port ================================================ FILE: example/libs/lib-a/project.clj ================================================ (defproject lein-monolith.example/lib-a "MONOLITH-SNAPSHOT" :description "Example library with no internal dependencies." :monolith/inherit true :dependencies [[org.clojure/clojure "1.10.1"]]) ================================================ FILE: example/libs/lib-a/src/lib_a/core.clj ================================================ (ns lib-a.core) (defn foo "I don't do a whole lot." [x] (println x "Hello, World!")) ================================================ FILE: example/libs/lib-a/test/lib_a/core_test.clj ================================================ (ns lib-a.core-test (:require [clojure.test :refer :all] [lib-a.core :refer :all])) (deftest a-code-test (is true)) ================================================ FILE: example/libs/lib-b/.gitignore ================================================ /target /classes /checkouts pom.xml pom.xml.asc *.jar *.class /.lein-* /.nrepl-port ================================================ FILE: example/libs/lib-b/project.clj ================================================ (defproject lein-monolith.example/lib-b "MONOLITH-SNAPSHOT" :description "Example lib depending on lib-a." :monolith/inherit [:aliases] :dependencies [[org.clojure/clojure "1.10.1"] [lein-monolith.example/lib-a "MONOLITH-SNAPSHOT"]] :clean-targets ^{:protect false} ["target" "resources"]) ================================================ FILE: example/libs/lib-b/src/lib_b/core.clj ================================================ (ns lib-b.core) (defn foo "I don't do a whole lot." [x] (println x "Hello, World!")) ================================================ FILE: example/libs/lib-b/test/lib_b/core_test.clj ================================================ (ns lib-b.core-test (:require [clojure.test :refer :all] [lib-b.core :refer :all])) (deftest b-code-test (testing "FIXME, I fail." (is false))) ================================================ FILE: example/libs/lib-d/project.clj ================================================ (defproject lein-monolith.example/lib-d "MONOLITH-SNAPSHOT" :description "Example lib depending on lib-b, for testing transitive deps-on." :monolith/inherit [:aliases] :dependencies [[org.clojure/clojure "1.10.1"] [lein-monolith.example/lib-b "MONOLITH-SNAPSHOT"]]) ================================================ FILE: example/libs/lib-d/src/lib_d/core.clj ================================================ (ns lib-d.core "Example library depending on lib-b.") ================================================ FILE: example/libs/subdir/lib-c/.gitignore ================================================ /target /classes /checkouts pom.xml pom.xml.asc *.jar *.class /.lein-* /.nrepl-port ================================================ FILE: example/libs/subdir/lib-c/project.clj ================================================ (defproject lein-monolith.example/lib-c "MONOLITH-SNAPSHOT" :description "Example lib depending on lib-a." :monolith/inherit [:aliases] :dependencies [[org.clojure/clojure "1.10.1"] [lein-monolith.example/lib-a "MONOLITH-SNAPSHOT"]]) ================================================ FILE: example/libs/subdir/lib-c/src/lib_c/core.clj ================================================ (ns lib-c.core) (defn foo "I don't do a whole lot." [x] (println x "Hello, World!")) ================================================ FILE: example/project.clj ================================================ (defproject lein-monolith.example/all "MONOLITH" :description "Overarching example project." :aliases {"version+" ["version"] "version++" ["version+"]} :plugins [[lein-monolith "1.11.0"] [lein-pprint "1.2.0"]] :dependencies [[org.clojure/clojure "1.10.1"]] :managed-dependencies [[amperity/greenlight "0.6.0"] [com.amperity/vault-clj "2.1.583"]] :test-selectors {:unit (complement :integration) :integration :integration} :test-paths ^:replace ["test/unit" "test/integration"] :compile-path "%s/compiled" :monolith {:inherit [:aliases :test-selectors :env] :inherit-raw [:test-paths] :inherit-leaky [:repositories :managed-dependencies] :inherit-leaky-raw [:compile-path] :project-selectors {:deployable :deployable :unstable #(= (first (:version %)) \0)} :project-dirs ["apps/*" "libs/**" "not-found"] :dependency-sets {:set-outdated [[amperity/greenlight "0.7.0"] [org.clojure/spec.alpha "0.2.194"]] :set-a [[amperity/greenlight "0.7.1"] [org.clojure/spec.alpha "0.3.218"]]}} :env {:foo "bar"}) ================================================ FILE: project.clj ================================================ (defproject lein-monolith "1.11.0" :description "Leiningen plugin for managing subrojects within a monorepo." :url "https://github.com/amperity/lein-monolith" :license {:name "Apache License 2.0" :url "http://www.apache.org/licenses/LICENSE-2.0"} :eval-in-leiningen true :deploy-branches ["main"] :dependencies [[manifold "0.2.4"] [rhizome "0.2.9"]] :hiera {:vertical false :show-external true :cluster-depth 1 :ignore-ns #{clojure manifold}} :profiles {:dev {:plugins [[lein-cloverage "1.2.4"]] :dependencies [[org.clojure/clojure "1.10.3"]]} :ci {:plugins [[test2junit "1.4.2"]] :test2junit-silent true :test2junit-output-dir "test-results/clojure.test"}}) ================================================ FILE: src/lein_monolith/color.clj ================================================ (ns lein-monolith.color "Coloring functions which apply ANSI color codes to color terminal output." (:require [clojure.string :as str])) (def ^:private sgr-code "Map of symbols to numeric SGR (select graphic rendition) codes." {:none 0 :bold 1 :underline 3 :blink 5 :reverse 7 :hidden 8 :strike 9 :black 30 :red 31 :green 32 :yellow 33 :blue 34 :magenta 35 :cyan 36 :white 37 :fg-256 38 :fg-reset 39 :bg-black 40 :bg-red 41 :bg-green 42 :bg-yellow 43 :bg-blue 44 :bg-magenta 45 :bg-cyan 46 :bg-white 47 :bg-256 48 :bg-reset 49}) (def enabled? "Delay which yields true if text should be rendered with color." (delay (let [env (System/getenv "LEIN_MONOLITH_COLOR") disabled? (and env (contains? #{"no" "false" "off"} (str/lower-case env)))] (not disabled?)))) (defn- sgr "Returns an ANSI escope string which will apply the given collection of SGR codes." [codes] (let [codes (map sgr-code codes codes) codes (str/join \; codes)] (str \u001b \[ codes \m))) (defn colorize "Wraps the given string with SGR escapes to apply the given codes, then reset the graphics. If `*enabled*` is not truthy, returns the string unaltered." [codes string] (if @enabled? (let [codes (if (keyword? codes) [codes] (vec codes))] (str (sgr codes) string (sgr [:none]))) string)) ================================================ FILE: src/lein_monolith/config.clj ================================================ (ns lein-monolith.config (:require [clojure.java.io :as io] [lein-monolith.dependency :as dep] [leiningen.core.main :as lein] [leiningen.core.project :as project]) (:import java.io.File)) (defmacro debug-profile "Measure the time to compute the value in `body`, printing out a debug message with the total elapsed time." [message & body] `(let [start# (System/nanoTime) message# ~message value# (do ~@body) elapsed# (/ (- (System/nanoTime) start#) 1000000.0)] (lein/debug "Elapsed:" message# (format "=> %.3f ms" elapsed#)) value#)) ;; ## General Configuration (defn- find-up "Searches upward from the given root directory, locating files with the given name. Returns a sequence of `File` objects in the order they occur in the parents of `root`." [root file-name] (when root (lazy-seq (let [dir (io/file root) file (io/file dir file-name) next-files (find-up (.getParentFile dir) file-name)] (if (.exists file) (cons file next-files) next-files))))) (defn- attach-raw-to-meta "Attaches the raw monolith project as metadata to an initialized project. It's necessary to have a reference to the raw project so unprocessed values can be inherited with inherit-raw and inherit-leaky-raw." [monolith raw-project] (vary-meta monolith assoc :monolith/raw raw-project)) (defn find-monolith "Returns the loaded project map for the monolith metaproject, or nil if not found. If the given project already has the `:monolith` key, it's returned directly. Otherwise, parent directories are searched using `find-up` and any projects are loaded to check for the `:monolith` entry." [project] (if (:monolith project) (let [project-file (io/file (:root project) "project.clj") raw-project (project/read-raw (str project-file))] (attach-raw-to-meta project raw-project)) (some (fn check-project [file] (lein/debug "Reading candidate project file" (str file)) (let [super (project/read-raw (str file))] (when (:monolith super) (attach-raw-to-meta super super)))) (find-up (:root project) "project.clj")))) (defn find-monolith! "Returns the loaded project map for the monolith metaproject. Aborts with an error if not found." [project] (let [monolith (debug-profile "find-monolith" (find-monolith project))] (when-not monolith (lein/abort "Could not find monolith project in any parent directory of" (:root project))) (lein/debug "Found monolith project rooted at" (:root monolith)) monolith)) ;; ## Subproject Configuration (defn- project-dir? "Given a directory returns true if it contains a `project.clj` file" [dir] (.exists (io/file dir "project.clj"))) (defn- all-projects "Given a directory recursively search for all sub directories that contain a `project.clj` file and return that list." [dir] (let [subdirs (->> (.listFiles dir) (filter #(.isDirectory ^File %))) grouped (group-by project-dir? subdirs) top-projects (get grouped true) all-subdir-project (mapcat all-projects (get grouped false))] (concat top-projects all-subdir-project))) (defn- pick-directories "Given a path, use it to find directories. If the path names a directory, return a vector containing it. If the path ends in `/*` and the parent is a directory, return a sequence of directories which are children of the parent. If the path end in `/**` and the parent is a directory, returns a sequence of directories searched recursively which are project (contains project.clj file). Otherwise, returns nil." [^File file] (cond (.isDirectory file) [file] (and (= "*" (.getName file)) (.isDirectory (.getParentFile file))) (->> (.getParentFile file) (.listFiles) (filter #(.isDirectory ^File %))) (and (= "**" (.getName file)) (.isDirectory (.getParentFile file))) (all-projects (.getParentFile file)) :else nil)) (defn- with-absolute-clean-targets "Returns the given project map with its clean targets updated to use absolute paths to work around https://github.com/technomancy/leiningen/issues/2707" [{:keys [root clean-targets] :as project}] (let [abs-target-fn (fn [target] (if (and (string? target) (not (.isAbsolute (io/file target)))) (str (io/file root target)) target)) abs-clean-targets (with-meta (mapv abs-target-fn clean-targets) (meta clean-targets))] (assoc project :clean-targets abs-clean-targets))) (defn- read-subproject "Reads a leiningen project definition from the given directory and returns the loaded project map, or nil if the directory does not contain a valid `project.clj` file." [dir] (let [project-file (io/file dir "project.clj")] (when (.exists project-file) (lein/debug "Reading subproject definition from" (str project-file)) (-> (project/read-raw (str project-file)) (with-absolute-clean-targets))))) (defn read-subprojects! "Returns a map of (condensed) project names to raw leiningen project definitions for all the subprojects in the repo." [monolith] (->> (get-in monolith [:monolith :project-dirs]) (map (partial io/file (:root monolith))) (mapcat pick-directories) (keep read-subproject) (map (juxt dep/project-name identity)) (into {}) (debug-profile "read-subprojects!"))) ================================================ FILE: src/lein_monolith/dependency.clj ================================================ (ns lein-monolith.dependency "Functions for working with dependency coordinates and graphs." (:require [clojure.set :as set] [clojure.string :as str] [lein-monolith.color :refer [colorize]] [leiningen.core.main :as lein])) ;; ## Coordinate Functions (defn condense-name "Simplifies a dependency name symbol with identical name and namespace components to a symbol with just a name." [sym] (when sym (if (= (namespace sym) (name sym)) (symbol (name sym)) sym))) (defn project-name "Extracts the (condensed) project name from a project definition map." [project] (when project (condense-name (symbol (:group project) (:name project))))) (defn resolve-name "Given a set of valid project names, determine the match for the named project. This can be used to resolve the short name (meaning, no namespace) to a fully-qualified project name. Returns a resolved key from `project-names`, a collection of multiple matching keys, or nil if the resolution fails." [project-names sym] (let [valid-keys (set project-names)] (cond (valid-keys sym) sym (valid-keys (condense-name sym)) (condense-name sym) (nil? (namespace sym)) (let [candidates (filter #(= (name %) (name sym)) valid-keys)] (if (= 1 (count candidates)) (first candidates) (seq candidates))) :else nil))) (defn resolve-name! "Resolves a symbol to a single project name, or calls abort if no or multiple projects match." [project-names sym] (let [result (resolve-name project-names sym)] (cond (nil? result) (lein/abort "Could not resolve" sym "to any monolith subproject!") (coll? result) (lein/abort "Name" sym "resolves to multiple monolith subprojects:" (str/join " " (sort result))) :else result))) (defn clean-coord "Removes the `:scope` entry from a leiningen dependency coordinate vector, if it is present. Preserves any metadata on the coordinate." [coord] (into (empty coord) (comp (partition-all 2) (remove (comp #{:scope :exclusions} first)) cat) coord)) (defn with-source "Attaches metadata to a dependency vector which notes the source project." [dependency project-name] (vary-meta dependency assoc :monolith/project project-name)) (defn dep-source "Retrieves the project which pulled in the dependency from metadata on the spec vector." [dependency] (:monolith/project (meta dependency))) ;; ## Dependency Graphs (defn- collect-dependencies "Merges the project's top-level dependencies with all dependencies listed in the project's profiles to ensure the project has the proper dependency closure for compilation ordering." [project] (->> project (:profiles) (vals) (cons project) (mapcat :dependencies) (map (comp condense-name first)) (set))) (defn dependency-map "Converts a map of project names to definitions into a map of project names to sets of projects that node depends on." [projects] (->> (vals projects) (map collect-dependencies) (zipmap (keys projects)))) (defn upstream-keys "Returns a set of the keys which are upstream of a given node in the dependency map. Includes the root value itself." [dependencies root] (loop [result #{} queue (conj (clojure.lang.PersistentQueue/EMPTY) root)] (cond ;; Nothing left to process. (empty? queue) result ;; Already seen this node. (contains? result (peek queue)) (recur result (pop queue)) ;; Add next set of dependencies. :else (let [node (peek queue) deps (dependencies node)] (recur (conj result node) (into (pop queue) (set/difference deps result))))))) (defn downstream-keys "Returns a set of the keys which are downstream of a given node in the dependency map. Includes the root value itself." [dependencies root] (let [deps-on (fn deps-on [n] (set (keep (fn [[k deps]] (when (deps n) k)) dependencies)))] (loop [result #{} queue (conj (clojure.lang.PersistentQueue/EMPTY) root)] (cond ;; Nothing left to process. (empty? queue) result ;; Already seen this node, deps are either present or already queued. (contains? result (peek queue)) (recur result (pop queue)) ;; Add next set of dependencies. :else (let [node (peek queue) consumers (deps-on node)] (recur (conj result node) (into (pop queue) (set/difference consumers result)))))))) (defn unique-cycles "Return a set of all unique cycles in dependency graph m." [m] {:pre [(map? m)] :post [(set? %)]} (let [path->cycles (fn path->cycles [path] {:pre [(seq path)]} (let [k (peek path) vs (m k) path-set (set path)] (mapcat (fn [v] (if (path-set v) ;; found the cycle [(into [] ;; drop non-cyclic prefix (drop-while (complement #{v})) (conj path v))] (path->cycles (conj path v)))) vs))) all-cycles (mapcat #(path->cycles [%]) (keys m)) ;; remove duplicate cycles (that involve the same deps) -- like ;; (into #{} ;; (map (comp first val)) ;; (group-by set all-cycles)) ;; but in a single pass. [cycles-vecs _] (reduce (fn [[cycles-vecs cycle-sets] c] (let [cset (set c)] (if (cycle-sets cset) [cycles-vecs cycle-sets] [(conj cycles-vecs c) (conj cycle-sets cset)]))) [#{} #{}] all-cycles)] cycles-vecs)) (defn pretty-cycle "Returns a pretty-printed string representation of cycle c. eg. (println (pretty-cycle [1 2 3 1])) => + 1 ^ + 2 | + 3 |_/" [c] {:pre [(vector? c) (= (first c) (peek c))]} (if (= 2 (count c)) (str/join \newline [(str "+ " (pr-str (peek c))) "^\\" "|_|"]) (str/join (map-indexed (fn [indent el] (if (= indent (dec (count c))) ;; draw: ;; |___/ (str \| (str/join (repeat (max 1 (- indent 2)) \_)) \/) (str (case (int indent) 0 "" 1 \^ \|) (str/join (repeat indent \space)) "+ " (pr-str el) "\n"))) c)))) (defn topological-sort "Returns a sequence of the keys in the map `m`, ordered such that no key `k1` appearing before `k2` satisfies `(contains? (upstream-keys m k1) k2)`. In other words, earlier keys do not transitively depend on any later keys." ([m] (when (seq m) ;; Note that 'roots' here are keys which no other keys depend on, hence ;; should appear *later* in the sequence. (let [roots (apply set/difference (set (keys m)) (map set (vals m)))] (when (empty? roots) (let [cs (->> m unique-cycles (sort-by count))] (assert (seq cs) "Found cycle but failed to reproduce") (throw (ex-info (str "Dependency cycle" (when (next cs) "s") " detected!\n\n" (str/join "\n\n" (map pretty-cycle cs))) {:cycles cs})))) (concat (topological-sort (apply dissoc m roots)) (sort roots))))) ([m ks] (filter (set ks) (topological-sort m)))) ;; ## Dependency Resolution (defn sourced-dependencies "Given a project map, returns a sequence of dependency coordinates with metadata tracking the source." [project] (let [pn (project-name project)] (map #(with-source % pn) (:dependencies project)))) (defn lint-dependency "Given a dependency name and a collection of specs for that dependency, warn if there are multiple distinct dep coordinates." [dep-name specs] (let [specs (mapv clean-coord specs) projects-for-specs (reduce (fn [m d] (update m d (fnil conj []) (dep-source d))) {} specs)] (when (not= 1 (count (distinct specs))) (lein/warn (colorize :red (format "WARN: Multiple dependency specs found for %s in %d projects" (condense-name dep-name) (count (distinct (map dep-source specs)))))) (doseq [[spec projects] projects-for-specs] (lein/warn (format "%-50s from %s" (pr-str spec) (str/join " " (sort projects))))) (lein/warn "")))) ================================================ FILE: src/lein_monolith/plugin.clj ================================================ (ns lein-monolith.plugin "This namespace runs inside of Leiningen on all projects and handles profile creation for `with-all` and `inherit` functionality." (:require [lein-monolith.config :as config] [lein-monolith.dependency :as dep] [leiningen.core.main :as lein] [leiningen.core.project :as project])) ;; ## Profile Generation (def profile-config "Configuration for inherited profiles. Structured as a vector of pairs to maintain ordering. The ordering is significant as the info command consumes this configuration directly, and providing deterministic output ordering is desirable." [[:monolith/inherited {:inherit-key :inherit :subproject-key :monolith/inherit}] [:monolith/inherited-raw {:raw? true :inherit-key :inherit-raw :subproject-key :monolith/inherit-raw}] [:monolith/leaky {:leaky? true :inherit-key :inherit-leaky :subproject-key :monolith/inherit-leaky}] [:monolith/leaky-raw {:leaky? true :raw? true :inherit-key :inherit-leaky-raw :subproject-key :monolith/inherit-leaky-raw}]]) (defn- subproject-dependencies "Given a map of internal projects, return a vector of dependency coordinates for the subprojects." [subprojects] (mapv #(vector (key %) (:version (val %))) subprojects)) (defn- maybe-mark-leaky "Add ^:leaky metadata to a profile if it is of the leaky type." [profile {:keys [leaky?]}] (if leaky? (vary-meta profile assoc :leaky true) profile)) (defn- choose-inheritance-source "Choose either the initialized monolith or its raw representation for use when building an inherited profile." [monolith {:keys [raw?]}] (if raw? (:monolith/raw (meta monolith)) monolith)) (defn- select-inherited-properties "Constructs a profile map containing the inherited properties from a parent project map." [monolith base-properties subproject subproject-key] (let [default (boolean (:monolith/inherit subproject)) setting (subproject-key subproject default)] (cond ;; Don't inherit anything (not setting) nil ;; Inherit the base properties specified in the parent. (true? setting) (select-keys monolith base-properties) ;; Provide additional properties to inherit, or replace if metadata is set. (vector? setting) (select-keys monolith (if (:replace (meta setting)) setting (distinct (concat base-properties setting)))) :else (throw (ex-info (str "Unknown value type for monolith inherit setting: " (pr-str setting)) {:inherit setting :subproject-key subproject-key}))))) (defn- inherited-profile "Constructs a profile map containing the inherited properties from a parent project map." [monolith subproject {:keys [inherit-key subproject-key]}] (when-let [base-properties (get-in monolith [:monolith inherit-key])] (when-let [profile (select-inherited-properties monolith base-properties subproject subproject-key)] (when (contains? profile :profiles) (lein/warn "WARN: nested profiles cannot be inherited; ignoring :profiles in monolith" inherit-key)) (dissoc profile :profiles)))) (defn build-inherited-profiles "Returns a vector of map entries from profile keys to inherited profile maps. We use a vector here instead of a map to preserve profile ordering." [monolith subproject] (reduce (fn [acc [key config]] (let [profile (some-> (choose-inheritance-source monolith config) (inherited-profile subproject config) (maybe-mark-leaky config))] (if profile (conj acc [key profile]) acc))) [] profile-config)) (defn build-dependency-profiles "Constructs a vector with a profile map entries containing managed dependencies from the subproject's chosen dependency set. Returns nil if the subproject does not use a dependency set." [monolith subproject] (when-let [dependency-set (:monolith/dependency-set subproject)] (let [dependencies (or (get-in monolith [:monolith :dependency-sets dependency-set]) (lein/abort (format "Unknown dependency set %s used in project %s" dependency-set (:name subproject))))] [[:monolith/dependency-set ^:leaky {:managed-dependencies (vary-meta dependencies assoc :replace true)}]]))) (defn build-profiles "Constructs a vector of profile keys to inherited profile maps and the dependency set profile map. We use a vector here instead of a map to preserve profile ordering." [monolith subproject] ;; The dependency set profile should be the first profile, so that its managed dependencies ;; take precedence. (vec (concat (build-dependency-profiles monolith subproject) (build-inherited-profiles monolith subproject)))) ;; ## Profile Utilities (defn profile-active? "Check whether the given profile key is in the set of active profiles on the given project." [project profile-key] (contains? (set (:active-profiles (meta project))) profile-key)) (defn add-profile "Adds the monolith profile to the given project if it's not already present." [project profile-key profile] (if (= profile (get-in project [:profiles profile-key])) project (do (lein/debug "Adding" profile-key "profile to project" (dep/project-name project)) (project/add-profiles project {profile-key profile})))) (defn activate-profile "Activates the monolith profile in the project if it's not already active." [project profile-key] (if (profile-active? project profile-key) project (do (lein/debug "Merging" profile-key "profile into project" (dep/project-name project)) (project/merge-profiles project [profile-key])))) (defn add-active-profile "Combines the effects of `add-profile` and `activate-profile`." [project profile-key profile] (-> project (add-profile profile-key profile) (activate-profile profile-key))) ;; ## Plugin Middleware (defn- add-profiles "Adds profiles to the project. Profiles should be passed in as a vector to ensure profiles are added in the right order." [project profiles] (if (empty? profiles) project (-> project (project/add-profiles (into {} profiles)) (project/merge-profiles (mapv first profiles))))) (defn middleware "Handles inherited properties in monolith subprojects by looking for the `:monolith/inherit*` keys, or sets the managed dependencies if :monolith/dependency-set is set." ([project] (middleware project nil)) ([project monolith] (if (:monolith/active (meta project)) ;; Already activated monolith subproject, don't activate. project ;; Monolith subproject has not yet been activated, potentially add profiles. (let [monolith (or monolith (config/find-monolith project)) profiles (build-profiles monolith project)] (-> project (vary-meta assoc :monolith/active true) (add-profiles profiles)))))) (defn add-middleware "Update the given project to include the plugin middleware. Appends the middleware symbol if it is not already present." [subproject] (let [mw-sym 'lein-monolith.plugin/middleware] (if (some #{mw-sym} (:middleware subproject)) subproject (update subproject :middleware (fnil conj []) mw-sym)))) ;; ## Merged Profiles (def ^:private path-keys "Project map keys for (re)source and test paths." #{:resource-paths :source-paths :test-paths}) (defn- add-profile-paths "Update a profile paths entry by adding the paths from the given project. Returns the updated profile." [project profile k] (update profile k (fn combine-colls [coll] (-> coll set (into (get project k)) (vary-meta assoc :replace true))))) (defn merged-profile "Constructs a profile map containing merged (re)source and test paths." [monolith subprojects] (let [profile (reduce-kv (fn [profile _project-name subproject] (let [with-profiles (middleware subproject monolith) project (project/absolutize-paths with-profiles)] (reduce (partial add-profile-paths project) profile path-keys))) (select-keys monolith path-keys) subprojects)] (as-> profile v (reduce (fn sort-paths [acc k] (update acc k sort)) v path-keys) (assoc v :dependencies (subproject-dependencies subprojects))))) ================================================ FILE: src/lein_monolith/target.clj ================================================ (ns lein-monolith.target "Functions for constructing and operating on dependency closures." (:require [clojure.set :as set] [clojure.string :as str] [lein-monolith.dependency :as dep] [leiningen.core.main :as lein])) (def selection-opts {:in* 1 :upstream-of* 1 :downstream-of* 1 :skip* 1 :select* 1}) (defn- resolve-projects "Returns a set of project names that have been resolved from the given sequence, which may consist of multiple comma-separated lists. Ignores names which do not map to a project." [subprojects name-args] (some->> (seq name-args) (mapcat #(str/split % #"\s*,\s*")) (map read-string) (map (partial dep/resolve-name! (keys subprojects))) (set))) (defn- resolve-selector "Looks up the subproject selector from the configuration map. Aborts if a selector is specified but does not exist." [monolith selector-key] (when selector-key (let [selectors (get-in monolith [:monolith :project-selectors]) selector (get selectors selector-key)] (when-not selector (lein/abort (format "Project selector %s is not configured in %s" selector-key (keys selectors)))) (eval selector)))) (defn- combine-selectors "Returns a selection function to filter projects based on the `:select` options passed. Multiple selection functions apply cumulative layers of filtering, meaning a project must pass _every_ selector to be included. Returns nil if no selectors were specified." [monolith select-args] (some->> (seq select-args) (map read-string) (keep (partial resolve-selector monolith)) (apply every-pred))) (defn- filter-selected "Applies a project-selector function to the topologically-sorted set of projects to produce a final sequence of projects." [subprojects selector targets] (->> (sort targets) (map-indexed (fn [i p] [p (assoc (subprojects p) :monolith/index i)])) (filter (comp selector second)) (map first))) (defn select "Returns a set of canonical project names selected by the given options." [monolith subprojects opts] (let [dependencies (dep/dependency-map subprojects) skippable (resolve-projects subprojects (:skip opts)) selector (combine-selectors monolith (:select opts))] (-> ;; Start with explicitly-specified 'in' targets. (resolve-projects subprojects (:in opts)) (as-> targets ;; Merge all targeted upstream dependencies. (->> (:upstream-of opts) (resolve-projects subprojects) (map (partial dep/upstream-keys dependencies)) (reduce set/union targets)) ;; Merge all targeted downstream dependencies. (->> (:downstream-of opts) (resolve-projects subprojects) (map (partial dep/downstream-keys dependencies)) (reduce set/union targets)) ;; If target set empty, replace with full set. (if (empty? targets) (set (keys subprojects)) targets)) (cond->> ;; Exclude all 'skip' targets. skippable (remove skippable) ;; Filter using the selector, if any. selector (filter-selected subprojects selector)) (set)))) ================================================ FILE: src/lein_monolith/task/checkouts.clj ================================================ (ns lein-monolith.task.checkouts (:require [clojure.java.io :as io] [clojure.string :as str] [lein-monolith.dependency :as dep] [lein-monolith.task.util :as u] [leiningen.core.main :as lein]) (:import java.io.File (java.nio.file Files LinkOption Path))) (defn- create-symlink! "Creates a link from the given source path to the given target." [source target] (Files/createSymbolicLink source target (make-array java.nio.file.attribute.FileAttribute 0))) (defn- resolve-symlink "Read a symlink at the given path and return the canonical path to its target." [^Path link] (let [target (Files/readSymbolicLink link)] (if (.isAbsolute target) (.toRealPath target (into-array LinkOption [])) (-> (.getParent link) (.resolve target) (.toRealPath (into-array LinkOption [])))))) (defn- link-checkout! "Creates a checkout dependency link to the given subproject." [^File checkouts-dir subproject force?] (let [dep-root (io/file (:root subproject)) dep-name (dep/project-name subproject) link-name (if (namespace dep-name) (str (namespace dep-name) "~" (name dep-name)) (name dep-name)) link-path (.toPath (io/file checkouts-dir link-name)) target-path (.relativize (.toPath checkouts-dir) (.toPath dep-root))] (if (Files/exists link-path (into-array LinkOption [LinkOption/NOFOLLOW_LINKS])) ;; Link file exists. (let [actual-target (Files/readSymbolicLink link-path)] (if (and (Files/isSymbolicLink link-path) (= target-path actual-target)) ;; Link exists and points to target already. (lein/debug "Link for" dep-name "is correct") ;; Link exists but points somewhere else. (if force? ;; Recreate link since force is set. (do (lein/warn "Relinking" dep-name "from" (str actual-target) "to" (str target-path)) (Files/delete link-path) (create-symlink! link-path target-path)) ;; Otherwise print a warning. (lein/warn "WARN:" dep-name "links to" (str actual-target) "instead of" (str target-path))))) ;; Link does not exist, so create it. (do (lein/info "Linking" dep-name "to" (str target-path)) (create-symlink! link-path target-path))))) (defn link "Create symlinks in the checkouts directory pointing to all internal dependencies in the current project." [project opts project-names] (let [[_ subprojects] (u/load-monolith! project) dep-map (dep/dependency-map subprojects) selected-names (into #{} (map (partial dep/resolve-name! (keys dep-map))) project-names) projects-to-link (-> (map (comp dep/condense-name first) (:dependencies project)) (cond->> (or (:deep opts) (seq project-names)) (mapcat (partial dep/upstream-keys dep-map)) (seq selected-names) (filter selected-names)) (->> (distinct) (keep subprojects))) checkouts-dir (io/file (:root project) "checkouts")] (when (empty? projects-to-link) (lein/abort (str "Couldn't find any projects to link matching: " (str/join " " project-names)))) ;; Create checkouts directory if needed. (when-not (.exists checkouts-dir) (lein/debug "Creating checkout directory" (str checkouts-dir)) (.mkdir checkouts-dir)) ;; Check each dependency for internal projects. (doseq [subproject projects-to-link] (link-checkout! checkouts-dir subproject (:force opts))))) (defn unlink "Remove the checkouts directory from a project." [project opts project-names] (when-let [checkouts-dir (some-> (:root project) (io/file "checkouts"))] (when (.exists checkouts-dir) (lein/debug "Unlinking checkouts in" (str checkouts-dir)) (let [[_ subprojects] (u/load-monolith! project) root->subproject (into {} (map (juxt (comp str :root val) key)) subprojects) selected-names (into #{} (map (partial dep/resolve-name! (keys subprojects))) project-names)] ;; For each file in the checkouts directory. (doseq [link (.listFiles checkouts-dir) :let [link-path (.toPath ^File link)]] (when (or (:all opts) ;; Check that the file is a symlink and points to a known ;; subproject that we want to remove. (when (Files/isSymbolicLink link-path) (let [link-target (resolve-symlink link-path) target-name (root->subproject (str link-target))] (and target-name (or (empty? selected-names) (contains? selected-names target-name)))))) (lein/debug "Removing checkout link" (str link)) (Files/delete link-path)))) ;; If the directory is empty, clean up. (when (empty? (.listFiles checkouts-dir)) (.delete checkouts-dir))))) ================================================ FILE: src/lein_monolith/task/each.clj ================================================ (ns lein-monolith.task.each (:require [clojure.java.io :as io] [clojure.stacktrace :as cst] [clojure.string :as str] [lein-monolith.color :refer [colorize]] [lein-monolith.config :as config] [lein-monolith.dependency :as dep] [lein-monolith.plugin :as plugin] [lein-monolith.target :as target] [lein-monolith.task.fingerprint :as fingerprint] [lein-monolith.task.util :as u] [leiningen.core.eval :as eval] [leiningen.core.main :as lein] [leiningen.core.project :as project] [leiningen.core.utils :as utils :refer [rebind-io!]] [leiningen.do :as lein-do] [manifold.deferred :as d] [manifold.executor :as executor]) (:import (com.hypirion.io ClosingPipe Pipe RevivableInputStream) (java.io ByteArrayOutputStream OutputStream) java.time.Instant)) ;; ## Task Options (def task-opts (merge target/selection-opts {:parallel 1 :endure 0 :report 0 :silent 0 :output 1 :upstream 0 :downstream 0 :start 1 :changed 1 :refresh 1})) (defn- opts->args "Converts a set of options back into the arguments that created them. Returns a sequence of keywords and strings." [opts] (concat (when-let [threads (:parallel opts)] [:parallel threads]) (when (:endure opts) [:endure]) (when (:report opts) [:report]) (when (:silent opts) [:silent]) (when-let [out-dir (:output opts)] [:output out-dir]) (when-let [in (seq (:in opts))] [:in (str/join "," in)]) (when (:upstream opts) [:upstream]) (when-let [uof (seq (:upstream-of opts))] [:upstream-of (str/join "," uof)]) (when (:downstream opts) [:downstream]) (when-let [dof (seq (:downstream-of opts))] [:downstream-of (str/join "," dof)]) (when-let [selectors (seq (:select opts))] (mapcat (partial vector :select) selectors)) (when-let [skips (seq (:skip opts))] [:skip (str/join "," skips)]) (if-let [refresh (:refresh opts)] [:refresh refresh] (when-let [changed (:changed opts)] [:changed changed])) (when-let [start (:start opts)] [:start start]))) ;; ## Project Initialization (defn- init-project "Initialize the given subproject to prepare to run a task in it." [subproject] (config/debug-profile "init-subproject" (project/init-project (plugin/add-middleware subproject)))) (defn- resolve-tasks "Perform an initial resolution of the task to prevent metadata-related arglist errors when namespaces are loaded in parallel." [project task+args] (let [[task args] (lein/task-args task+args project)] (lein/resolve-task task) ;; Some tasks pull in other tasks, so also resolve them. (case task "do" (doseq [subtask+args (lein-do/group-args args)] (resolve-tasks project subtask+args)) "update-in" (let [subtask+args (rest (drop-while #(not= "--" %) args))] (resolve-tasks project subtask+args)) "with-profile" (let [subtask+args (rest args)] (resolve-tasks project subtask+args)) ;; default no-op nil))) ;; ## Output Handling (def ^:private output-lock "An object to lock on to ensure that project output is not interleaved when running in silent mode." (Object.)) (def ^:private ^:dynamic *task-capture-output* "If bound, write task output to this stream *instead* of the standard output and error streams." nil) (def ^:private ^:dynamic *task-file-output* "If bound, copy task output to this stream to record it to a log file." nil) (defn- tee-output-stream "Constructs a proxy of an OutputStream that will write a copy of the bytes given to both A and B." ^OutputStream [^OutputStream out-a ^OutputStream out-b] (proxy [OutputStream] [] (write ([value] (locking out-b (if (integer? value) (do (.write out-a (int value)) (.write out-b (int value))) (do (.write out-a ^bytes value) (.write out-b ^bytes value))))) ([^bytes byte-arr off len] (locking out-b (.write out-a byte-arr off len) (.write out-b byte-arr off len)))) (flush [] (.flush out-a) (.flush out-b)) (close [] ;; no-op nil))) (defn- run-with-output "A version of `leiningen.core.eval/sh` that streams in/out/err, teeing output to the given file." [& cmd] (when eval/*pump-in* (rebind-io!)) (let [cmd (into-array String cmd) env (into-array String (@#'eval/overridden-env eval/*env*)) proc (.exec (Runtime/getRuntime) ^{:tag "[Ljava.lang.String;"} cmd ^{:tag "[Ljava.lang.String;"} env (io/file eval/*dir*))] (.addShutdownHook (Runtime/getRuntime) (Thread. (fn [] (.destroy proc)))) (with-open [out (.getInputStream proc) err (.getErrorStream proc) in (.getOutputStream proc)] (let [out-dest (cond-> (or *task-capture-output* System/out) *task-file-output* (tee-output-stream *task-file-output*)) err-dest (cond-> (or *task-capture-output* System/err) *task-file-output* (tee-output-stream *task-file-output*)) pump-out (doto (Pipe. out ^OutputStream out-dest) (.start)) pump-err (doto (Pipe. err ^OutputStream err-dest) (.start)) pump-in (ClosingPipe. System/in in)] (when eval/*pump-in* (.start pump-in)) (.join pump-out) (.join pump-err) (let [exit-value (.waitFor proc)] (when eval/*pump-in* (.kill ^RevivableInputStream System/in) (.join pump-in) (.resurrect ^RevivableInputStream System/in)) (when *task-file-output* (.flush ^OutputStream *task-file-output*)) exit-value))))) (defn- apply-with-output "Applies the function to the given subproject, writing the task output to a file in the given directory." [out-dir f subproject task] (let [out-file (io/file out-dir (:group subproject) (str (:name subproject) ".txt")) elapsed (u/stopwatch)] (io/make-parents out-file) (with-open [file-output-stream (io/output-stream out-file :append true)] ;; Write task header (.write file-output-stream (.getBytes (format "[%s] Applying task to %s/%s: %s\n\n" (Instant/now) (:group subproject) (:name subproject) (str/join " " task)))) (try ;; Run task with output capturing. (binding [*task-file-output* file-output-stream] (f subproject task)) (catch Exception ex (.write file-output-stream (.getBytes (format "\nERROR: %s\n%s" (ex-message ex) (with-out-str (cst/print-cause-trace ex))))) (throw ex)) (finally ;; Write task footer (.write file-output-stream (.getBytes (format "\n[%s] Elapsed: %s\n" (Instant/now) (u/human-duration @elapsed))))))))) ;; ## Task Execution (defn- thread-safe-require-resolve "Replacement for `leiningen.core.utils/require-resolve` that is safe to execute in multiple threads." ([ns sym] (thread-safe-require-resolve (symbol ns sym))) ([sym] (if (qualified-symbol? sym) (try (requiring-resolve sym) (catch Exception _ nil)) (resolve sym)))) (defn- apply-subproject-task "Applies the task to the given subproject." [subproject task] (binding [lein/*exit-process?* false eval/*dir* (:root subproject)] (with-redefs [utils/require-resolve thread-safe-require-resolve] (let [initialized (init-project subproject)] (config/debug-profile "apply-task" (lein/resolve-and-apply initialized task)))))) (defn- run-task! "Runs the given task, returning a map of information about the run." [ctx target] ;; Try to reclaim some memory before running the task. (System/gc) (let [subproject (get-in ctx [:subprojects target]) opts (:opts ctx) marker (:changed opts) fprints (:fingerprints ctx) elapsed (u/stopwatch) task-output (when (:silent opts) (ByteArrayOutputStream.))] (try (lein/info (format "\nApplying to %s%s" (colorize [:bold :yellow] target) (if marker (str " (" (fingerprint/explain-str fprints marker target) ")") ""))) ;; Bind appropriate output options and apply the task. (binding [*task-capture-output* task-output] (if-let [out-dir (get-in ctx [:opts :output])] (apply-with-output out-dir apply-subproject-task subproject (:task ctx)) (apply-subproject-task subproject (:task ctx)))) ;; Save updated fingerprint if refreshing. (when (:refresh opts) (fingerprint/save! fprints marker target) (lein/info (format "Saved %s fingerprint for %s" (colorize :bold marker) (colorize [:bold :yellow] target)))) ;; Return successful task result. {:name target :elapsed @elapsed :success true} (catch Exception ex ;; When silent, grab output lock and print task output. (when (:silent opts) (locking output-lock (print (str task-output)) (flush))) ;; Print convenience resume tip for user. (when-not (or (:parallel opts) (:endure opts)) (let [resume-args (into ["lein" "monolith" "each"] (map u/shell-escape) (concat (opts->args (dissoc opts :start)) [:start target] (:task ctx)))] (lein/warn (format "\n%s %s\n" (colorize [:bold :red] "Resume with:") (str/join " " resume-args))))) ;; Fail or continue depending on whether endure is enabled. (if (:endure opts) (lein/warn (format "\n%s: %s\n%s" (colorize [:bold :red] "ERROR") (ex-message ex) (with-out-str (cst/print-cause-trace ex)))) (throw ex)) {:name target :elapsed @elapsed :success false :error ex}) (finally (lein/info (format "Completed %s (%s/%s) in %s" (colorize [:bold :yellow] target) (colorize :cyan (swap! (:completions ctx) inc)) (colorize :cyan (:num-targets ctx)) (colorize [:bold :cyan] (u/human-duration @elapsed)))))))) (defn- run-linear! "Runs the task for each target in a linear (single-threaded) fashion. Returns a vector of result maps in the order the tasks were executed." [ctx targets] (mapv (comp (partial run-task! ctx) second) targets)) (defn- run-parallel! "Runs the tasks for targets in multiple worker threads, chained by dependency order. Returns a vector of result maps in the order the tasks finished executing." [ctx threads targets] (let [deps (partial dep/upstream-keys (dep/dependency-map (:subprojects ctx))) thread-pool (executor/fixed-thread-executor threads {:initial-thread-count threads})] (resolve-tasks (:monolith ctx) (:task ctx)) (-> (reduce (fn future-builder [computations [_ target]] (let [upstream-futures (keep computations (deps target)) task-runner (fn task-runner [_] (d/future-with thread-pool (lein/debug "Starting project" target) (run-task! ctx target))) task-future (if (seq upstream-futures) (d/chain (apply d/zip upstream-futures) task-runner) (task-runner nil))] (assoc computations target task-future))) {} targets) (as-> computations (mapv (comp deref computations second) targets))))) (defn- run-all* "Run all tasks, using the `:parallel` option to determine whether to run them serially or concurrently." [ctx targets] (if-let [threads (get-in ctx [:opts :parallel])] (run-parallel! ctx (Integer/parseInt threads) targets) (run-linear! ctx targets))) (defn- run-all! "Run all tasks, using the `:parallel`, `:silent`, and `:output` options to determine behavior." [ctx targets] (if (or (get-in ctx [:opts :silent]) (get-in ctx [:opts :output])) ;; NOTE: this is done here rather than inside each task so that tasks ;; starting across threads don't have a chance to see the `sh` var between ;; rebindings. (with-redefs [leiningen.core.eval/sh run-with-output] (run-all* ctx targets)) (run-all* ctx targets))) ;; ## Each Task (defn- select-projects "Returns a vector of pairs of index numbers and symbols naming the selected subprojects." [monolith subprojects fprints opts] (let [dependencies (dep/dependency-map subprojects) targets (target/select monolith subprojects opts) start (when-let [start (:start opts)] (dep/resolve-name! (keys subprojects) (read-string start))) marker (:changed opts)] (-> ;; Sort project names by dependency order. (dep/topological-sort dependencies targets) (cond->> ;; Skip projects until the starting project, if provided. start (drop-while (partial not= start)) ;; Skip projects whose fingerprint hasn't changed. marker (filter (partial fingerprint/changed? fprints marker))) ;; Pair names up with an index [[i project-sym] ...] (->> (map-indexed vector))))) (defn- print-report "Reports information about the tasks given a results map." [results elapsed] (let [task-time (reduce + (keep :elapsed results)) speedup (/ task-time elapsed)] (lein/info (format "\n%s %11s" (colorize [:bold :cyan] "Run time:") (u/human-duration elapsed))) (lein/info (format "%s %11s" (colorize [:bold :cyan] "Task time:") (u/human-duration task-time))) (lein/info (format "%s %11.1f" (colorize [:bold :cyan] "Speedup:") speedup)) (lein/info (->> results (sort-by :elapsed) (reverse) (take 8) (map #(format "%-45s %s %11s" (colorize [:bold :yellow] (:name %)) (if (:success %) " " "!") (u/human-duration (:elapsed %)))) (str/join "\n") (str \newline (colorize [:bold :cyan] "Slowest projects:") \newline))))) (defn run-tasks "Iterate over each subproject in the monolith and apply the given task." [project opts task] (let [[monolith subprojects] (u/load-monolith! project) fprints (fingerprint/context monolith subprojects) opts (if-let [marker (:refresh opts)] (assoc opts :changed marker) opts) targets (select-projects monolith subprojects fprints (u/globalize-opts project opts))] (if (seq targets) (lein/info "Applying" (colorize [:bold :cyan] (str/join " " task)) "to" (colorize :cyan (count targets)) "subprojects...") (lein/info "Target selection matched zero subprojects; nothing to do")) (when (seq targets) (let [elapsed (u/stopwatch) results (run-all! {:monolith monolith :subprojects subprojects :fingerprints fprints :completions (atom (ffirst targets)) :num-targets (inc (or (first (last targets)) -1)) :task task :opts opts} targets)] (when (:report opts) (print-report results @elapsed)) (if-let [failures (seq (map :name (remove :success results)))] (lein/abort (format "\n%s: Applied %s to %s projects in %s with %d failures: %s" (colorize [:bold :red] "FAILURE") (colorize [:bold :cyan] (str/join " " task)) (colorize :cyan (count targets)) (u/human-duration @elapsed) (count failures) (str/join " " failures))) (lein/info (format "\n%s: Applied %s to %s projects in %s" (colorize [:bold :green] "SUCCESS") (colorize [:bold :cyan] (str/join " " task)) (colorize :cyan (count targets)) (u/human-duration @elapsed)))))))) ================================================ FILE: src/lein_monolith/task/fingerprint.clj ================================================ (ns lein-monolith.task.fingerprint (:require [clojure.edn :as edn] [clojure.java.io :as io] [clojure.string :as str] [lein-monolith.color :refer [colorize]] [lein-monolith.dependency :as dep] [lein-monolith.plugin :as plugin] [lein-monolith.target :as target] [lein-monolith.task.util :as u] [leiningen.core.main :as lein]) (:import (java.io File InputStream) java.security.MessageDigest java.util.Base64)) ;; ## Options (def task-opts (assoc target/selection-opts :upstream 0 :downstream 0 :debug 0)) ;; ## Hashing projects' inputs (defn- base64 [^bytes content] (-> (Base64/getUrlEncoder) (.withoutPadding) (.encode content) (String.))) (defn- sha1 "Takes a string or an InputStream, and returns a base64 string representing the SHA-1 hash." [content] (let [hasher (MessageDigest/getInstance "SHA-1")] (cond (string? content) (.update hasher (.getBytes ^String content)) (instance? InputStream content) (let [buffer (byte-array 4096) in ^InputStream content] (loop [] (let [n (.read in buffer 0 (alength buffer))] (when (pos? n) (.update hasher buffer 0 n) (recur))))) :else (throw (ex-info (str "Cannot compute digest from " (type content)) {}))) (base64 (.digest hasher)))) (defn- kv-hash "Takes a map from strings (ids of things we hashed) to strings (their hash results); returns a new hash that identifies the aggregate collection." [kind m] {:pre [(every? string? (vals m))]} (->> (seq m) (sort-by key) (map #(str (key %) \tab (val %))) (str/join "\n") (str "v2/" (name kind) "\n") (sha1))) (defn- list-all-files [^File file] (if (.isFile file) [file] (mapcat list-all-files (.listFiles file)))) (defn- local-path [project ^File file] (let [root (:root project) path (.getAbsolutePath file)] (when-not (str/starts-with? path root) (throw (ex-info "Cannot determine local path with different root" {}))) (subs path (count root)))) (defn- all-paths "Finds all source, test, and resource paths associated with a project, including those set in profiles." [project] (->> (concat [project] (vals (:profiles project))) (mapcat (juxt :source-paths :java-source-paths :test-paths :resource-paths)) (mapcat identity) (map (fn absolute-file [dir-str] ;; Monolith subprojects and profiles don't use absolute paths (if (str/starts-with? dir-str (:root project)) (io/file dir-str) (io/file (:root project) dir-str)))))) (defn- hash-sources [project] (->> (all-paths project) (mapcat list-all-files) (map (fn hash-file [^File file] [(local-path project file) (with-open [in (io/input-stream file)] (sha1 in))])) (into {}) (kv-hash :files))) (defn- dependency-coordinate-map "Turn a sequence of dependency vectors into a map from dependency symbols to coordinate maps, with the version in `:version` and other qualifiers added as entries." [dependencies] (into (sorted-map) (map (fn dep-entry [[dep-sym version & {:as extra}]] [(if (namespace dep-sym) dep-sym (symbol (name dep-sym) (name dep-sym))) (assoc extra :version version)])) dependencies)) (defn- hash-dependency-coordinate "Hash a single dependency coordinate." [coordinate] (kv-hash :dep-coordinate (into {} (map (juxt key (comp pr-str val))) coordinate))) (defn- hash-profile-dependencies "Given a map of profiles, construct a hash of profile name/dependency type keys to hashes." [profiles] (into {} (comp (mapcat (fn lookup-deps [[prof-key profile]] [(when-let [deps (seq (:dependencies profile))] [prof-key :dependencies (dependency-coordinate-map deps)]) (when-let [deps (seq (:managed-dependencies profile))] [prof-key :managed-dependencies (dependency-coordinate-map deps)])])) (remove nil?) (map (fn hash-deps [[prof-key dep-key deps]] [(str prof-key \tab dep-key) (->> deps (into {} (map (juxt key (comp hash-dependency-coordinate val)))) (kv-hash :profile-dependencies))]))) profiles)) (defn- hash-dependencies "Hashes a project's dependencies and managed dependencies, as well as that of its profiles and project root." [project] (->> (assoc (:profiles project) ::default project) (hash-profile-dependencies) (map #(str (key %) \tab (val %))) (sort) (str/join "\n") (str "v3/dependencies\n") (sha1))) (declare hash-inputs) (defn- hash-upstream-projects [project dep-map subprojects cache] (into (sorted-map) (keep (fn hash-upstream [subproject-name] (when-let [subproject (subprojects subproject-name)] [subproject-name (::final (hash-inputs subproject dep-map subprojects cache))]))) (dep-map (dep/project-name project)))) (defn- hash-jar-exclusions [project] (kv-hash :jar-exclusions (into {} (map (fn [[profile-key profile]] [profile-key (pr-str (:jar-exclusions profile))])) (assoc (:profiles project) ::default project)))) (defn- hash-inputs "Hashes each of a project's inputs, and returns a map containing each individual result, so it's easier to explain what aspect of a project caused its overall fingerprint to change. Returns a map of `{::xyz \"hash\"}` Keeps a cache of hashes computed so far, for efficiency." [project dep-map subprojects cache] (let [project-name (dep/project-name project)] (or (@cache project-name) (let [upstream-hashes (hash-upstream-projects project dep-map subprojects cache) prints {::version (str (:version project)) ::java-version (System/getProperty "java.version") ::jar-exclusions (hash-jar-exclusions project) ::seed (str (:monolith/fingerprint-seed project 0)) ::sources (hash-sources project) ::deps (hash-dependencies project) ::upstream (kv-hash :projects upstream-hashes)} prints (assoc prints ::upstream-hashes upstream-hashes ::final (kv-hash :inputs prints) ::time (System/currentTimeMillis))] (swap! cache assoc project-name prints) prints)))) ;; ## Storing fingerprints ;; The .lein-monolith-fingerprints file at the metaproject root stores the ;; detailed fingerprint map for each project and marker type. (comment ;; Example .lein-monolith-fingerprints {"build" {'foo/bar {::sources "abcde" ,,, ::final "vwxyz"} ,,,} ,,,}) (defn- fingerprints-file ^File [root] (io/file root ".lein-monolith-fingerprints")) (defn- read-fingerprints-file [root] (let [f (fingerprints-file root)] (when (.exists f) (edn/read-string (slurp f))))) (defn- write-fingerprints-file! [root fingerprints] (let [file (fingerprints-file root)] (spit file (pr-str fingerprints)))) (let [lock (Object.)] (defn update-fingerprints-file! [root f & args] (locking lock (write-fingerprints-file! root (apply f (read-fingerprints-file root) args))))) ;; ## Generating and comparing fingerprints (defn context "Create a stateful context to use for fingerprinting operations." [monolith subprojects] (let [dep-map (dep/dependency-map subprojects) root (:root monolith) initial (read-fingerprints-file root) cache (atom {}) subprojects (into {} (map (fn inherit-profiles [[k subproject]] [k (update subproject :profiles merge (into {} (plugin/build-profiles monolith subproject)))])) subprojects)] {:root root :subprojects subprojects :dependencies dep-map :initial initial :cache cache})) (defn- fingerprints "Returns a map of fingerpints associated with a project, including the ::final one. Can be compared with a previous fingerprint file." [ctx project-name] (let [{:keys [subprojects dependencies cache]} ctx] (hash-inputs (subprojects project-name) dependencies subprojects cache))) (defn changed? "Determines if a project has changed since the last fingerprint saved under the given marker." [ctx marker project-name] (let [current (fingerprints ctx project-name) past (get-in ctx [:initial marker project-name])] (not= (::final past) (::final current)))) (def ^:private fingerprint-priority "Priority ordered list of fingerprints to check; keys appearing earlier in the list will take precedence when explaining why a project is considered changed." [::version ::seed ::sources ::deps ::java-version ::jar-exclusions ::upstream]) (def ^:private reason-details {::up-to-date ["is up-to-date" "are up-to-date" :green] ::new-project ["is a new project" "are new projects" :red] ::version ["has a different version" "have different versions" :red] ::java-version ["has a different java version" "have different java versions" :red] ::jar-exclusions ["has different JAR exclusions" "have different JAR exclusions" :yellow] ::seed ["has a different seed" "have different seeds" :yellow] ::sources ["has updated sources" "have updated sources" :red] ::deps ["has updated external dependencies" "have updated external dependencies" :yellow] ::upstream ["is downstream of an affected project" "are downstream of affected projects" :yellow] ::unknown ["has a different fingerprint" "have different fingerprints" :red]}) (defn- explain-kw [ctx marker project-name] (let [current (fingerprints ctx project-name) past (get-in ctx [:initial marker project-name])] (cond (nil? past) ::new-project (= (::final past) (::final current)) ::up-to-date :else (or (some (fn [ftype] (when (not= (ftype past) (ftype current)) ftype)) fingerprint-priority) ::unknown)))) (defn explain-str [ctx marker project-name] (let [[singular _ color] (reason-details (explain-kw ctx marker project-name))] (colorize color singular))) (defn save! "Save the fingerprints for a project with the specified marker." [ctx marker project-name] (let [current (fingerprints ctx project-name)] (update-fingerprints-file! (:root ctx) assoc-in [marker project-name] current))) (defn- list-projects [project-names color] (->> project-names (map (partial colorize color)) (str/join ", "))) (defn- debug-project-fingerprints "Print a detailed representation of a project's fingerprints for debugging." [project-name past current] (let [all-attrs (disj (into (sorted-set) (concat (keys past) (keys current))) ::upstream-hashes ::final ::time) ordered-attrs (into [] (filter all-attrs) fingerprint-priority) compare-attrs (concat ordered-attrs (sort (remove (set ordered-attrs) all-attrs)) [::final]) render-attr (fn render-attr [old-val new-val same-color] (cond (and (nil? old-val) new-val) (colorize :green new-val) (and old-val (nil? new-val)) (colorize :red old-val) (= old-val new-val) (if same-color (colorize same-color new-val) new-val) :else (str (colorize :red old-val) " => " (colorize :green new-val))))] (println project-name) (doseq [attr compare-attrs] (printf "%24s: %s\n" (colorize :cyan (name attr)) (render-attr (get past attr) (get current attr) nil)) (when (= ::upstream attr) (let [past-map (::upstream-hashes past) curr-map (::upstream-hashes current)] (doseq [upstream (into (sorted-set) (concat (keys past-map) (keys curr-map)))] (printf "%16s * %s: %s\n" " " upstream (render-attr (get past-map upstream) (get curr-map upstream) :yellow))))))) (newline) (flush)) (defn changed [project opts markers] (let [[monolith subprojects] (u/load-monolith! project) ctx (context monolith subprojects) targets (filter subprojects (target/select monolith subprojects opts)) markers (if (seq markers) markers (keys (:initial ctx)))] (cond (empty? markers) (lein/info "No saved fingerprint markers") (empty? targets) (lein/info "No projects selected") :else (doseq [marker markers :let [changed (->> targets (filter (partial changed? ctx marker)) (set)) pct-changed (if (seq targets) (* 100.0 (/ (count changed) (count targets))) 0.0)]] (lein/info (colorize (cond (== 0.0 pct-changed) :green (< pct-changed 50) :yellow :else :red) (format "%.2f%%" pct-changed)) "out of" (count targets) "projects have out-of-date" (colorize :bold marker) "fingerprints:\n") (let [reasons (group-by (partial explain-kw ctx marker) targets)] (doseq [k (concat [::unknown ::new-project] fingerprint-priority [::up-to-date])] (when-let [projs (seq (k reasons))] (let [[singular plural color] (reason-details k) c (count projs)] (lein/info "*" (colorize color (count projs)) (str (if (= 1 c) singular plural) (when-not (#{::up-to-date ::upstream} k) (str ": " (list-projects projs color))))) (when (and (:debug opts) (not= k ::new-project) (not= k ::up-to-date)) (doseq [project-name projs] (debug-project-fingerprints project-name (get-in ctx [:initial marker project-name]) (fingerprints ctx project-name)))))))) (lein/info))))) (defn mark-fresh [project opts markers] (when-not (seq markers) (lein/abort "Please specify one or more markers!")) (let [[monolith subprojects] (u/load-monolith! project) ctx (context monolith subprojects) targets (filter subprojects (target/select monolith subprojects opts)) fprints (->> targets (map (fn [project-name] [project-name (fingerprints ctx project-name)])) (into {}))] (update-fingerprints-file! (:root monolith) (fn add-new-fingerprints [all-fprints] (reduce #(update %1 %2 merge fprints) all-fprints markers))) (lein/info (format "Set %s markers for %s projects" (colorize :bold (count markers)) (colorize :bold (count targets)))))) (defn show [project marker targets] (when-not (seq targets) (lein/abort "Please specify at least one project to show")) (let [[monolith subprojects] (u/load-monolith! project) ctx (context monolith subprojects) projects (->> {:in (set targets)} (target/select monolith subprojects) (dep/topological-sort (dep/dependency-map subprojects)))] (doseq [project-name projects] (debug-project-fingerprints project-name (get-in ctx [:initial marker project-name]) (fingerprints ctx project-name))))) (defn clear [project opts markers] (let [[monolith subprojects] (u/load-monolith! project) ctx (context monolith subprojects) markers (if (seq markers) (set markers) (set (keys (:initial ctx)))) targets (set (filter subprojects (target/select monolith subprojects opts)))] (update-fingerprints-file! (:root monolith) (partial into {} (keep (fn [[marker fprints]] (if (markers marker) (when-let [fprints' (seq (filter (comp targets val) fprints))] [marker fprints']) [marker fprints]))))) (lein/info (format "Cleared %s markers for %s projects" (colorize :bold (count markers)) (colorize :bold (count targets)))))) ================================================ FILE: src/lein_monolith/task/graph.clj ================================================ (ns lein-monolith.task.graph (:require [clojure.java.io :as io] [clojure.string :as str] [lein-monolith.dependency :as dep] [lein-monolith.target :as target] [lein-monolith.task.util :as u] [leiningen.core.main :as lein]) (:import java.io.File)) (def default-image-name "project-hierarchy.png") (defn- mkparent! "Ensure the parent directory exists for the given file." [^File file] (.. file getCanonicalFile getParentFile mkdir)) (defn cluster->descriptor [monolith-root subdirectory] (when (not= monolith-root subdirectory) {:label (subs (str subdirectory) (inc (count monolith-root)))})) (defn graph "Generate a graph of subprojects and their interdependencies." [project opts] ;; NOTE: This is pulled in on-demand here because Rhizome needs to load the ;; JVM's graphical context in order to render the hierarchy images. This has ;; the unfortunate side-effect of popping up a Java applet in most OS's task ;; bars, which can then steal focus away from the terminal. To keep this from ;; happening on _every_ invocation of lein-monolith, only load it when then ;; user actually wants to make graphs. (require 'rhizome.viz) (let [graph->dot (ns-resolve 'rhizome.dot 'graph->dot) dot->image (ns-resolve 'rhizome.viz 'dot->image) save-image (ns-resolve 'rhizome.viz 'save-image) [monolith subprojects] (u/load-monolith! project) targets (target/select monolith subprojects opts) dependencies (dep/dependency-map subprojects) dot-str (graph->dot targets dependencies :vertical? false :node->descriptor #(array-map :label (name %)) :node->cluster (fn [id] (when-let [root (get-in subprojects [id :root])] (str/join "/" (butlast (str/split root #"/"))))) :cluster->descriptor (partial cluster->descriptor (:root monolith)))] (when (empty? targets) (lein/abort "No targets selected to graph!")) (when-let [dot-file (some-> (:dot-path opts) io/file)] (mkparent! dot-file) (spit dot-file dot-str) (lein/info "Wrote dependency graph data to" (str dot-file))) (when-let [graph-file (or (some-> (:image-path opts) io/file) (io/file (:target-path monolith) default-image-name))] (mkparent! graph-file) (save-image (dot->image dot-str) (str graph-file)) (lein/info "Generated dependency graph image at" (str graph-file))))) ================================================ FILE: src/lein_monolith/task/info.clj ================================================ (ns lein-monolith.task.info (:require [clojure.string :as str] [lein-monolith.color :refer [colorize]] [lein-monolith.config :as config] [lein-monolith.dependency :as dep] [lein-monolith.plugin :as plugin] [lein-monolith.target :as target] [lein-monolith.task.util :as u] [leiningen.core.main :as lein])) (defn- inherited-tags "Builds tags for printing with the inherited properties, e.g. `(leaky, raw)`." [{:keys [leaky? raw?]}] (some->> (cond-> [] leaky? (conj "leaky") raw? (conj "raw")) seq (str/join ", ") (format " (%s)"))) (defn- print-inherited-info "Show information about the inherited profiles present within the monorepo configuration." [monolith] (doseq [[_profile-key {:keys [inherit-key] :as config}] plugin/profile-config] (when-let [inherited (get-in monolith [:monolith inherit-key])] (println (str "Inherited properties" (inherited-tags config) ":")) (doseq [kw inherited] (println (colorize [:bold :yellow] kw))) (newline)))) (defn info "Show information about the monorepo configuration." [project opts] (let [monolith (config/find-monolith! project)] (when-not (:bare opts) (println "Monolith root:" (:root monolith)) (newline) (print-inherited-info monolith) (when-let [dirs (get-in monolith [:monolith :project-dirs])] (println "Subproject directories:") (doseq [dir dirs] (println (colorize :magenta dir))) (newline))) (let [subprojects (config/read-subprojects! monolith) dependencies (dep/dependency-map subprojects) targets (target/select monolith subprojects opts) prefix-len (inc (count (:root monolith)))] ;; IDEA: some kind of stats about dependency graph shape (when-not (:bare opts) (printf "Internal projects (%d):\n" (count targets))) (doseq [subproject-name (dep/topological-sort dependencies targets) :let [{:keys [version root]} (get subprojects subproject-name) relative-path (subs (str root) prefix-len)]] (if (:bare opts) (println subproject-name relative-path) (printf " %-90s %s\n" (str (colorize :red \[) subproject-name \space (colorize :magenta (pr-str version)) (colorize :red \])) (colorize :cyan relative-path))))))) (defn lint "Check various aspects of the monolith and warn about possible problems." [project opts] (let [[_ subprojects] (u/load-monolith! project)] (when (:deps opts) (doseq [[dep-name coords] (->> (vals subprojects) (mapcat dep/sourced-dependencies) (group-by first))] (dep/lint-dependency dep-name coords))))) (defn deps "Print a list of subprojects and the (internal) projects they depend on. Targeting options may be used to scope down the projects listed." [project opts] (let [[monolith subprojects] (u/load-monolith! project) targets (target/select monolith subprojects opts) dependencies (dep/dependency-map subprojects)] (doseq [project-name targets] (doseq [dependency (get dependencies project-name)] (when (if (contains? subprojects dependency) (u/parse-bool (:internal opts "true")) (u/parse-bool (:external opts "false"))) (if (:bare opts) (printf "%s\t%s\n" project-name dependency) (println (colorize :bold project-name) "->" dependency))))))) (defn deps-on "Print a list of subprojects which depend on the given package(s). Defaults to the current project if none are provided." [project opts project-names] (let [[_ subprojects] (u/load-monolith! project) dep-map (dep/dependency-map subprojects) resolved-names (map (partial dep/resolve-name! (keys dep-map)) project-names)] (doseq [dep-name resolved-names] (when-not (get dep-map dep-name) (lein/abort dep-name "is not a valid subproject!")) (when-not (:bare opts) (lein/info (str "\nSubprojects which " (when (:transitive opts) "transitively ") "depend on " (colorize [:bold :yellow] dep-name)))) (let [match-names (if (:transitive opts) (dep/downstream-keys dep-map dep-name) #{dep-name})] (doseq [subproject-name (dep/topological-sort dep-map)] (when-let [spec (->> (get-in subprojects [subproject-name :dependencies]) (filter (comp match-names dep/condense-name first)) (first))] (if (:bare opts) (println subproject-name (first spec) (second spec)) (println " " (colorize :bold subproject-name) "->" (colorize :bold spec))))))))) (defn deps-of "Print a list of subprojects which given package(s) depend on. Defaults to the current project if none are provided." [project opts project-names] (let [[_ subprojects] (u/load-monolith! project) dep-map (dep/dependency-map subprojects) resolved-names (map (partial dep/resolve-name! (keys dep-map)) project-names)] (doseq [project-name resolved-names] (when-not (get dep-map project-name) (lein/abort project-name "is not a valid subproject!")) (when-not (:bare opts) (lein/info "\nSubprojects which" (colorize [:bold :yellow] project-name) (if (:transitive opts) "transitively depends on" "depends on"))) (doseq [dep (if (:transitive opts) (-> (dep/upstream-keys dep-map project-name) (disj project-name) (->> (dep/topological-sort dep-map))) (filter #(contains? dep-map %) (dep-map project-name)))] (if (:bare opts) (println project-name dep) (println " " (colorize :bold project-name) "->" dep)))))) ================================================ FILE: src/lein_monolith/task/util.clj ================================================ (ns lein-monolith.task.util "Utility functions for task code." (:require [clojure.string :as str] [lein-monolith.config :as config] [leiningen.core.main :as lein])) (defn shell-escape "Escape the provided argument for use in a shell." [arg] (let [s (if (string? arg) arg (pr-str arg))] (if (or (str/includes? s " ") (str/includes? s "'") (str/includes? s "\"")) (str \' (str/escape s {\' "\\'"}) \') s))) (defn parse-kw-args "Given a sequence of string arguments, parse out expected keywords. Returns a vector with a map of keywords to values (or `true` for flags) followed by a sequence the remaining unparsed arguments." [expected args] (loop [opts {} args args] (if-not (and (first args) (.startsWith (str (first args)) ":")) ;; No more arguments to process, or not a keyword arg. [opts args] ;; Parse keyword option arg. (let [kw (keyword (subs (first args) 1)) multi-arg-count (get expected (keyword (str (name kw) \*))) arg-count (get expected kw multi-arg-count)] (cond ;; Unexpected option, halt parsing. (nil? arg-count) [opts args] ;; Flag option. (zero? arg-count) (recur (assoc opts kw true) (rest args)) ;; Single-valued option. (and (= 1 arg-count) (nil? multi-arg-count)) (recur (assoc opts kw (first (rest args))) (drop 2 args)) ;; Multi-spec option, join value list. multi-arg-count (recur (update opts kw (fnil into []) (take arg-count (rest args))) (drop (inc arg-count) args)) ;; Multi-arg (but not spec) option. :else (recur (assoc opts kw (vec (take arg-count (rest args)))) (drop (inc arg-count) args))))))) (defn parse-bool "Parse a boolean option with some slack for human-friendliness." [x] (case (str/lower-case (str x)) ("true" "t" "yes" "y") true ("false" "f" "no" "n") false (throw (IllegalArgumentException. (format "%s is not a valid boolean value" (pr-str x)))))) (defn globalize-opts "Takes a map of parsed options, and converts the `:upstream` and `:downstream` options into `:upstream-of ` and `:downstream-of `." [project opts] (if (and (:monolith project) (or (:upstream opts) (:downstream opts))) (do (lein/warn "The :upstream and :downstream options have no meaning in the monolith project.") opts) (cond-> opts (:upstream opts) (update :upstream-of conj (:name project)) (:downstream opts) (update :downstream-of conj (:name project))))) (defn stopwatch "Construct a timer which will contain the number of milliseconds elapsed between its creation and when it is dereferenced." [] (let [start (System/nanoTime)] (delay (/ (- (System/nanoTime) start) 1e6)))) (defn human-duration "Renders a duration in milliseconds in hour:minute:second.ms format." [duration] (if duration (let [hours (int (/ duration 1000.0 60 60)) minutes (- (int (/ duration 1000.0 60)) (* hours 60)) seconds (- (int (/ duration 1000.0)) (* minutes 60) (* hours 60 60)) milliseconds (int (rem duration 1000))] (if (pos? hours) (format "%d:%02d:%02d.%03d" hours minutes seconds milliseconds) (format "%d:%02d.%03d" minutes seconds milliseconds))) "--:--")) (defn load-monolith! "Helper function to make a common pattern more succinct." [project] (let [monolith (config/find-monolith! project) subprojects (config/read-subprojects! monolith)] [monolith subprojects])) ================================================ FILE: src/lein_monolith/task/with_dependency_set.clj ================================================ (ns lein-monolith.task.with-dependency-set (:require [lein-monolith.plugin :as plugin] [lein-monolith.task.util :as u] [leiningen.core.main :as lein])) (defn run-task "Runs the given task on the project with the given dependency set by reloading the project, changing the dependencies, re-initializing the project, and then running the task." [project dependency-set task] (let [[monolith _] (u/load-monolith! project) dependencies (or (get-in monolith [:monolith :dependency-sets dependency-set]) (lein/abort (format "Unknown dependency set %s" dependency-set))) managed-deps {:managed-dependencies (vary-meta dependencies assoc :replace true)} profile (merge managed-deps (when-not (:monolith project) {:monolith/dependency-set dependency-set})) project (plugin/add-active-profile project :monolith/dependency-override profile)] (lein/resolve-and-apply project task))) ================================================ FILE: src/leiningen/monolith.clj ================================================ (ns leiningen.monolith "Leiningen task implementations for working with monorepos." (:require [clojure.string :as str] [lein-monolith.dependency :as dep] [lein-monolith.plugin :as plugin] [lein-monolith.target :as target] [lein-monolith.task.checkouts :as checkouts] [lein-monolith.task.each :as each] [lein-monolith.task.fingerprint :as fingerprint] [lein-monolith.task.graph :as graph] [lein-monolith.task.info :as info] [lein-monolith.task.util :as u] [lein-monolith.task.with-dependency-set :as wds] [leiningen.core.main :as lein])) (defn- opts-only [expected args] (let [[opts more] (u/parse-kw-args expected args)] (when (seq more) (lein/abort "Unknown args:" (str/join " " more))) opts)) (defn- opts+projects [expected project args] (let [[opts more] (u/parse-kw-args expected args) project-names (or (seq (map read-string more)) [(dep/project-name project)])] [opts project-names])) ;; ## Subtask Vars (defn info "Show information about the monorepo configuration. Options: :bare Only print the project names and directories, one per line (targets) Standard target selection options are supported" [project args] (info/info project (opts-only (merge target/selection-opts {:bare 0}) args))) (defn lint "Check various aspects of the monolith and warn about possible problems. Options: :deps Check for conflicting dependency versions" [project args] (info/lint project (if (seq args) (opts-only {:deps 0} args) {:deps true}))) (defn deps "Print a list of subprojects and the (internal) projects they depend on. Targeting options may be used to scope down the projects listed. Options: :internal Whether to show dependencies on internal projects (default: true) :external Whether to show dependencies on external projects (default: false) :bare Only print the project names and dependencies, one per line (targets) Standard target selection options are supported" [project args] (let [opts (opts-only (assoc target/selection-opts :internal 1 :external 1 :bare 0) args)] (info/deps project opts))) (defn deps-on "Print a list of subprojects which depend on the given package(s). Defaults to the current project if none are provided. Options: :bare Only print the project names and dependent versions, one per line :transitive Include transitive dependents in addition to direct ones" [project args] (let [[opts project-names] (opts+projects {:bare 0, :transitive 0} project args)] (info/deps-on project opts project-names))) (defn deps-of "Print a list of subprojects which given package(s) depend on. Defaults to the current project if none are provided. Options: :bare Only print the project names and dependent versions, one per line :transitive Include transitive dependencies in addition to direct ones" [project args] (let [[opts project-names] (opts+projects {:bare 0, :transitive 0} project args)] (info/deps-of project opts project-names))) (defn graph "Generate a graph of subprojects and their interdependencies. Options: :image-path Path to save the graph image to (default: `project-hierarchy.png`) :dot-path Path to save the raw dot file to (default: not output) (targets) Standard target selection options are supported" [project args] (graph/graph project (opts-only (assoc target/selection-opts :image-path 1 :dot-path 1) args))) (defn ^:higher-order with-all "Apply the given task with a merged set of dependencies, sources, and tests from all the internal projects. For example: lein monolith with-all test" [project args] (when-not (:monolith project) (lein/warn "WARN: Running with-all in a subproject is not recommended! Beware of dependency ordering differences.")) (let [[opts [task & args]] (u/parse-kw-args target/selection-opts args) [monolith subprojects] (u/load-monolith! project) targets (target/select monolith subprojects opts) profile (plugin/merged-profile monolith (select-keys subprojects targets)) project (reduce-kv (fn remove-replace-meta [proj k _v] (update proj k vary-meta dissoc :replace)) project profile)] (lein/apply-task task (plugin/add-active-profile project :monolith/all profile) args))) (defn ^:higher-order each "Iterate over a target set of subprojects in the monolith and apply the given task. Projects are iterated in dependency order; that is, later projects may depend on earlier ones. By default, all projects are included in the set of iteration targets. If you provide the `:in`, `:upstream[-of]`, or `:downstream[-of]` options then the resulting set of projects will be composed only of the additive targets of each of the options specified. The `:skip` option can be used to exclude specific projects from the set. Specifying `:select` will use a configured `:project-selector` to filter the final set. If the iteration fails on a subproject, you can continue where you left off by providing the `:start` option as the first argument, giving the name of the project to resume from. General Options: :parallel Run tasks in parallel across a fixed thread pool. :endure Continue executing the task even if some subprojects fail. :report Print a detailed timing report after running tasks. :silent Don't print task output unless a subproject fails. :output Save each project's individual output in the given directory. Targeting Options: :in Add the named projects directly to the targets. :upstream Add the transitive dependencies of the current project to the targets. :upstream-of Add the transitive dependencies of the named projects to the targets. :downstream Add the transitive consumers of the current project to the targets. :downstream-of Add the transitive consumers of the named projects to the targets. :select Use a selector from the config to filter target projects. :skip Exclude one or more projects from the target set. :start Provide a starting point for the subproject iteration :refresh Only iterate over projects that have changed since the last `:refresh` of this marker :changed Like `:refresh` but does not reset the projects' state for the next run Each argument can contain multiple comma-separated project names, and all the targeting options except `:start` may be provided multiple times. Examples: lein monolith each check lein monolith each :upstream :parallel 4 install lein monolith each :select :deployable uberjar lein monolith each :report :start my/lib-a test lein monolith each :refresh ci/build install" [project args] (let [[opts task] (u/parse-kw-args each/task-opts args)] (when (empty? task) (lein/abort "Cannot run each without a task argument!")) (when (and (:start opts) (:parallel opts)) (lein/abort "The :parallel and :start options are not compatible!")) (each/run-tasks project opts task))) (defn link "Create symlinks in the checkouts directory pointing to all internal dependencies in the current project. Optionally, a set of project names may be specified to create links to only those projects (this implies `:deep`). Options: :force Override any existing checkout links with conflicting names :deep Link all subprojects this project transitively depends on" [project args] (when (:monolith project) (lein/abort "The 'link' task cannot be run for the monolith project!")) (let [[opts project-names] (opts+projects {:force 0, :deep 0} project args) target-names (remove #(= (dep/project-name project) %) project-names)] (checkouts/link project opts target-names))) (defn unlink "Remove internal checkout links from a project. Optionally, a set of project names may be specified to remove links only for those projects. Options: :all Remove all checkouts, not just internal ones." [project args] (when (:monolith project) (lein/abort "The 'unlink' task cannot be run for the monolith project!")) (let [[opts project-names] (opts+projects {:all 0} project args) target-names (remove #(= (dep/project-name project) %) project-names)] (checkouts/unlink project opts target-names))) ;; ## Fingerprinting (defn changed "Show information about the projects that have changed since last :refresh. Optionally takes one or more marker ids, or project selectors, to narrow the information. Usage: lein monolith changed [:debug] [project-selectors] [marker1 marker2 ...]" [project args] (let [[opts more] (u/parse-kw-args fingerprint/task-opts args) opts (u/globalize-opts project opts)] (fingerprint/changed project opts more))) (defn mark-fresh "Manually mark projects as refreshed. Fingerprints all projects, or a selected set of projects, and saves the results under the given marker id(s), for later use with the `:refresh` selector. Usage: lein monolith mark [project-selectors] marker1 marker2 ..." [project args] (let [[opts more] (u/parse-kw-args fingerprint/task-opts args) opts (u/globalize-opts project opts)] (fingerprint/mark-fresh project opts more))) (defn show-fingerprints "Show information about the calculation of one or more projects' fingerprints, compared to a current marker. Usage: lein monolith show-fingerprints marker project [...]" [project [marker & args]] (fingerprint/show project marker args)) (defn clear-fingerprints "Clear projects' cached fingerprints so they will be re-built next :refresh. Removes the fingerprints associated with one or more marker types on one or more projects. By default, clears all projects for all marker types. Usage: lein monolith clear [project-selectors] [marker1 marker2 ...]" [project args] (let [[opts more] (u/parse-kw-args fingerprint/task-opts args) opts (u/globalize-opts project opts)] (fingerprint/clear project opts more))) (defn ^:higher-order with-dependency-set "Run a task with a set of managed dependencies from a named dependency set. Overrides the dependencies from the named dependency set into the project. For the root project, this means the managed dependencies will be overwritten with the dependencies from the named set. For subprojects, the `:monolith/dependency-set` metadata key will be set to the named set. Usage: lein monolith with-dependency-set [...] lein monolith each [opts] monolith with-dependency-set [...]" [project args] (let [dependency-set (read-string (first args)) task (rest args)] (when (some #{"monolith"} task) (lein/abort (str "Running monolith with-dependency-set as a top-level task" " produces undefined behavior. It should be used as a subtask."))) (wds/run-task project dependency-set task))) ;; ## Plugin Entry (defn monolith "Tasks for working with Leiningen projects inside a monorepo." {:subtasks [#'info #'lint #'deps #'deps-on #'deps-of #'graph #'with-all #'each #'link #'unlink #'changed #'mark-fresh #'show-fingerprints #'clear-fingerprints #'with-dependency-set]} [project command & args] (case command "info" (info project args) "lint" (lint project args) "deps" (deps project args) "deps-on" (deps-on project args) "deps-of" (deps-of project args) "graph" (graph project args) "with-all" (with-all project args) "each" (each project args) "link" (link project args) "unlink" (unlink project args) "changed" (changed project args) "mark-fresh" (mark-fresh project args) "show-fingerprints" (show-fingerprints project args) "clear-fingerprints" (clear-fingerprints project args) "with-dependency-set" (with-dependency-set project args) (lein/abort (pr-str command) "is not a valid monolith command! Try: lein help monolith")) (flush)) ================================================ FILE: test/example-tests.sh ================================================ #!/bin/bash # Fail if any subcommand fails set -e REPO_ROOT="$(cd $(dirname "${BASH_SOURCE[0]}")/.. && pwd)" PLUGIN_VERSION="$(head -1 project.clj | cut -d ' ' -f 3)" echo "Installing lein-monolith $PLUGIN_VERSION from source..." cd $REPO_ROOT lein install EXAMPLE_DIR="${REPO_ROOT}/example" cd $EXAMPLE_DIR echo echo "Updating example project to use lein-monolith version $PLUGIN_VERSION..." sed -i'.bak' -e "s/lein-monolith \"[^\"]*\"/lein-monolith $PLUGIN_VERSION/" project.clj echo echo "Running tests against example projects in $EXAMPLE_DIR" test_monolith() { echo echo -e "\033[36mlein monolith $@\033[0m" lein monolith "$@" echo } test_monolith info test_monolith lint test_monolith deps test_monolith deps-of app-a test_monolith deps-on lib-a test_monolith deps-of lib-c test_monolith with-all pprint :dependencies :source-paths :test-paths test_monolith each pprint :version test_monolith each :in lib-a pprint :root :compile-path test_monolith each :upstream-of lib-b pprint :version test_monolith each :downstream-of lib-a pprint :name test_monolith each :parallel 3 :report :endure pprint :group test_monolith each :refresh foo install test_monolith each :refresh foo install test_monolith each :parallel 3 :refresh bar install test_monolith changed test_monolith clear-fingerprints :upstream-of lib-b test_monolith mark-fresh :upstream-of lib-b foo bar ================================================ FILE: test/lein_monolith/config_test.clj ================================================ (ns lein-monolith.config-test (:require [clojure.java.io :as io] [clojure.test :refer [deftest is testing]] [lein-monolith.config :as config] [lein-monolith.test-utils :refer [read-example-project]])) (deftest read-subprojects (testing "subproject clean targets use absolute paths" (let [monolith (read-example-project) subprojects (config/read-subprojects! monolith) test-project (get subprojects 'lein-monolith.example/lib-b) clean-targets (:clean-targets test-project)] (is (map? test-project) "lib-b subproject was loaded") (is (= {:protect false} (meta clean-targets)) "metadata is preserved") (is (= (set clean-targets) (set (filter #(.isAbsolute (io/file %)) clean-targets))) "All clean target paths are absolute")))) ================================================ FILE: test/lein_monolith/dependency_test.clj ================================================ (ns lein-monolith.dependency-test (:require [clojure.set :as set] [clojure.string :as str] [clojure.test :refer [deftest testing is are]] [lein-monolith.dependency :as dep]) (:import (clojure.lang IExceptionInfo))) (deftest coordinate-utilities (testing "condense-name" (is (nil? (dep/condense-name nil))) (is (= 'lein-monolith (dep/condense-name 'lein-monolith/lein-monolith))) (is (= 'example/foo (dep/condense-name 'example/foo)))) (testing "project-name" (is (nil? (dep/project-name nil))) (is (= 'foo (dep/project-name {:group "foo", :name "foo"}))) (is (= 'example/bar (dep/project-name {:group "example", :name "bar"})))) (testing "resolve-name" (let [projects '[foo baz/foo example/bar example/baz]] (is (nil? (dep/resolve-name projects 'qux))) (is (nil? (dep/resolve-name projects 'example/qux))) (is (= '[foo/baz bar/baz] (dep/resolve-name '[foo/baz bar/baz bar/qux] 'baz))) (is (= 'foo (dep/resolve-name projects 'foo))) (is (= 'foo (dep/resolve-name projects 'foo/foo))) (is (= 'example/bar (dep/resolve-name projects 'bar))) (is (= 'baz/foo (dep/resolve-name projects 'baz/foo))) (is (= 'example/baz (dep/resolve-name projects 'baz))))) (testing "clean-coord" (is (= '[example/foo "1.0"] (dep/clean-coord '[example/foo "1.0"]))) (is (= '[example/bar "0.5.0"] (dep/clean-coord '[example/bar "0.5.0" :exclusions [foo]]))) (is (= '[example/bar "0.5.0"] (dep/clean-coord '[example/bar "0.5.0" :exclusions [foo] :scope :test]))) (is (= '[example/baz "0.1.0-SNAPSHOT"] (dep/clean-coord '[example/baz "0.1.0-SNAPSHOT" :scope :test])))) (testing "source-metadata" (is (nil? (dep/dep-source [:foo "123"]))) (is (= [:foo "123"] (dep/with-source [:foo "123"] 'example/bar))) (is (= 'example/bar (dep/dep-source (dep/with-source [:foo "123"] 'example/bar)))))) (deftest dependency-mapping (let [projects '{foo/a {:dependencies []} foo/b {:dependencies [[foo/a "1.0.0"]]} foo/c {:dependencies [[foo/a "1.0.0"]]} foo/d {:dependencies [[foo/b "1.0.0"] [foo/c "1.0.0"]]}}] (is (= '{foo/a #{}, foo/b #{foo/a}, foo/c #{foo/a}, foo/d #{foo/b foo/c}} (dep/dependency-map projects)))) (let [projects '{foo/a {:dependencies []} foo/b {:dependencies [] :profiles {:test {:dependencies [[foo/a]]}}}}] (is (= `{foo/a #{}, foo/b #{foo/a}} (dep/dependency-map projects))))) (deftest upstream-dependency-closure (let [deps {:a #{}, :b #{:a}, :c #{:a :b} :x #{:b} :y #{:c}}] (is (= #{:a} (dep/upstream-keys deps :a))) (is (= #{:a :b} (dep/upstream-keys deps :b))) (is (= #{:a :b :c} (dep/upstream-keys deps :c))) (is (= #{:a :b :x} (dep/upstream-keys deps :x))) (is (= #{:a :b :c :y} (dep/upstream-keys deps :y))))) (deftest downstream-dependency-closure (let [deps {:a #{}, :b #{:a}, :c #{:a :b} :x #{:b} :y #{:c}}] (is (= #{:a :b :c :x :y} (dep/downstream-keys deps :a))) (is (= #{:b :c :x :y} (dep/downstream-keys deps :b))) (is (= #{:c :y} (dep/downstream-keys deps :c))) (is (= #{:x} (dep/downstream-keys deps :x))) (is (= #{:y} (dep/downstream-keys deps :y)))) (let [deps {:a #{}, :b #{:a}, :c #{:a}, :d #{:b :c}}] (is (= #{:a :b :c :d} (dep/downstream-keys deps :a))))) (defn maps-like [n m] (map #(into (array-map) (shuffle (seq %))) (repeat n m))) ;; Int -> [Deps SmallestCycles] (defn gen-dep-cycle "Create a dependency cycle of the specified size that also includes a cycle of length 3 (ie. between two deps). Returns a vector of the dependencies and a set of its smallest dependency cycles." [size] {:pre [(<= 5 size)]} ;; comments assume size == 50 (let [[cstart cend] ((juxt identity inc) (quot size 2))] [(into {} (map (fn [a] [a (condp = a (dec size) #{0} ; 0->1-*>49->0 cend #{cstart} ; 24->25->24 (into #{} (range (inc a) size)))])) (range size)) #{[cstart cend cstart] [cend cstart cend]}])) (defn cycle-actually-occurs [deps c] {:pre [(vector? c) (seq c) (map? deps) (= (first c) (peek c))]} (boolean (reduce (fn [downstream el] (or (some-> el downstream deps) (reduced nil))) (deps (first c)) (next c)))) (deftest cycle-actually-occurs-test (is (cycle-actually-occurs {1 #{2} 2 #{1}} [1 2 1])) (is (not (cycle-actually-occurs {1 #{2} 2 #{3} 3 #{}} [1 2 1])))) (deftest unique-cycles-test (is (= #{} (dep/unique-cycles {}))) (is (= #{[2 2]} (dep/unique-cycles {2 #{2}}))) (is (= #{} (dep/unique-cycles {1 #{2}}))) (doseq [size [5 10]] ; gen cycles of these sizes (higher is very slow) (let [[deps smallest-cycles] (gen-dep-cycle size)] (doseq [c (maps-like 10 deps)] ; shuffle deps order <..> times (let [actual (dep/unique-cycles c)] (every? #(is (cycle-actually-occurs deps %) (str "Cycle doesn't occur:\n" "deps: " deps \newline "claimed cycle: " %)) actual) (is (seq (set/intersection smallest-cycles actual)) (str "Missing smallest cycle(s) for size " size ": " (pr-str actual)))))))) (defn check-cycle-error [deps smlest-cycles] (doseq [deps (maps-like 10 deps)] (let [^Exception e (try (dep/topological-sort deps) (catch Exception e e))] (is (instance? IExceptionInfo e) (str "Didn't throw an exception\ndeps: " deps)) (is (re-find #"Dependency cycles? detected" (.getMessage e))) ;; pretty printed dependency cycle appears in msg (is (->> e ex-data :cycles (some smlest-cycles)) (str "Didn't include smallest cycle:\n" "deps: " deps "\n" "smallest-cycles: " smlest-cycles "\n" "actual cycles: " (->> e ex-data :cycles) "\n" "actual message: " (.getMessage e)))))) (deftest topological-sorting (let [deps {:a #{}, :b #{:a}, :c #{:a :b} :x #{:b} :y #{:c}}] (is (= [:a :b :c :x :y] (dep/topological-sort deps))) (is (= [:b :c :x] (dep/topological-sort deps [:x :c :b])))) (check-cycle-error {:a #{:b}, :b #{:c}, :c #{:a}} #{[:a :b :c :a] [:b :c :a :b] [:c :a :b :c]}) (doseq [size [5 10]] ; gen cycles of these sizes (higher is very slow) (let [[deps smallest-cycles] (gen-dep-cycle size)] (doseq [c (maps-like 5 deps)] ; shuffle deps order <..> times (check-cycle-error c smallest-cycles))))) (deftest pretty-cycle-test (are [c strs] (= (str/join \newline strs) (dep/pretty-cycle c)) [1 1] ["+ 1" "^\\" "|_|"] [1 2 1] ["+ 1" "^ + 2" "|_/"] [1 2 3 1] ["+ 1" "^ + 2" "| + 3" "|_/"] [1 2 3 4 1] ["+ 1" "^ + 2" "| + 3" "| + 4" "|__/"] [1 2 3 4 5 1] ["+ 1" "^ + 2" "| + 3" "| + 4" "| + 5" "|___/"])) ================================================ FILE: test/lein_monolith/monolith_test.clj ================================================ (ns lein-monolith.monolith-test (:require [clojure.java.io :as io] [clojure.test :refer [deftest is]] [lein-monolith.test-utils :refer [use-example-project read-example-project]] [leiningen.monolith :as monolith])) (use-example-project) (defn- absolute-path "Return an absolute java.nio.file.Path for the given file-ish input." [x] (.. (io/as-file x) toPath toAbsolutePath)) (defn- read-pprint-output "Runs lein pprint with the given key path using the :monolith/all profile." [& ks] (->> (map str ks) (apply vector "pprint") (monolith/with-all (read-example-project)) with-out-str read-string)) (defn- relativize-path "Convert absolute paths to paths relative to the example project." [path] (str (.relativize (absolute-path "example") (absolute-path path)))) (defn- relativize-pprint-output "Read pprint output and convert absolute paths to paths relative to the example project." [& ks] (->> ks (apply read-pprint-output) (map relativize-path))) (deftest with-all-test (is (= ["apps/app-a/resources" "dev-resources" "libs/lib-a/resources" "libs/lib-b/resources" "libs/lib-d/resources" "libs/subdir/lib-c/resources" "resources"] (relativize-pprint-output :resource-paths))) (is (= ["apps/app-a/src" "libs/lib-a/src" "libs/lib-b/src" "libs/lib-d/src" "libs/subdir/lib-c/src" "src"] (relativize-pprint-output :source-paths))) (is (= ["apps/app-a/test/integration" "apps/app-a/test/unit" "libs/lib-a/test/integration" "libs/lib-a/test/unit" "libs/lib-b/test/integration" "libs/lib-b/test/unit" "libs/lib-d/test/integration" "libs/lib-d/test/unit" "libs/subdir/lib-c/test/integration" "libs/subdir/lib-c/test/unit" "test/integration" "test/unit"] (relativize-pprint-output :test-paths)))) ================================================ FILE: test/lein_monolith/plugin_test.clj ================================================ (ns lein-monolith.plugin-test (:require [clojure.test :refer [deftest is]] [lein-monolith.config :as config] [lein-monolith.plugin :as plugin] [lein-monolith.test-utils :refer [use-example-project read-example-project]] [leiningen.core.project :as project])) (use-example-project) (deftest build-inherited-profiles-test (let [monolith (config/find-monolith! (read-example-project)) subproject (project/read "example/apps/app-a/project.clj") profiles (into {} (plugin/build-inherited-profiles monolith subproject))] (is (= #{:monolith/inherited :monolith/inherited-raw :monolith/leaky :monolith/leaky-raw} (set (keys profiles)))) (is (= {:test-paths ["test/unit" "test/integration"]} (:monolith/inherited-raw profiles))) (is (= {:repositories [["central" {:url "https://repo1.maven.org/maven2/" :snapshots false}] ["clojars" {:url "https://repo.clojars.org/"}]] :managed-dependencies [['amperity/greenlight "0.6.0"] ['com.amperity/vault-clj "2.1.583"]]} (:monolith/leaky profiles))) (is (= {:compile-path "%s/compiled"} (:monolith/leaky-raw profiles))))) (deftest build-dependency-set-profile-test (let [monolith (config/find-monolith! (read-example-project)) subproject (project/read "example/apps/app-a/project.clj") profile (into {} (plugin/build-dependency-profiles monolith subproject))] (is (= :set-a (:monolith/dependency-set subproject))) (is (= [['amperity/greenlight "0.7.1"] ['org.clojure/spec.alpha "0.3.218"]] (get-in monolith [:monolith :dependency-sets :set-a]))) (is (= [['amperity/greenlight "0.7.1"] ['org.clojure/spec.alpha "0.3.218"]] (get-in profile [:monolith/dependency-set :managed-dependencies]))))) (deftest managed-dependencies-order (let [monolith (config/find-monolith! (read-example-project)) subproject (-> (project/read "example/apps/app-a/project.clj") (plugin/middleware monolith))] (is (= [['amperity/greenlight "0.7.1"] ['org.clojure/spec.alpha "0.3.218"]] (:managed-dependencies subproject))))) ================================================ FILE: test/lein_monolith/task/each_test.clj ================================================ (ns lein-monolith.task.each-test (:require [clojure.java.io :as io] [clojure.string :as str] [clojure.test :refer [deftest is testing]] [lein-monolith.config :as config] [lein-monolith.task.each :as each] [lein-monolith.test-utils :refer [read-example-project]])) (defn- test-path "Returns the path where the test file should exist for the given target path." [subproject target] (if (= :target-path target) (str (:root subproject) "/target/test.txt") (str target "/test.txt"))) (deftest clean-subprojects (testing "Verify that the clean targets for each subproject are cleaned up by `lein monolith each clean`." (let [monolith (read-example-project) subprojects (config/read-subprojects! monolith)] (doseq [[_subproject-name subproject] subprojects target (:clean-targets subproject)] (let [path (test-path subproject target)] (is (str/starts-with? path (:root subproject)) "The test file path should be created within the subproject directory.") (io/make-parents path) (spit path "test") (is (.exists (io/file path)) "The test file should have been created."))) (each/run-tasks monolith {} ["clean"]) ; lein monolith each clean (doseq [[_subproject-name subproject] subprojects target (:clean-targets subproject)] (let [path (test-path subproject target) test-file (io/file path) parent-dir (io/file (.getParent test-file))] (is (not (.exists test-file)) "The test file should not exist after a lein clean") (is (not (.exists parent-dir)) "The target directory should not exist after a lein clean")))))) ================================================ FILE: test/lein_monolith/task/util_test.clj ================================================ (ns lein-monolith.task.util-test (:require [clojure.test :refer [deftest testing is]] [lein-monolith.task.util :as u])) (deftest shell-escaping (is (= "nil" (u/shell-escape nil))) (is (= "123" (u/shell-escape 123))) (is (= "foo" (u/shell-escape "foo"))) (is (= ":abc" (u/shell-escape :abc))) (is (= "'[123 true]'" (u/shell-escape [123 true]))) (is (= "'\\'foo'" (u/shell-escape "'foo"))) (is (= "'\"xyz\"'" (u/shell-escape "\"xyz\"")))) (deftest kw-arg-parsing (testing "empty arguments" (is (= [{} []] (u/parse-kw-args {} []))) (is (= [{} []] (u/parse-kw-args {:foo 0} [])))) (testing "flag options" (is (= [{:foo true} []] (u/parse-kw-args {:foo 0} [":foo"]))) (is (= [{:foo true} ["bar"]] (u/parse-kw-args {:foo 0} [":foo" "bar"])))) (testing "single-value options" (is (= [{:abc "xyz"} ["123"]] (u/parse-kw-args {:abc 1} [":abc" "xyz" "123"]))) (is (= [{} ["%" ":abc" "123"]] (u/parse-kw-args {:abc 1} ["%" ":abc" "123"])))) (testing "multi-arg options" (is (= [{:tri-arg ["1" "2" "3"]} ["abc"]] (u/parse-kw-args {:tri-arg 3} [":tri-arg" "1" "2" "3" "abc"]))) (is (= [{:missing ["abc"]} []] (u/parse-kw-args {:missing 2} [":missing" "abc"]))) (is (= [{:foo ["x" "y"]} ["bar"]] (u/parse-kw-args {:foo 2} [":foo" "a" "b" ":foo" "x" "y" "bar"])) "should overwrite prior option")) (testing "multi-value options" (is (= [{:foo ["a"]} []] (u/parse-kw-args {:foo* 1} [":foo" "a"]))) (is (= [{:foo ["a" "b"], :bar true} []] (u/parse-kw-args {:foo* 1, :bar 0} [":foo" "a" ":bar" ":foo" "b"])))) (testing "combo args" (is (= [{:foo "1", :bar true} ["xyz"]] (u/parse-kw-args {:foo 1, :bar 0} [":foo" "1" ":bar" "xyz"]))) (is (= [{:foo "x"} [":bar" "123" ":foo" "y"]] (u/parse-kw-args {:foo 1} [":foo" "x" ":bar" "123" ":foo" "y"])) "unknown arg should halt parsing"))) ================================================ FILE: test/lein_monolith/task/with_dependency_set_test.clj ================================================ (ns lein-monolith.task.with-dependency-set-test (:require [clojure.test :refer [deftest testing is]] [lein-monolith.task.with-dependency-set :as wds] [lein-monolith.test-utils :refer [use-example-project]] [leiningen.core.main :as lein] [leiningen.core.project :as project] [leiningen.monolith :as monolith])) (use-example-project) (deftest run-task-test (with-redefs [lein/resolve-and-apply (fn [project & _] project)] (testing "Root Project" (let [project (project/read "example/project.clj") deps [['amperity/greenlight "0.7.1"] ['org.clojure/spec.alpha "0.3.218"]] actual (wds/run-task project :set-a nil)] (is (= deps (:managed-dependencies actual))) (is (= deps (get-in actual [:profiles :monolith/dependency-override :managed-dependencies]))))) (testing "Subproject" (let [project (project/read "example/apps/app-a/project.clj") replaced-deps [['amperity/greenlight "0.7.0"] ['org.clojure/spec.alpha "0.2.194"]] actual (wds/run-task project :set-outdated nil)] (is (= replaced-deps (:managed-dependencies actual))) (is (= replaced-deps (get-in actual [:profiles :monolith/dependency-override :managed-dependencies]))) (is (= :set-outdated (:monolith/dependency-set actual))))) (testing "Unknown dependency set" (let [project (project/read "example/project.clj")] (is (thrown? Exception (wds/run-task project :unknown nil))))))) (deftest monolith-task-test (testing "Parent subtask throws" (let [project (project/read "example/project.clj")] (is (thrown? Exception (monolith/monolith project "with-dependency-set" [":foo" "monolith" "each" "clean"])))))) ================================================ FILE: test/lein_monolith/test_utils.clj ================================================ (ns lein-monolith.test-utils (:require [clojure.test :refer [use-fixtures]] [lein-monolith.task.each :as each] [lein-monolith.task.util :as u] [leiningen.core.main :as lein] [leiningen.core.project :as project] [leiningen.deps :as deps] [leiningen.install :as install]) (:import (java.io StringWriter))) (defn read-example-project "Read in the example monolith project." [] (project/read "example/project.clj")) (defn prepare-example-project "Prepare the example project by installing the source version of lein-monolith, fetching the example project's dependencies, and installing all of the example project's subprojects." [] (let [out (StringWriter.)] (try (binding [lein/*exit-process?* false *out* out *err* out] (install/install (project/read "project.clj")) (let [[monolith subprojects] (u/load-monolith! (read-example-project))] (deps/deps monolith) (doseq [[_project-name project] subprojects] (each/run-tasks project {} ["install"])))) (catch Exception e (.println *err* (str out)) (throw e))))) (defn use-example-project "Adds a fixture that ensures that the example project is completely set up so monolith tasks can be run against it for testing." [] (use-fixtures :once (fn [f] (prepare-example-project) (f))))