1
0
mirror of https://github.com/janet-lang/janet synced 2024-07-05 19:43:14 +00:00

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.
This commit is contained in:
Calvin Rose 2024-05-25 10:48:26 -05:00
parent ae4b8078df
commit 7387a1d91e
4 changed files with 85 additions and 11 deletions

View File

@ -0,0 +1,3 @@
@{
:dependencies ["spork"]
}

View File

@ -0,0 +1,3 @@
(defn install
[manifest &]
(bundle/add-file manifest "mymod.janet"))

View File

@ -0,0 +1,3 @@
(defn myfn
[x]
(+ x x))

View File

@ -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"
[]