diff --git a/CHANGELOG.md b/CHANGELOG.md index 16d309d..2230c68 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,13 @@ This project adheres to [Semantic Versioning](http://semver.org/). [#27](https://github.com/amperity/lein-monolith/issues/27) [#72](https://github.com/amperity/lein-monolith/pull/72) +### Changed +- 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) + ## [1.5.0] - 2020-09-17 diff --git a/README.md b/README.md index 586ef72..0ac26ec 100644 --- a/README.md +++ b/README.md @@ -167,13 +167,14 @@ override them, you can pass the `:force` option. ``` lein monolith link [:deep :force] [project...] -lein monolith unlink +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 diff --git a/src/lein_monolith/task/checkouts.clj b/src/lein_monolith/task/checkouts.clj index 60aea97..336acd1 100644 --- a/src/lein_monolith/task/checkouts.clj +++ b/src/lein_monolith/task/checkouts.clj @@ -9,7 +9,8 @@ java.io.File (java.nio.file Files - LinkOption))) + LinkOption + Path))) (defn- create-symlink! @@ -20,6 +21,18 @@ (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?] @@ -31,23 +44,23 @@ 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. + ;; 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/info "Link for" dep-name "is correct") - ; Link exists but points somewhere else. + ;; 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. + ;; 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. + ;; 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. + ;; Link does not exist, so create it. (do (lein/info "Linking" dep-name "to" (str target-path)) (create-symlink! link-path target-path))))) @@ -77,22 +90,42 @@ (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. + ;; Create checkouts directory if needed. (when-not (.exists checkouts-dir) - (lein/info "Creating checkout directory" (str checkouts-dir)) + (lein/debug "Creating checkout directory" (str checkouts-dir)) (.mkdir checkouts-dir)) - ; Check each dependency for internal projects. + ;; 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] + [project opts project-names] (when-let [checkouts-dir (some-> (:root project) (io/file "checkouts"))] (when (.exists checkouts-dir) - (lein/info "Removing checkout directory" (str checkouts-dir)) - (doseq [link (.listFiles checkouts-dir)] - (lein/debug "Removing checkout link" (str link)) - (.delete ^File link)) - (.delete 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))))) diff --git a/src/leiningen/monolith.clj b/src/leiningen/monolith.clj index 26dd1db..3ed8a22 100644 --- a/src/leiningen/monolith.clj +++ b/src/leiningen/monolith.clj @@ -192,18 +192,27 @@ :deep Link all subprojects this project transitively depends on" [project args] (when (:monolith project) - (lein/abort "The 'link' task does not need to be run for the 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) - subproject-names (remove #(= (dep/project-name project) %) - project-names)] - (checkouts/link project opts - subproject-names))) + target-names (remove #(= (dep/project-name project) %) + project-names)] + (checkouts/link project opts target-names))) (defn unlink - "Remove the checkouts directory from a project." - [project] - (checkouts/unlink project)) + "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 @@ -269,7 +278,7 @@ "with-all" (with-all project args) "each" (each project args) "link" (link project args) - "unlink" (unlink project) + "unlink" (unlink project args) "changed" (changed project args) "mark-fresh" (mark-fresh project args) "clear-fingerprints" (clear-fingerprints project args)