mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 02:59:54 +00:00
Code Issues 1 Releases Wiki Activity

Add first versions of bundle/* module

Browse Source 
The bundle module contains tools for modifying the contents of
(dyn *syspath*) and providing a common interface for installing
packages (called "bundles").

The functions are:

* bundle/install
* bundle/uninstall
* bundle/manifest
* bundle/do-hook
* bundle/list
* bundle/add-file
* bundle/add-directory

A bundle is a directory that contains any number of source files and
other extra files, as well as a directory "hooks/", which contains a
flat listing of janet scripts. This version of the bundle module is not
responsible for building C source modules or for downloading files over
the network.
This commit is contained in:
Calvin Rose 2024-05-12 14:42:05 -05:00
parent 60e22d9703
commit 9c437796d3
1 changed files with 153 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

147
src/boot/boot.janet
View File

@ -2958,7 +2958,7 @@
:core/stream path
(file/open path :rb)))
(def path-is-file (= f path))
(default env (make-env))
(default env (make-env (curenv)))
(def spath (string path))
(put env :source (or source (if-not path-is-file spath path)))
(var exit-error nil)
@ -3959,6 +3959,151 @@
(merge-into module/cache old-modcache)
nil)
###
###
### Bundle tools
###
###
(compwhen (dyn 'os/stat)
(defdyn *bundle-manifest* "Current manifest table of an installed package. Bound when executing hooks.")
(defn- get-manifest-filename
[&opt bundle-name]
(string (dyn *syspath*) "/.manifests/" bundle-name (when bundle-name ".jdn")))
(defn- get-hook-filename
[&opt bundle-name hook]
(string (dyn *syspath*) "/.hooks/" bundle-name (when bundle-name (string "/" hook))))
(defn- prime-bundle-paths
[]
(def mf (get-manifest-filename))
(def hf (get-hook-filename))
(os/mkdir mf)
(os/mkdir hf)
nil)
(defn- copy-hooks
[hooks-src bundle-name]
(os/mkdir (get-hook-filename bundle-name))
(when (os/stat hooks-src :mode)
(each hook (os/dir hooks-src)
(def hookpath (string hooks-src "/" hook))
(def source (slurp hookpath))
(spit (get-hook-filename bundle-name hook) source))))
(defn- get-files []
(def manifest (dyn *bundle-manifest*))
(assert manifest "nothing bound to (dyn *bundle-manifest*)")
(def files (get manifest :files @[]))
(put manifest :files files)
files)
(defn bundle/manifest
"Get the manifest for a give installed bundle"
[bundle-name]
(def name (get-manifest-filename bundle-name))
(assert (fexists name) (string "no bundle " bundle-name " found"))
(parse (slurp name)))
(defn bundle/do-hook
"Run a given hook for an installed bundle"
[bundle-name hook]
(bundle/manifest bundle-name) # assert good bundle-name
(def filename (get-hook-filename bundle-name hook))
(when (os/stat filename :mode)
(def dir (os/cwd))
(def real-syspath (os/realpath (dyn *syspath*))) # if syspath is a relative path
(def env (make-env))
(def manifest-name (get-manifest-filename bundle-name))
(def manifest (bundle/manifest bundle-name))
(def srcdir (get manifest :local-source))
(def filename-real (os/realpath filename))
(put env *bundle-manifest* manifest)
(merge-into env manifest)
(put env *syspath* real-syspath)
# After install, srcdir does not always exist
(when (os/stat srcdir :mode) (os/cd srcdir))
(defer (os/cd dir)
(print "running " filename-real " for bundle " bundle-name)
(dofile filename-real :env env)
(spit manifest-name (string/format "%j\n" manifest)))))
(defn bundle/uninstall
"Remove a bundle from the current syspath"
[bundle-name]
(bundle/do-hook bundle-name "uninstall.janet")
(def man (bundle/manifest bundle-name))
(def files (get man :files []))
(each file (reverse files)
(print "removing " file)
(case (os/stat file :mode)
:file (os/rm file)
:directory (os/rmdir file)))
(os/rm (get-manifest-filename bundle-name))
(def hf (get-hook-filename bundle-name))
(each hook (os/dir hf)
(os/rm (string hf "/" hook)))
(os/rmdir hf)
nil)
(defn bundle/install
"Install a bundle from the local filesystem with a name `bundle-name`."
[path &opt bundle-name &keys config]
(default bundle-name (last (string/split "/" path)))
(assert (next bundle-name) "cannot use empty bundle-name")
(assert (not (fexists (get-manifest-filename bundle-name)))
"bundle is already installed")
(prime-bundle-paths)
(def src-hooks (string path "/hooks/"))
(copy-hooks src-hooks bundle-name)
(def man @{:bundle-name bundle-name :local-source path})
(when config (merge-into man config))
(spit (get-manifest-filename bundle-name) (string/format "%j\n" man))
(edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
(bundle/do-hook bundle-name "deps.janet")
(bundle/do-hook bundle-name "build.janet")
(bundle/do-hook bundle-name "install.janet"))
nil)
(defn bundle/add-directory
"Add a directory during the install process relative to `(dyn *syspath*)`"
[dest &opt chmod-mode]
(def files (get-files))
(def absdest (string (dyn *syspath*) "/" dest))
(unless (os/mkdir absdest)
(errorf "collision at %s, directory already exists" absdest))
(when chmod-mode
(os/chmod absdest chmod-mode))
(array/push files absdest)
(print "adding " absdest)
absdest)
(defn bundle/add-file
"Add files during an install relative to `(dyn *syspath*)`"
[src &opt dest chmod-mode]
(default dest src)
(def files (get-files))
(def absdest (string (dyn *syspath*) "/" dest))
(when (os/stat absdest :mode)
(errorf "collision at %s, file already exists" absdest))
(spit absdest (slurp src))
(when chmod-mode
(os/chmod dest chmod-mode))
(array/push files absdest)
(print "adding " absdest)
absdest)
(defn bundle/list
"Get a list of all installed bundles in lexical order."
[]
(def d (get-manifest-filename))
(if (os/stat d :mode)
(sort (seq [x :in (os/dir (get-manifest-filename))]
(string/slice x 0 -5)))
@[])))
###
###