From 7387a1d91e709e2ce935674742b2bc6b8ec969d7 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 May 2024 10:48:26 -0500 Subject: [PATCH] Add `bundle/prune` and support for :auto-remove. This allows dependencies to be marked such that they are not primary dependencies installed by the users - rather, they are dependencies of dependencies. This distinction is important when a user installs a package that itself has dependencies. This also interacts with new features to prevent a user from breaking their installation by installing needed packages or installing/uninstalling bundles out of order. --- examples/sample-bundle/bundle/info.jdn | 3 + examples/sample-bundle/bundle/init.janet | 3 + examples/sample-bundle/mymod.janet | 3 + src/boot/boot.janet | 87 +++++++++++++++++++++--- 4 files changed, 85 insertions(+), 11 deletions(-) create mode 100644 examples/sample-bundle/bundle/info.jdn create mode 100644 examples/sample-bundle/bundle/init.janet create mode 100644 examples/sample-bundle/mymod.janet diff --git a/examples/sample-bundle/bundle/info.jdn b/examples/sample-bundle/bundle/info.jdn new file mode 100644 index 00000000..54875852 --- /dev/null +++ b/examples/sample-bundle/bundle/info.jdn @@ -0,0 +1,3 @@ +@{ + :dependencies ["spork"] +} diff --git a/examples/sample-bundle/bundle/init.janet b/examples/sample-bundle/bundle/init.janet new file mode 100644 index 00000000..10aa476d --- /dev/null +++ b/examples/sample-bundle/bundle/init.janet @@ -0,0 +1,3 @@ +(defn install + [manifest &] + (bundle/add-file manifest "mymod.janet")) diff --git a/examples/sample-bundle/mymod.janet b/examples/sample-bundle/mymod.janet new file mode 100644 index 00000000..088ab194 --- /dev/null +++ b/examples/sample-bundle/mymod.janet @@ -0,0 +1,3 @@ +(defn myfn + [x] + (+ x x)) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index f36b3f41..8e102685 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -4094,8 +4094,15 @@ (print "running hook " hook " for bundle " bundle-name) (hookf ;args))) - (defn bundle/uninstall - "Remove a bundle from the current syspath" + (defn bundle/list + "Get a list of all installed bundles in lexical order." + [] + (def d (bundle-dir)) + (if (os/stat d :mode) + (sort (os/dir d)) + @[])) + + (defn- bundle-uninstall-unchecked [bundle-name] (def man (bundle/manifest bundle-name)) (def all-hooks (get man :hooks @[])) @@ -4111,6 +4118,61 @@ (rmrf (bundle-dir bundle-name)) nil) + (defn bundle/uninstall + "Remove a bundle from the current syspath" + [bundle-name] + (def breakage @{}) + (each b (bundle/list) + (unless (= b bundle-name) + (def m (bundle/manifest b)) + (def deps (get m :dependencies [])) + (each d deps + (if (= d bundle-name) (put breakage b true))))) + (when (next breakage) + (def breakage-list (sorted (keys breakage))) + (errorf "cannot uninstall %s, breaks dependent bundles %n" bundle-name breakage-list)) + (bundle-uninstall-unchecked bundle-name)) + + (defn bundle/topolist + "Get topological order of all bundles, such that each bundle is listed after its dependencies. + DFS (tarjan)" + [] + (def visited @{}) + (def cycle-detect @{}) + (def order @[]) + (defn visit + [b] + (if (get visited b) (break)) + (if (get cycle-detect b) (errorf "cycle detected in bundle dependencies: %s" b)) + (put cycle-detect b true) + (each d (get (bundle/manifest b) :dependencies []) (visit d)) + (put cycle-detect b nil) + (put visited b true) + (array/push order b)) + (each b (bundle/list) (visit b)) + order) + + (defn bundle/prune + "Remove all orphaned bundles from the syspath. An orphaned bundle is a bundle that is + marked for :auto-remove and is not depended on by any other bundle." + [] + (def topo (bundle/topolist)) + (def rtopo (reverse topo)) + # Check which auto-remove packages can be dropped + # Iterate in (reverse) topological order, and if we see an auto-remove package and have not already seen + # something that depends on it, then it is a root package and can be pruned. + (def exempt @{}) + (def to-drop @[]) + (each b rtopo + (def m (bundle/manifest b)) + (if (or (get exempt b) (not (get m :auto-remove))) + (do + (put exempt b true) + (each d (get m :dependencies []) (put exempt d true))) + (array/push to-drop b))) + (print "pruning " (length to-drop) " bundles") + (each b to-drop (bundle-uninstall-unchecked b))) + (defn bundle/installed? "Check if a bundle is installed." [bundle-name] @@ -4127,6 +4189,14 @@ (assert (next bundle-name) "cannot use empty bundle-name") (assert (not (fexists (get-manifest-filename bundle-name))) "bundle is already installed") + # Check meta file for dependencies + (def infofile-pre (string path "/bundle/info.jdn")) + (when (os/stat infofile-pre :mode) + (def info (-> infofile-pre slurp parse)) + (def deps (get info :deps @[])) + (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d))) + (when (next missing) (errorf "missing dependencies %s" (string/join missing ", ")))) + # Setup installed paths (prime-bundle-paths) (os/mkdir (bundle-dir bundle-name)) # Copy some files into the new location unconditionally @@ -4136,6 +4206,7 @@ (def man @{:bundle-name bundle-name :local-source path :files @[]}) (merge-into man config) (def infofile (bundle-file bundle-name "info.jdn")) + (put man :auto-remove (get config :auto-remove)) (sync-manifest man) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) (when (os/stat infofile :mode) @@ -4144,10 +4215,12 @@ (def missing (filter (complement bundle/installed?) deps)) (when (next missing) (error (string "missing dependencies " (string/join missing ", ")))) + (put man :dependencies deps) (put man :info info)) (def module (get-bundle-module bundle-name)) (def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k))) (put man :hooks all-hooks) + (do-hook module bundle-name :dependencies man) (when clean (do-hook module bundle-name :clean man)) (do-hook module bundle-name :build man) @@ -4204,7 +4277,7 @@ (bundle/install backup-bundle-source bundle-name) (copyrf (string backup-bundle-source "/old-bundle") (bundle-dir bundle-name)) (rmrf backup-bundle-source)) - (bundle/uninstall bundle-name) + (bundle-uninstall-unchecked bundle-name) (bundle/install path bundle-name ;(kvs config) ;(kvs new-config))) (rmrf backup-bundle-source) bundle-name) @@ -4237,14 +4310,6 @@ (print "+ " absdest) absdest) - (defn bundle/list - "Get a list of all installed bundles in lexical order." - [] - (def d (bundle-dir)) - (if (os/stat d :mode) - (sort (os/dir d)) - @[])) - (defn bundle/update-all "Reinstall all bundles" []