diff --git a/doc/guide/env-vars.md b/doc/guide/env-vars.md index 3d183c601..128143433 100644 --- a/doc/guide/env-vars.md +++ b/doc/guide/env-vars.md @@ -59,3 +59,10 @@ You can wholly disable parallelism by exporting `GERBIL_BUILD_CORES=0`, at which point the Gerbil part of compilation will be done in the current process. By contrast, `GERBIL_BUILD_CORES=1` enforces use of subprocesses for Gerbil compilation, even though only one process will be run at once. + +## GERBIL_PKG_GIT_USER + +If this variable is set, `gxpkg` will clone packages using `git` over +ssh instead of https. + +Set this if you want to access private repose. diff --git a/doc/guide/getting-started.md b/doc/guide/getting-started.md index a4d87ee8c..56d4ca13f 100644 --- a/doc/guide/getting-started.md +++ b/doc/guide/getting-started.md @@ -34,7 +34,7 @@ I usually configure Gerbil for devlopment with the following incantation: This will install Gerbil in `/usr/local/gerbil`; you should add `/usr/local/gerbil/bin` to your path. -Note that this configuration enables share libraries: all gerbil +Note that this configuration enables shared libraries: all gerbil programs will use shared libraries for `libgambit` and `libgerbil` linkage, resulting in significantly smaller executables. @@ -126,21 +126,21 @@ $ gerbil new -n hello $ ls -latR .: -total 24 -drwxrwxr-x 3 vyzo vyzo 4096 Sep 15 09:54 . --rwxr-xr-x 1 vyzo vyzo 138 Sep 15 09:54 build.ss --rw-rw-r-- 1 vyzo vyzo 16 Sep 15 09:54 gerbil.pkg --rw-rw-r-- 1 vyzo vyzo 14 Sep 15 09:54 .gitignore -drwxrwxr-x 2 vyzo vyzo 4096 Sep 15 09:54 hello --rw-rw-r-- 1 vyzo vyzo 555 Sep 15 09:54 Makefile -drwxrwxr-x 3 vyzo vyzo 4096 Sep 15 09:54 .. +total 28 +drwxrwxr-x 3 vyzo vyzo 4096 Sep 24 09:52 . +-rwxr-xr-x 1 vyzo vyzo 138 Sep 24 09:52 build.ss +-rw-rw-r-- 1 vyzo vyzo 16 Sep 24 09:52 gerbil.pkg +-rw-rw-r-- 1 vyzo vyzo 27 Sep 24 09:52 .gitignore +drwxrwxr-x 2 vyzo vyzo 4096 Sep 24 09:52 hello +-rw-rw-r-- 1 vyzo vyzo 593 Sep 24 09:52 Makefile +drwxrwxr-x 8 vyzo vyzo 4096 Sep 24 09:52 .. ./hello: total 16 -drwxrwxr-x 2 vyzo vyzo 4096 Sep 15 09:54 . -drwxrwxr-x 3 vyzo vyzo 4096 Sep 15 09:54 .. --rw-rw-r-- 1 vyzo vyzo 90 Sep 15 09:54 lib.ss --rw-rw-r-- 1 vyzo vyzo 617 Sep 15 09:54 main.ss +drwxrwxr-x 2 vyzo vyzo 4096 Sep 24 09:52 . +drwxrwxr-x 3 vyzo vyzo 4096 Sep 24 09:52 .. +-rw-rw-r-- 1 vyzo vyzo 109 Sep 24 09:52 lib.ss +-rw-rw-r-- 1 vyzo vyzo 777 Sep 24 09:52 main.ss $ cat gerbil.pkg (package: vyzo) @@ -184,6 +184,10 @@ $ cat hello/main.ss ./lib) (export main) +;; build manifest; generated during the build +;; defines version-manifest which you can use for exact versioning +(include "../manifest.ss") + (def (main . args) (call-with-getopt hello-main args program: "hello" @@ -224,22 +228,24 @@ $ gerbil build ... build in current directory ... compile hello/lib ... compile hello/main -... compile exe hello/main -> ~/.gerbil/bin/hello -/tmp/gxc.1694761212.5571132/vyzo__hello__main.scm: -/home/vyzo/.gerbil/bin/hello.scmx: -/tmp/gxc.1694761212.5571132/vyzo__hello__main.c: -/home/vyzo/.gerbil/bin/hello.c: -/home/vyzo/.gerbil/bin/hello_.c: - +... compile exe hello/main -> /home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello +/tmp/gxc.1695538439.3642368/vyzo__hello__main.scm: +/home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello.scmx: +/tmp/gxc.1695538439.3642368/vyzo__hello__main.c: +/home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello.c: +/home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello_.c: ``` -And we have an executable, which is placed by default in `~/.gerbil/bin`. +And we have an executable, which is placed by default in `.gerbil/bin`. You can change this by exporting the `GERBIL_PATH` variable. Of course our executable doesn't do anything right now, as we haven't filled any code: ```shell -$ hello -*** ERROR -- Implement me! +$ ./.gerbil/bin/hello +*** ERROR -- +*** ERROR IN ? [Error]: Implement me! +--- continuation backtrace: +0 error ``` ## Write Some Code @@ -296,16 +302,16 @@ $ gerbil build ... build in current directory ... compile hello/lib ... compile hello/main -... compile exe hello/main -> ~/.gerbil/bin/hello -/tmp/gxc.1694761770.3361619/vyzo__hello__lib.scm: -/tmp/gxc.1694761770.3361619/vyzo__hello__main.scm: -/home/vyzo/.gerbil/bin/hello.scmx: -/tmp/gxc.1694761770.3361619/vyzo__hello__lib.c: -/tmp/gxc.1694761770.3361619/vyzo__hello__main.c: -/home/vyzo/.gerbil/bin/hello.c: -/home/vyzo/.gerbil/bin/hello_.c: - -$ hello world +... compile exe hello/main -> /home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello +/tmp/gxc.1695538539.046348/vyzo__hello__lib.scm: +/tmp/gxc.1695538539.046348/vyzo__hello__main.scm: +/home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello.scmx: +/tmp/gxc.1695538539.046348/vyzo__hello__lib.c: +/tmp/gxc.1695538539.046348/vyzo__hello__main.c: +/home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello.c: +/home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello_.c: + +$ .gerbil/bin/hello world hello, world ``` @@ -322,38 +328,37 @@ optimization. For example: ```shell -$ ldd $(which hello) - linux-vdso.so.1 (0x00007ffc3ffb0000) - libgerbil.so => /usr/local/gerbil/v0.17.0-247-gfba4fc7f/lib/libgerbil.so (0x00007f1304600000) - libgambit.so => /usr/local/gerbil/v0.17.0-247-gfba4fc7f/lib/libgambit.so (0x00007f1303c00000) - libz.so.1 => /lib/x86_64-linux-gnu/libz.so.1 (0x00007f1306588000) - libssl.so.3 => /lib/x86_64-linux-gnu/libssl.so.3 (0x00007f130455c000) - libsqlite3.so.0 => /lib/x86_64-linux-gnu/libsqlite3.so.0 (0x00007f1303ab3000) - libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007f1303800000) - /lib64/ld-linux-x86-64.so.2 (0x00007f13065c4000) - libm.so.6 => /lib/x86_64-linux-gnu/libm.so.6 (0x00007f1303719000) - libcrypto.so.3 => /lib/x86_64-linux-gnu/libcrypto.so.3 (0x00007f1303200000) +$ ldd ./.gerbil/bin/hello + linux-vdso.so.1 (0x00007ffe5f3b6000) + libgerbil.so => /usr/local/gerbil/v0.17.0-294-g80c1d164/lib/libgerbil.so (0x00007fb29cc00000) + libgambit.so => /usr/local/gerbil/v0.17.0-294-g80c1d164/lib/libgambit.so (0x00007fb29c200000) + libz.so.1 => /lib/x86_64-linux-gnu/libz.so.1 (0x00007fb29eb30000) + libssl.so.3 => /lib/x86_64-linux-gnu/libssl.so.3 (0x00007fb29ea8c000) + libsqlite3.so.0 => /lib/x86_64-linux-gnu/libsqlite3.so.0 (0x00007fb29c0b3000) + libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007fb29be00000) + /lib64/ld-linux-x86-64.so.2 (0x00007fb29eb6c000) + libm.so.6 => /lib/x86_64-linux-gnu/libm.so.6 (0x00007fb29cb19000) + libcrypto.so.3 => /lib/x86_64-linux-gnu/libcrypto.so.3 (0x00007fb29b800000) $ gerbil clean ... clean current package -... remove ~/.gerbil/lib/vyzo/hello/lib.ssi -... remove ~/.gerbil/lib/static/vyzo__hello__lib.scm -... remove ~/.gerbil/bin/hello -... remove ~/.gerbil/lib/static/vyzo__hello__main.scm +... remove /home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/lib/vyzo/hello/lib.ssi +... remove /home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/lib/static/vyzo__hello__lib.scm +... remove /home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello +... remove /home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/lib/static/vyzo__hello__main.scm $ gerbil build --optimized ... build in current directory ... compile hello/lib ... compile hello/main -... compile exe hello/main -> ~/.gerbil/bin/hello - -$ ldd $(which hello) - linux-vdso.so.1 (0x00007ffc8e93a000) - libgambit.so => /usr/local/gerbil/v0.17.0-247-gfba4fc7f/lib/libgambit.so (0x00007f58ba000000) - libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007f58b9c00000) - libm.so.6 => /lib/x86_64-linux-gnu/libm.so.6 (0x00007f58ba956000) - /lib64/ld-linux-x86-64.so.2 (0x00007f58bab1b000) - +... compile exe hello/main -> /home/vyzo/src/vyzo/scratch/test/hello-world/.gerbil/bin/hello + +$ ldd ./.gerbil/bin/hello + linux-vdso.so.1 (0x00007fff585fc000) + libgambit.so => /usr/local/gerbil/v0.17.0-294-g80c1d164/lib/libgambit.so (0x00007f6b2e600000) + libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007f6b2e200000) + libm.so.6 => /lib/x86_64-linux-gnu/libm.so.6 (0x00007f6b2e502000) + /lib64/ld-linux-x86-64.so.2 (0x00007f6b2efc9000) ``` If you want your program to be statically linked to dependent @@ -370,7 +375,7 @@ way to build release binaries is by using [docker](docker.md). The generated Makefile has two main rules: the default `linux-static` rule which builds static executables for your poject, and the utility -`clean` rule to clean static build artifacts. +`clean` rule to clean build artifacts. So all you have to do to build a release executable is this: ```shell @@ -379,3 +384,62 @@ $ make This will build the release executable in `.gerbil/bin` in the current directory. + +## Dependency Management + +Once you have started building more complex projects, you will +naturally want to organize them into multiple packages. You are also +likely to have some external dependencies to package developed by +others. + +The `gerbil` tool provides functionality to help with this situation. + +Here are some examples: +- Search for packages in the user configured directories (or just the + default `mighty-gerbils` directory if none is configured): + +```shell +# Search for packages +$ gerbil pkg search +github.com/mighty-gerbils/gerbil-crypto: Cryptography beyond OpenSSL +github.com/mighty-gerbils/gerbil-ethereum: Ethereum support +github.com/mighty-gerbils/gerbil-persist: Data persistence layer +github.com/mighty-gerbils/gerbil-leveldb: LevelDB bindings +github.com/mighty-gerbils/gerbil-libxml: libxml2 bindings +github.com/mighty-gerbils/gerbil-libyaml: Libyaml bindings +github.com/mighty-gerbils/gerbil-lmdb: LMDB bindings +github.com/mighty-gerbils/gerbil-mysql: MySQL database driver +github.com/mighty-gerbils/gerbil-poo: Prototype Object Orientation system +github.com/mighty-gerbils/gerbil-utils: Various utilities + +# Search with keywords +$ gerbil pkg search xml +github.com/mighty-gerbils/gerbil-libxml: libxml2 bindings +``` + +- Add dependencies to your project: +```shell +$ gerbil deps -a -i github.com/mighty-gerbils/gerbil-libxml +... cloning github.com/mighty-gerbils/gerbil-libxml +... pulling +... build github.com/mighty-gerbils/gerbil-libxml +... compile foreign xml/_libxml +... copy ssi xml/_libxml +... compile loader xml/_libxml +... compile xml/libxml +... tagging packages +``` + +- List your project's dependencies: +```shell +$ gerbil deps +github.com/mighty-gerbils/gerbil-libxml +``` + +## Where to go from here + +You can find more information about packages in the [Gerbil Package Manager](package-manager.md) page. + +You can find more information about the `gerbil` tooling in the [Universal Gerbil Binary and Tools](/reference/dev/bach.md) page. + +You can find more information about the build tool specifics in the [Gerbil Build Tool](/reference/dev/build.md) page. diff --git a/doc/guide/package-manager.md b/doc/guide/package-manager.md index b8163751c..8fe3349cf 100644 --- a/doc/guide/package-manager.md +++ b/doc/guide/package-manager.md @@ -7,15 +7,15 @@ distributed through github, gitlab, or bitbucket. ::: tip usage ``` -gxpkg install pkg ... -gxpkg update pkg ... -gxpkg uninstall pkg ... -gxpkg link pkg src -gxpkg unlink pkg ... -gxpkg build pkg ... -gxpkg list -gxpkg retag -gxpkg search keyword ... +gerbil pkg install pkg ... +gerbil pkg update pkg ... +gerbil pkg uninstall pkg ... +gerbil pkg link pkg src +gerbil pkg unlink pkg ... +gerbil pkg build pkg ... +gerbil pkg list +gerbil pkg retag +gerbil pkg search keyword ... ``` ::: @@ -34,46 +34,66 @@ Any supported public provider git repo can serve a Gerbil package, provided that You can use `:std/build-script` to get a template script definition from the package build-spec. -See gerbil-utils for an example package. +See [gerbil-utils](https://github.com/mighty-gerbils/gerbil-utils) for an example package. ## Examples -To install fare's gerbil-utils package: - -`gxpkg install github.com/fare/gerbil-utils` - -To link a local development package (here vyzo's gerbil-aws package): - -`gxpkg link github.com/mighty-gerbils/gerbil-aws gerbil-aws` - -To list all installed (or linked) packages: +- To install fare's gerbil-utils package: +```shell +$ gerbil pkg install github.com/mighty-gerbils/gerbil-utils +``` -`gxpkg list` +- To link a local development package (here vyzo's gerbil-aws package): +```shell +$ gerbil pkg link github.com/vyzo/gerbil-aws gerbil-aws +``` -To update all packages: +- To list all installed (or linked) packages: +```shell +$ gerbil pkg list +``` -`gxpkg update all` +- To update all packages: +```shell +$ gerbil pkg update all +``` -To rebuild a package and its transitive dependencies: +- To rebuild a package and its transitive dependencies: +```shell +gerbil pkg build github.com/mighty-gerbils/gerbil-utils +``` -`gxpkg build github.com/fare/gerbil-utils` +- To rebuild all packages: +```shell +gerbil pkg build all` +``` -To rebuild all packages: +## Package Directories -`gxpkg build all` +Package lists come from directories, which can be any repo on github +that has a `package-list` file or just a URL pointing to a package +list. -To search for packages created by vyzo using the package directory: +This list follows the simplest and most extensible format: an +association list where the car is the package and the cdr is a plist +of the package properties, with keyword keys. The only required key is +`description:`. -`gxpkg search vyzo` +This is designed so that it is trivial to create a new directory; in +fact users are encouraged to create their own directories for their +packages and share them with each other. -## Known Gerbil Packages +By default, the [Mighty Gerbils +directory](https://github.com/mighty-gerbils/gerbil-directory) is +searched, as these are packaged developed and maintained by the Gerbil +Core Team. -We maintain a list of known Gerbil packages in the [Gerbil Package Directory](https://github.com/mighty-gerbils/gerbil-directory). -Feel free to open a PR in that repo to list your own packages! +You can add a new directory with the `gerbil pkg dir -a directory-repo-or-url ...` +command. ## A Word of Caution -The build script is currently not sandboxed; it runs with user privileges and it is an arbitrary script. We originally planned to address this by creating a restricted sandbox language for package build scripts. But you can only go so far in a language that thrives in compile-time evaluation; remember, it's macros all the way! +The build script is not sandboxed; it runs with user privileges and it is an arbitrary script. We originally planned to address this by creating a restricted sandbox language for package build scripts. But you can only go so far in a language that thrives in compile-time evaluation; remember, it's macros all the way! You can quickly vet a package by inspecting the gerbil.pkg manifest and the build script itself. If it uses the standard script template or just invokes make with a build-spec, then it should be a reasonably behaved package. Of course, who knows what surprises could be lurking in a macro deep in the sources, so where to stop? diff --git a/doc/reference/dev/bach.md b/doc/reference/dev/bach.md index 8058224aa..84d6ad1af 100644 --- a/doc/reference/dev/bach.md +++ b/doc/reference/dev/bach.md @@ -1,3 +1,254 @@ # The Gerbil Universal Binary and Tools -(TODO) +If you look at the Gerbil installation bin directory, you will see someghing like the following: +```shell +$ ll -h /usr/local/gerbil/bin/ +total 11M +-rwxrwxr-x 1 vyzo vyzo 19K Sep 24 10:20 gambuild-C +-rwxrwxr-x 1 vyzo vyzo 11M Sep 24 10:23 gerbil +-rwxrwxr-x 1 vyzo vyzo 151K Sep 24 10:20 gsc +lrwxrwxrwx 1 vyzo vyzo 6 Sep 24 10:23 gxc -> gerbil +lrwxrwxrwx 1 vyzo vyzo 6 Sep 24 14:43 gxensemble -> gerbil +lrwxrwxrwx 1 vyzo vyzo 6 Sep 24 10:23 gxi -> gerbil +lrwxrwxrwx 1 vyzo vyzo 6 Sep 24 14:43 gxpkg -> gerbil +lrwxrwxrwx 1 vyzo vyzo 6 Sep 24 14:43 gxprof -> gerbil +lrwxrwxrwx 1 vyzo vyzo 6 Sep 24 14:43 gxtags -> gerbil +lrwxrwxrwx 1 vyzo vyzo 6 Sep 24 14:43 gxtest -> gerbil +``` + +As you notice all the programs distributed with Gerbil link to a +single universal binary, `gerbil`. We call this program +affectionately **Bach** after the great composer of timeless music. + +The `gerbil` binary includes all modules from the core system compiled +in and has specialized main functions for the interpreter and +compiler. + +It also fronts for all tooling, which is implemented with dynamic +loading of dynamically compiled executable modules depending on the +linked executable name. Some of the tooling functionality is actually +explicitly lifted at top level: things like the build tool and +dependency management commands of the `gxpkg` tool. + +Here we give an overview of all commands and tools supported by Bach. + +## Using Bach + +The Gerbil universal binary has the following usage: +```shell +$ gerbil help +Usage: gerbil [option ...] arguments ... + +Options: + -h|--help display this help message exit + -v|--version display the system version and exit + +Arguments: + cmd-arg ... execute a builtin tool command + arg ... drop to the gerbil interpreter + +Commands: + new create a new project template (gxpkg new) + build build a gerbil package (gxpkg build) + deps manage dependencies for a package (gxpkg deps) + clean clean build artifactacts for a package (gxpkg clean) + pkg invoke the gerbil package manager (gxpkg) + test run tests (gxtest) + tags create emacs tags (gxtags) + prof profile a dynamic executable module (gxprof) + ensemble invoke the gerbil actor ensemble manager (gxensemble) + interactive invoke the gerbil interpreter (gxi) + compile invoke the gerbil compiler (gxc) + help display help for a tool command + +Try gerbil help for help on tool command usage +``` + +### `gxi` + +The Gerbil interpreter is `gxi`, but can also be invoked with `gerbil interactve`. +It has the following usage: +```shell +$ gxi -h +Usage: gxi [options ...] arguments ... + +Options: + -h|--help|help display this help message exit + -v||--version|version display the system version and exit + -l|--lang module set the current interpretation language; must precede any evaluation + -e|--eval evaluate an expression + +Arguments: + - enter the repl + :module import library module; if it exports a main function, apply it with the remaining arguments + file load file; if it defines a main function, apply it with the remaining arguments + +When no arguments or options other than --lang are supplied, enters the interactive repl +``` + +### `gxc` + +The Gerbil compiler is `gxc`, but can also be invoked with `gerbil compile`. +It has the following usage: +```shell +$ gxc -h +gxc [options...] ... +Options: + -h,--help display this help message and exit + -d set compiler output directory; defaults to $GERBIL_PATH/lib + -exe compile an executable + -o set executable output file + -O optimize gerbil source + -full-program-optimization perform full program optimization + -static link the executable's external library dependencies statically + -s keep intermediate .scm files + -S don't invoke gsc + -v be verbose during compilation + -g compile with debug symbols; c code is compiled with -g + -no-ssxi don't generate .ssxi modules for cross-module optimization + -include-gambit-sharp include _gambit# with necessary cond expand features + -prelude add [-prelude ] to gsc options + -cc-options add [-cc-options ] to gsc options + -ld-options add [-ld-options ] to gsc options + -gsc-flag add [] to gsc options + -gsc-option add [ ] to gsc options +``` + +### `gerbil new` +```shell +$ gerbil help new +Usage: gxpkg new [command-option ...] + create a new package template in the current directory + +Command Options: + -p --package the package prefix for your project; defaults to the current username [default: vyzo] + -n --name the package name; defaults to the current directory name [default: gerbil] + -l --link link this package with a public package name; for example: github.com/your-user/your-package [default: #f] +``` + +### `gerbil build` +```shell +$ gerbil help build +Usage: gxpkg build [command-option ...] ... + rebuild one or more packages and their dependents + +Command Options: + -l --local do the action in the local package context, unless GERBIL_PATH is set + -R --release build released (static) executables + -O --optimized build full program optimized executables + +Arguments: + pkg package to build; all for all packages, omit to build in current directory +``` + +### `gerbil clean` +```shell +$ gerbil help clean +Usage: gxpkg clean [command-option ...] ... + clean compilation artefacts from one or more packages + +Command Options: + -l --local do the action in the local package context, unless GERBIL_PATH is set + +Arguments: + pkg package to clean; all for all packages, omit to clean in current directory +``` + +### `gerbil pkg` +```shell +$ gerbil help pkg +gxpkg: The Gerbil Package Manager + +Usage: gxpkg command-arg ... + +Commands: + new create a new package template in the current directory + build rebuild one or more packages and their dependents + clean clean compilation artefacts from one or more packages + deps manage dependencies for the current project + link link a local development package + unlink unlink one or more local development packages + install install one or more packages + uninstall uninstall one or more packages + update update one or more packages + list list installed packages + retag retag installed packages + search search the package directory + dir manage the directory list + env execute a command within the local package context + help display help; help for command help +``` + +### `gerbil test` +```shell +$ gerbil help test +gxtest: run Gerbil tests in the command line + +Usage: gxtest [option ...] ... + +Options: + -v run in verbose mode where all test execution progress is displayed in stdout. + -r --run only run test suites whose name matches a given regex [default: #f] + -D define one or more conditional expansion feature (comma separated) for enabling tests that require external services [default: #f] + -h --help display help + +Arguments: + args test files or directories to execute tests in; appending /... to a directory will recursively execute or tests in it. If no arguments are passed, all tests in the current directory are executed. +``` + +### `gerbil tags` +```shell +$ gerbil help tags +gxtags: generate emacs tags for Gerbil code + +Usage: gxtags [option ...] ... + +Options: + -a append to existing tag file + -o explicit name of file for tag table [default: TAGS] + -h --help display help + +Arguments: + input source file or directory +``` + +### `gerbil prof` +```shell +$ gerbil help prof +gxprof: The Gerbil profiler + +Usage: gxprof [option ...] [] ... + +Options: + -o --output gxprof output file [default: gxprof.out] + --heartbeat heartbeat interval for sampling, in seconds [default: .001] + -k --ignore-kernel-frames ignore kernel functions in the analysis + -h --help display help + +Arguments: + module dynamic executable module to run; analyze an existing output file if omitted [default: #f] + module-args arguments to pass to the executable module's main +``` + +### `gerbil ensemble` +```shell +$ gerbil help ensemble +gxensemble: the Gerbil Actor Ensemble Manager + +Usage: gxensemble command-arg ... + +Commands: + run run a server in the ensemble + registry runs the ensemble registry + load loads code in a running server + eval evals code in a running server + repl provides a repl for a running server + ping pings a server or actor in the server + lookup looks up a server by id or role + shutdown shuts down an actor, server, or the entire ensemble including the registry + admin ensemble administrative operations + list list server state + ca ensemble CA operations + package package ensemble state to ship an actor server environment + help display help; help for command help +``` diff --git a/doc/reference/dev/build.md b/doc/reference/dev/build.md index acf6273f3..195709831 100644 --- a/doc/reference/dev/build.md +++ b/doc/reference/dev/build.md @@ -1,8 +1,8 @@ -# The Standard Library Build Tool +# The Gerbil Build Tool Building complex libraries and executables by invoking `gxc` quickly gets tedious. When you reach that point of complexity and you need a build tool, you can use the [`:std/make` library module](/reference/std/make.md) which provides a modest build tool that can handle reasonably complex project building. -## The project source code +## A Trivial Project For illustration purposes, we'll make a hello world library module and an executable that uses it. @@ -23,7 +23,7 @@ $ cat hello.ss (for-each hello args)) ``` -## The standard build script template +### The Standard Build Script Template The recommended way to write a build script is to use the template provided by the standard library. You can do this by importing `:std/build-script` and using the `defbuild-script` macro. @@ -52,7 +52,7 @@ $ ./build.ss ... ``` -## Intermediate build scripts +### Intermediate Build Scripts Here is a build script that uses an environment variable to determine whether to build an optimized fully static binary or a normally linked binary: @@ -68,7 +68,8 @@ $ cat build.ss '(exe: "hello")))) ``` -If you are in your development environment and building executables for your host, then you can just invoke it as +If you are in your development environment and building executables +for your host, then you can just invoke it as ```bash $ ./build.ss ``` @@ -90,8 +91,9 @@ link all stdlib foreign dependencies. ## Using the Gerbil build tool -You don't normally have to run `build.ss` directly, you use the -`gerbil build` which will run it for you: +Normally, you should not run `build.ss` directly but you use the +`gerbil build` tool insted. This will run it for you with the proper build +environment: ```shell $ gerbil build @@ -114,5 +116,493 @@ $ gerbil build --optimized And to build optimized release executables, you can do this inside your [docker build container](/guide/docker.md): ```shell -gerbil build --release --optimized +$ gerbil build --release --optimized ``` + +## Dependency Management and Build Isolation + +So far we have illustrated projects without any package dependencies; +things get more interesting when we factor those in. The build tool +provides functionality to manage your project dependencies and build +your project cleanly in an isolated environment irrespective of the +current global state in `~/.gerbil`. + +All this is best explained with an example, but first let's explicitly +state the problem so that you can understand what follows: +- The Gerbil build environment is dictated by the `GERBIL_PATH` environment variable. +- If you don't set this variable, it will default to `~/.gerbil`. +- This is totally fine for casual or interactive use, where you want + to install things globally to access libraries in the interpreter + and have binaries in your path. +- However, it is entirely inappropriate when building and assembling + your project, as a dirty `~/.gerbil` can break the build and + generally have unintended side effects because of state. +- Prior to Gerbil v0.18, the recommended best practice was to + _manually_ set `GERBIL_PATH` on a per project basis to isolate your + builds. +- This works, but it is poor developer UX; so in Gerbil v0.18 we have + systematized it and unless you explicitly set `GERBIL_PATH` (you can + still do that if you want full control of the build environment), + when building a project locally the build tool will automatically + create a build environment for your project and set `GERBIL_PATH` + for relevant commands. + +### A Simple Project with an External Dependency + +### The Project Structure Source Code + +So let's start over again: this time we'll build a primitive web +scrapper: it is a command line tool that takes a URL, makes an http +request and parses the html output using `parse-html` from the +[gerbil-libxml](https://github.com/mighty-gerbils/gerbil-libxml) +package. + +First, let's create the project: +```shell +$ mkdir scrape-it +$ cd scrape-it +$ gerbil new -n scraper +$ ls -lR +.: +total 16 +-rwxr-xr-x 1 vyzo vyzo 144 Sep 24 11:33 build.ss +-rw-rw-r-- 1 vyzo vyzo 16 Sep 24 11:33 gerbil.pkg +-rw-rw-r-- 1 vyzo vyzo 478 Sep 24 11:33 Makefile +drwxrwxr-x 2 vyzo vyzo 4096 Sep 24 11:33 scraper + +./scraper: +total 8 +-rw-rw-r-- 1 vyzo vyzo 109 Sep 24 11:33 lib.ss +-rw-rw-r-- 1 vyzo vyzo 791 Sep 24 11:33 main.ss +``` + +Now let's add our dependency: +```shell +$ gerbil deps -a -i github.com/mighty-gerbils/gerbil-libxml +... cloning github.com/mighty-gerbils/gerbil-libxml +... pulling +... build github.com/mighty-gerbils/gerbil-libxml +... compile foreign xml/_libxml +... copy ssi xml/_libxml +... compile loader xml/_libxml +... compile xml/libxml +... tagging packages +``` + +Next, we add the code for the scrapper: +```shell + cat scraper/lib.ss +;;; -*- Gerbil -*- +(import :std/error + :std/sugar + :std/net/request + :clan/xml/libxml) +(export #t) + +(def (scrape url) + (let (req (http-get url redirect: #t)) + (unless (= (request-status req) 200) + (error "HTTP request did not succeed" status: (request-status-text req))) + (let (content-type (assget "Content-Type"(request-headers req))) + (unless (string-prefix? "text/html" content-type) + (error "HTTP response did not return html" content-type: content-type))) + (parse-html (request-text req)))) + +$ cat scraper/main.ss +;;; -*- Gerbil -*- +(import :std/error + :std/sugar + :std/getopt + :gerbil/gambit + ./lib) +(export main) + +;; build manifest; generated during the build +;; defines version-manifest which you can use for exact versioning +(include "../manifest.ss") + +(def (main . args) + (call-with-getopt scraper-main args + program: "scraper" + help: "A simple web scraper" + (argument 'url help: "URL to scrape"))) + +(def* scraper-main + ((opt) + (scraper-main/options opt)) + ((cmd opt) + (scraper-main/command cmd opt))) + +;;; Implement this if your CLI doesn't have commands +(def (scraper-main/options opt) + (let (sxml (scrape (hash-ref opt 'url))) + (pretty-print sxml))) + +;;; Implement this if your CLI has commands +(def (scraper-main/command cmd opt) + (error "Implement me!")) + +$ cat build.ss +#!/usr/bin/env gxi +;;; -*- Gerbil -*- +(import :std/build-script :std/make) + +(defbuild-script + `("scraper/lib" + (exe: "scraper/main" bin: "scraper" + "-cc-options" ,(shell-config "xml2-config" "--cflags") + "-ld-options" ,(shell-config "xml2-config" "--libs")))) + +``` + +And let's build it and run it: +```shell +$ gerbil build +... build in current directory +... compile scraper/main +... compile exe scraper/main -> /home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper +/tmp/gxc.1695545021.0991077/clan__xml___libxml.scm: +/tmp/gxc.1695545021.0991077/clan__xml__libxml.scm: +/tmp/gxc.1695545021.0991077/vyzo__scraper__lib.scm: +/tmp/gxc.1695545021.0991077/vyzo__scraper__main.scm: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper.scmx: +/tmp/gxc.1695545021.0991077/clan__xml___libxml.c: +/tmp/gxc.1695545021.0991077/clan__xml__libxml.c: +/tmp/gxc.1695545021.0991077/vyzo__scraper__lib.c: +/tmp/gxc.1695545021.0991077/vyzo__scraper__main.c: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper.c: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper_.c: + +$ ./.gerbil/bin/scraper http://hackzen.org +(*TOP* (html (head (title "(hackzen.org)") + (link (@ (rel "stylesheet") (type "text/css") (href "style.css")))) + (body "\n " + (h1 (@ (id "header")) "(hackzen.org)") + "\n " + "\n " + (div (a (@ (href "http://xkcd.com/297/")) (img (@ (src "parens.png"))))) + "\n " + (br) + (div (a (@ (href "robots.html")) "(robots)")) + "\n " + (div (a (@ (href "gerbil/index.html")) "(gerbils)")) + "\n " + (div (a (@ (href "humans.html")) "(humans)")) + "\n " + (div (a (@ (href "nic9/index.html")) "[N1C#09]")) + "\n " + (br) + (script (@ (src "harhar.js")))))) +``` + +So everything worked smoothly with the build, and the program works; +let's look at what happend under the hood. + +### The Build Environment + +The first thing that you should notice is that the build artifacts are +placed in a local `.gerbil` directory and not the global user +`~/.gerbil`. + +Now let's look at what's in there: +```shell +$ ls -lR .gerbil/ +.gerbil/: +total 12 +drwxr-xr-x 2 vyzo vyzo 4096 Sep 24 11:43 bin +drwxr-xr-x 5 vyzo vyzo 4096 Sep 24 11:42 lib +drwxr-xr-x 3 vyzo vyzo 4096 Sep 24 11:34 pkg + +.gerbil/bin: +total 220 +-rwxrwxr-x 1 vyzo vyzo 222312 Sep 24 11:43 scraper + +.gerbil/lib: +total 12 +drwxr-xr-x 3 vyzo vyzo 4096 Sep 24 11:34 clan +drwxr-xr-x 2 vyzo vyzo 4096 Sep 24 11:43 static +drwxr-xr-x 3 vyzo vyzo 4096 Sep 24 11:42 vyzo + +.gerbil/lib/clan: +total 4 +drwxr-xr-x 2 vyzo vyzo 4096 Sep 24 11:34 xml + +.gerbil/lib/clan/xml: +total 212 +-rwxrwxr-x 1 vyzo vyzo 47448 Sep 24 11:34 libxml__0.o1 +-rwxrwxr-x 1 vyzo vyzo 18656 Sep 24 11:34 libxml__1.o1 +-rwxrwxr-x 1 vyzo vyzo 92472 Sep 24 11:34 _libxml.o1 +-rwxrwxr-x 1 vyzo vyzo 17800 Sep 24 11:34 _libxml__rt.o1 +-rwxrwxr-x 1 vyzo vyzo 18160 Sep 24 11:34 libxml__rt.o1 +-rwxrwxr-x 1 vyzo vyzo 1543 Sep 24 11:34 _libxml.ssi +-rw-r--r-- 1 vyzo vyzo 4072 Sep 24 11:34 libxml.ssi +-rw-r--r-- 1 vyzo vyzo 1832 Sep 24 11:34 libxml.ssxi.ss + +.gerbil/lib/static: +total 48 +-rwxrwxr-x 1 vyzo vyzo 12419 Sep 24 11:34 clan__xml___libxml.scm +-rwxrwxr-x 1 vyzo vyzo 21371 Sep 24 11:34 clan__xml__libxml.scm +-rwxrwxr-x 1 vyzo vyzo 2109 Sep 24 11:42 vyzo__scraper__lib.scm +-rwxrwxr-x 1 vyzo vyzo 2404 Sep 24 11:43 vyzo__scraper__main.scm + +.gerbil/lib/vyzo: +total 4 +drwxr-xr-x 2 vyzo vyzo 4096 Sep 24 11:42 scraper + +.gerbil/lib/vyzo/scraper: +total 64 +-rwxrwxr-x 1 vyzo vyzo 19008 Sep 24 11:42 lib__0.o1 +-rwxrwxr-x 1 vyzo vyzo 18488 Sep 24 11:42 lib__rt.o1 +-rw-r--r-- 1 vyzo vyzo 293 Sep 24 11:42 lib.ssi +-rw-r--r-- 1 vyzo vyzo 108 Sep 24 11:42 lib.ssxi.ss +-rw-r--r-- 1 vyzo vyzo 2404 Sep 24 11:43 main__0.scm +-rw-r--r-- 1 vyzo vyzo 297 Sep 24 11:43 main__rt.scm +-rw-r--r-- 1 vyzo vyzo 738 Sep 24 11:43 main.ssi +-rw-r--r-- 1 vyzo vyzo 424 Sep 24 11:43 main.ssxi.ss + +.gerbil/pkg: +total 8 +drwxr-xr-x 3 vyzo vyzo 4096 Sep 24 11:34 github.com +-rw-rw-r-- 1 vyzo vyzo 3599 Sep 24 11:34 TAGS + +.gerbil/pkg/github.com: +total 4 +drwxr-xr-x 3 vyzo vyzo 4096 Sep 24 11:34 mighty-gerbils + +.gerbil/pkg/github.com/mighty-gerbils: +total 8 +drwxrwxr-x 4 vyzo vyzo 4096 Sep 24 11:34 gerbil-libxml +-rw-rw-r-- 1 vyzo vyzo 131 Sep 24 11:34 gerbil-libxml.manifest + +.gerbil/pkg/github.com/mighty-gerbils/gerbil-libxml: +total 64 +-rw-rw-r-- 1 vyzo vyzo 362 Sep 24 11:34 build-deps +-rwxrwxr-x 1 vyzo vyzo 306 Sep 24 11:34 build.ss +-rw-rw-r-- 1 vyzo vyzo 16 Sep 24 11:34 gerbil.pkg +-rw-rw-r-- 1 vyzo vyzo 11358 Sep 24 11:34 LICENSE-APACHE-2.0.txt +-rw-rw-r-- 1 vyzo vyzo 26430 Sep 24 11:34 LICENSE-LGPL.txt +-rw-rw-r-- 1 vyzo vyzo 172 Sep 24 11:34 manifest.ss +-rw-rw-r-- 1 vyzo vyzo 3535 Sep 24 11:34 README.md +drwxrwxr-x 2 vyzo vyzo 4096 Sep 24 11:34 xml + +.gerbil/pkg/github.com/mighty-gerbils/gerbil-libxml/xml: +total 28 +-rw-rw-r-- 1 vyzo vyzo 12419 Sep 24 11:34 _libxml.scm +-rw-rw-r-- 1 vyzo vyzo 6351 Sep 24 11:34 libxml.ss +-rw-rw-r-- 1 vyzo vyzo 1543 Sep 24 11:34 _libxml.ssi +``` + +- `.gerbil/bin` contains the binary output. +- `.gerbil/lib` contains the library build artifacts. +- `.gerbil/pkg` contains the packages involved + +The most important one here is the `.gerbil/pkg` directory, this is +where dependencies live. + +### Version Manifests + +You will notice a salient new file that appeared in our directory: +```shell +$ ll manifest.ss +-rw-rw-r-- 1 vyzo vyzo 205 Sep 24 11:43 manifest.ss + +$ cat manifest.ss +(def version-manifest + '(("scrape-it" . "unknown") + ("Gerbil" . "0.17.0-309-g5ebf1095") + ("Gambit" . "v4.9.5-40-g24201248") + ("github.com/mighty-gerbils/gerbil-libxml" . "b08e5d8"))) +``` + +This file provides exact versioning for all parts of the project +involved, getting information from `git`. For `gerbil-libxml` you'll +notice that the version is a commit hash, as at the time of writing +there are not any _version tags_ in the package (see next section). + +Note that the version of our project (`scrape-it`) is unknow; that's +because we have not initialized a git repository for our project. +Once we do that, it stops being unknown and it points to the current commit: +```shell +$ git init +Initialized empty Git repository in /home/vyzo/src/vyzo/scratch/test/scrape-it/.git/ + +$ git add . +$ git status +On branch master + +No commits yet + +Changes to be committed: + (use "git rm --cached ..." to unstage) + new file: .gitignore + new file: Makefile + new file: build.ss + new file: gerbil.pkg + new file: scraper/lib.ss + new file: scraper/main.ss + +$ git commit -m "initial commit" +[master (root-commit) 0ba7240] initial commit + 6 files changed, 83 insertions(+) + create mode 100644 .gitignore + create mode 100644 Makefile + create mode 100755 build.ss + create mode 100644 gerbil.pkg + create mode 100644 scraper/lib.ss + create mode 100644 scraper/main.ss + + $ gerbil clean +... clean current package +... remove /home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/lib/vyzo/scraper/lib.ssi +... remove /home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/lib/static/vyzo__scraper__lib.scm +... remove /home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper +... remove /home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/lib/static/vyzo__scraper__main.scm + +$ gerbil build +... build in current directory +... compile scraper/lib +... compile scraper/main +... compile exe scraper/main -> /home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper +/tmp/gxc.1695546027.0358357/clan__xml___libxml.scm: +/tmp/gxc.1695546027.0358357/clan__xml__libxml.scm: +/tmp/gxc.1695546027.0358357/vyzo__scraper__lib.scm: +/tmp/gxc.1695546027.0358357/vyzo__scraper__main.scm: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper.scmx: +/tmp/gxc.1695546027.0358357/clan__xml___libxml.c: +/tmp/gxc.1695546027.0358357/clan__xml__libxml.c: +/tmp/gxc.1695546027.0358357/vyzo__scraper__lib.c: +/tmp/gxc.1695546027.0358357/vyzo__scraper__main.c: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper.c: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper_.c: + +$ cat manifest.ss +(def version-manifest + '(("scrape-it" . "0ba7240") + ("Gerbil" . "0.17.0-309-g5ebf1095") + ("Gambit" . "v4.9.5-40-g24201248") + ("github.com/mighty-gerbils/gerbil-libxml" . "b08e5d8"))) +``` + +We can integrate the version manifest into our program's cli so that +when a user reports a bug or there is some failure in your production +environment, you can query the binary to find the exact version and +know exactly what code was used to compile it. + +Here, we add a `-v/--version` flag to print the version and exit: +```shell +$ cat scraper/main.ss +;;; -*- Gerbil -*- +(import :std/error + :std/sugar + :std/getopt + :gerbil/gambit + ./lib) +(export main) + +;; build manifest; generated during the build +;; defines version-manifest which you can use for exact versioning +(include "../manifest.ss") + +(def (main . args) + (call-with-getopt scraper-main args + program: "scraper" + help: "A simple web scraper" + (flag 'version "-v" "--version" help: "display program version and exit") + (optional-argument 'url help: "URL to scrape"))) + +(def* scraper-main + ((opt) + (scraper-main/options opt)) + ((cmd opt) + (scraper-main/command cmd opt))) + +;;; Implement this if your CLI doesn't have commands +(def (scraper-main/options opt) + (when (hash-get opt 'version) + (pretty-print version-manifest) + (exit 0)) + (let (sxml (scrape (hash-ref opt 'url))) + (pretty-print sxml))) + +;;; Implement this if your CLI has commands +(def (scraper-main/command cmd opt) + (error "Implement me!")) + + +$ gerbil build +... build in current directory +... compile scraper/main +... compile exe scraper/main -> /home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper +/tmp/gxc.1695546226.3194306/clan__xml___libxml.scm: +/tmp/gxc.1695546226.3194306/clan__xml__libxml.scm: +/tmp/gxc.1695546226.3194306/vyzo__scraper__lib.scm: +/tmp/gxc.1695546226.3194306/vyzo__scraper__main.scm: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper.scmx: +/tmp/gxc.1695546226.3194306/clan__xml___libxml.c: +/tmp/gxc.1695546226.3194306/clan__xml__libxml.c: +/tmp/gxc.1695546226.3194306/vyzo__scraper__lib.c: +/tmp/gxc.1695546226.3194306/vyzo__scraper__main.c: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper.c: +/home/vyzo/src/vyzo/scratch/test/scrape-it/.gerbil/bin/scraper_.c: + +``` + +And voila: +```shell +$ ./.gerbil/bin/scraper -v +(("scrape-it" . "0ba7240") + ("Gerbil" . "0.17.0-309-g5ebf1095") + ("Gambit" . "v4.9.5-40-g24201248") + ("github.com/mighty-gerbils/gerbil-libxml" . "b08e5d8")) +``` + +### Semantic Versioning + +As you've probably noticed, version information comes from `git`. The natural follow up question is "can we version packages". + +The answer is "Yes, of course!". Gerbil uses tags for version and +implements _semantic versioning_ to select the correct version of your +packages when there differing versions specified. You can request a +specific version of a package by simple appending `@` to +the package name when specifying a dependency. This will ensure that +the correct version of the code is checked out according to the +dependencies in the transitive package list. + +The rules for version selection when there are different version of +the same package involved in the transitive dependency list are as +follows: +- Always select the latest semantic version, with tags of the form + `vX[.Y[.Z]]` parsed as major, minor, and patch version +- The `master` and `main` branches are always considered versioned as + higher than any semantic version tag. +- If the package version specifies two different branches or commit + hashes, then it is considered a _hard_ conflict and the user has to + intervene to resolve the issue. + +Note that Gerbil's semantic versioning doesn't follow the strict +"different major versions are incompatible" rule. We considered this +and our long experience with developing production software has led us +to the conclusion that it simply doesn't work in practice -- see Go's +ugly required version appending once you are over v1 or the mess with +Rust. What we advocate instead is for you to make a `v2` subpackage +within your package that implements forward functionality without +breaking the API of `v1` and so on for higher versions. + +## Testing your package + +So at this point you are naturally wondering how to run tests for your +package, given the build isolation properties of the tooling. + +This is actually very simple: the `gerbil pkg env` command provides +you with the ability to run command with the local build GERBIL_PATH +set for you. + +So in order to run your tests, all you have to do is: +``` +$ gerbil pkg env gxtest ./... +``` + +## Where to go from here + +See the [Gerbil Universal Binary and Tools](bach.md) page for more +information about the Gerbil tooling. diff --git a/doc/reference/dev/optimizing.md b/doc/reference/dev/optimizing.md index bbefc0ee5..b261f7b0c 100644 --- a/doc/reference/dev/optimizing.md +++ b/doc/reference/dev/optimizing.md @@ -77,7 +77,7 @@ checking and show you your performance envelope. ::: tip Note We do not advocate shipping programs compiled like this in production -servers, unless you want your devops to be debugging segfaults. The +servers, unless you want your devops to be debugging segfaults. These programs are also nearly impossible to debug because everything is lumped in a single host function and you might not even get a stack trace with gdb. diff --git a/src/gerbil/main.ss b/src/gerbil/main.ss index 67fd379c3..34ea517c2 100644 --- a/src/gerbil/main.ss +++ b/src/gerbil/main.ss @@ -53,6 +53,7 @@ package: gerbil (def builtin-tool-commands '(("new" "gxpkg" "new") ("build" "gxpkg" "build") + ("deps" "gxpkg" "deps") ("clean" "gxpkg" "clean") ("pkg" "gxpkg") ("test" "gxtest") @@ -65,6 +66,7 @@ package: gerbil (def builtin-tool-help '(("new" "gxpkg" "help" "new") ("build" "gxpkg" "help" "build") + ("deps" "gxpkg" "help" "deps") ("clean" "gxpkg" "help" "clean") ("pkg" "gxpkg" "help") ("test" "gxtest" "-h") @@ -79,7 +81,7 @@ package: gerbil (displayln) (displayln "Options: ") (displayln " -h|--help display this help message exit") - (displayln " -v|--version|version display the system version and exit") + (displayln " -v|--version display the system version and exit") (displayln) (displayln "Arguments: ") (displayln " cmd-arg ... execute a builtin tool command") @@ -88,6 +90,7 @@ package: gerbil (displayln "Commands:") (displayln " new create a new project template (gxpkg new)") (displayln " build build a gerbil package (gxpkg build)") + (displayln " deps manage dependencies for a package (gxpkg deps)") (displayln " clean clean build artifactacts for a package (gxpkg clean)") (displayln " pkg invoke the gerbil package manager (gxpkg)") (displayln " test run tests (gxtest)") diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 44273ef43..d84b764f5 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -5,15 +5,16 @@ ;;; Usage: ;;; gxpkg action arg .... ;;; Actions: -;;; install pkg ... +;;; install pkg[@tag] ... +;;; update pkg[@tag] ... ;;; uninstall pkg ... -;;; update pkg ... ;;; link pkg src ;;; unlink pkg ... ;;; build pkg ... ;;; clean pkg ... ;;; list ;;; retag +;;; search kw ... ;;; Packages: ;;; github.com/user/package -- github based packages ;;; gitlab.com/user/package -- gitlab based packages @@ -21,7 +22,8 @@ ;;; all -- action applies to all packages where sensible to do so ;;; TODO: add private repos support -(import :std/getopt +(import :gerbil/gambit + :std/getopt :std/sugar :std/iter :std/sort @@ -30,7 +32,7 @@ :std/misc/process :std/misc/template (only-in :std/srfi/13 string-trim) - :gerbil/gambit) + (only-in :std/srfi/1 reverse!)) (export main ;; script api pkg-root-dir @@ -42,51 +44,96 @@ pkg-plist pkg-dependents pkg-dependents*) (def (main . args) + (def local-flag + (flag 'local "-l" "--local" + help: "do the action in the local package context, unless GERBIL_PATH is set")) + (def force-flag + (flag 'force "-f" "--force" + help: "force the action")) (def install-cmd (command 'install help: "install one or more packages" - (rest-arguments 'pkg help: "package to install"))) + local-flag + (rest-arguments 'pkg help: "package to install; use @tag to checkout a specific tag"))) (def uninstall-cmd (command 'uninstall help: "uninstall one or more packages" - (flag 'force "-f" help: "force uninstall even if there are orphaned dependencies") + local-flag force-flag (rest-arguments 'pkg help: "package to uninstall"))) (def update-cmd (command 'update help: "update one or more packages" - (rest-arguments 'pkg help: "package to update; all for all packages"))) + local-flag + (rest-arguments 'pkg help: "package to update; use @tag to checkout a specific tag; all for all packages"))) (def link-cmd (command 'link help: "link a local development package" + local-flag (argument 'pkg help: "package to link") (argument 'src help: "path to package source directory"))) (def unlink-cmd (command 'unlink help: "unlink one or more local development packages" - (flag 'force "-f" help: "force unlink even if there are orphaned dependencies") + local-flag force-flag (rest-arguments 'pkg help: "package to unlink"))) (def build-cmd (command 'build help: "rebuild one or more packages and their dependents" + local-flag (flag 'build-release "-R" "--release" help: "build released (static) executables") (flag 'build-optimized "-O" "--optimized" help: "build full program optimized executables") (rest-arguments 'pkg help: "package to build; all for all packages, omit to build in current directory"))) (def clean-cmd (command 'clean help: "clean compilation artefacts from one or more packages" + local-flag (rest-arguments 'pkg help: "package to clean; all for all packages, omit to clean in current directory"))) (def new-cmd - (command 'new help: "Create a new package template in the current directory" + (command 'new help: "create a new package template in the current directory" (option 'package "-p" "--package" - help: "The package prefix for your project; defaults to the current username" + help: "the package prefix for your project; defaults to the current username" default: (getenv "USER")) (option 'name "-n" "--name" - help: "The package name; defaults to the current directory name" - default: (path-strip-directory - (let (path (path-normalize (current-directory))) - (substring path 0 (1- (string-length path)))))) + help: "the package name; defaults to the current directory name" + default: (path-strip-directory (path-normalize* (current-directory)))) (option 'link "-l" "--link" - help: "Optionally link this package with a public package name; for example: github.com/your-user/your-package"))) + help: "link this package with a public package name; for example: github.com/your-user/your-package"))) + (def deps-cmd + (command 'deps help: "manage dependencies for the current project" + (flag 'add "-a" "--add" + help: "add dependencies") + (flag 'install "-i" "--install" + help: "install dependencies") + (flag 'update "-u" "--update" + help: "update dependencies") + (flag 'remove "-r" "--remove" + help: "remove dependencies") + (rest-arguments 'deps + help: "the list of dependencies to add, update or remove; empty for all; if no flags are specified it displays current deps"))) (def list-cmd - (command 'list help: "list installed packages")) + (command 'list + local-flag + help: "list installed packages")) (def retag-cmd - (command 'retag help: "retag installed packages")) + (command 'retag + local-flag + help: "retag installed packages")) (def search-cmd (command 'search help: "search the package directory" - (rest-arguments 'keywords help: "keywords to search for"))) + local-flag + (option 'directory "-d" "--directory" + help: "A specific directory to use; by default the mighty-gerbils directory and all user configured directories are searched") + (flag 'as-list "--list" + help: "Print the results as a list, do not format it") + (rest-arguments 'keywords help: "keywords to search for, as a boolean and"))) + + (def dir-cmd + (command 'dir help: "manage the directory list" + local-flag + (flag 'add "-a" "--add" + help: "add a directory to the list of searched directories") + (flag 'remove "-r" "--remove" + help: "remove a directory from the list") + (rest-arguments 'directories + help: "the directory to add or remove; the directory can be a fully qualified https url to the package-list or a github repo of the form github.com/some-org/some-repo"))) + + (def env-cmd + (command 'env help: "execute a command within the local package context" + (argument 'command help: "the command to execute") + (rest-arguments 'command-args help: "the command arguments"))) (call-with-getopt gxpkg-main args program: "gxpkg" @@ -94,6 +141,7 @@ new-cmd build-cmd clean-cmd + deps-cmd link-cmd unlink-cmd install-cmd @@ -101,7 +149,9 @@ update-cmd list-cmd retag-cmd - search-cmd)) + search-cmd + dir-cmd + env-cmd)) (def (gxpkg-main cmd opt) (let-hash opt @@ -109,27 +159,40 @@ ((new) (pkg-new .package .name .link)) ((build) - (build-pkgs .pkg .?build-release .?build-optimized)) + (build-pkgs .pkg .?build-release .?build-optimized .?local)) ((clean) - (clean-pkgs .pkg)) + (clean-pkgs .pkg .?local)) + ((deps) + (manage-deps .deps .?add .?install .?update .?remove)) ((link) - (link-pkg .pkg .src)) + (link-pkg .pkg .src .?local)) ((unlink) - (unlink-pkgs .pkg .?force)) + (unlink-pkgs .pkg .?force .?local)) ((install) - (install-pkgs .pkg)) + (install-pkgs .pkg .?local)) ((uninstall) - (uninstall-pkgs .pkg .?force)) + (uninstall-pkgs .pkg .?force .?local)) ((update) - (update-pkgs .pkg)) + (update-pkgs .pkg .?local)) ((list) - (list-pkgs)) + (list-pkgs .?local)) ((retag) - (retag-pkgs)) + (retag-pkgs .?local)) ((search) - (search-pkgs .keywords))))) + (search-pkgs .keywords .directory .?as-list)) + ((dir) + (manage-dirs .directories .?add .?remove .?local)) + ((env) + (env-exec .command .command-args))))) ;;; commands +(def (env-exec command args) + (set-local-env!) + (invoke command args + stdin-redirection: #f + stdout-redirection: #f + stderr-redirection: #f)) + (defrules fold-pkgs () ((_ pkgs action action-arg ...) (let lp ((rest pkgs) (result #f)) @@ -146,13 +209,19 @@ (when (fold-pkgs pkgs action action-arg ...) (pkg-retag)))) -(def (install-pkgs pkgs) +(def (install-pkgs pkgs local?) + (when local? + (set-local-env!)) (fold-pkgs-retag pkgs pkg-install)) -(def (uninstall-pkgs pkgs force?) +(def (uninstall-pkgs pkgs force? local?) + (when local? + (set-local-env!)) (fold-pkgs-retag pkgs pkg-uninstall force?)) -(def (update-pkgs pkgs) +(def (update-pkgs pkgs local?) + (when local? + (set-local-env!)) (when (fold-pkgs pkgs pkg-update) ;; the package dependencies might have changed, so install them (for-each @@ -165,61 +234,101 @@ (for-each pkg-build pkgs) (pkg-retag))) -(def (link-pkg pkg src) +(def (link-pkg pkg src local?) + (when local? + (set-local-env!)) (pkg-link pkg src)) -(def (unlink-pkgs pkgs force?) +(def (unlink-pkgs pkgs force? local?) + (when local? + (set-local-env!)) (for-each (cut pkg-unlink <> force?) pkgs)) -(def (build-pkgs pkgs release? optimized?) +(def (build-pkgs pkgs release? optimized? local?) + (when local? + (set-local-env!)) (when release? (setenv "GERBIL_BUILD_RELEASE" "t")) (when optimized? (setenv "GERBIL_BUILD_OPTIMIZED" "t")) (if (null? pkgs) ;; do local build - (pkg-build "." #f) + (begin + (set-local-env!) + (pkg-build "." #f)) (for-each pkg-build pkgs))) -(def (clean-pkgs pkgs) +(def (clean-pkgs pkgs local?) + (when local? + (set-local-env!)) (if (null? pkgs) ;; do local clean - (pkg-clean ".") + (begin + (set-local-env!) + (pkg-clean ".")) (for-each pkg-clean pkgs))) -(def (list-pkgs) - (for-each displayln (pkg-list))) - -(def (retag-pkgs) +(def (list-pkgs local?) + (when local? + (set-local-env!)) + (for (pkg (pkg-list)) + (let (tag (pkg-tag-get pkg)) + (display pkg) + (when tag + (display* "@" tag)) + (newline)))) + +(def (retag-pkgs local?) + (when local? + (set-local-env!)) (pkg-retag)) -(def (search-pkgs keywords) - (pkg-search keywords)) +(def (search-pkgs keywords dir as-list?) + (pkg-search keywords dir as-list?)) + +(def (manage-dirs dirs add? remove? local?) + (pkg-directory-manage dirs add? remove? local?)) + +(def (manage-deps deps add? install? update? remove?) + (set-local-env!) + (pkg-deps-manage deps add? install? update? remove?)) + +(def (set-local-env!) + (unless (getenv "GERBIL_PATH" #f) + (let* ((here (path-normalize* (current-directory))) + (gerbil-path (path-expand ".gerbil" here))) + (if (file-exists? gerbil-path) + (setenv "GERBIL_PATH" gerbil-path) + (if (file-exists? (path-expand "gerbil.pkg" here)) + (begin + (create-directory* gerbil-path) + (setenv "GERBIL_PATH" gerbil-path)) + (error "not in local package context")))))) ;;; action implementation -- script api (def +root-dir+ - (getenv "GERBIL_PATH" "~/.gerbil")) + (delay (getenv "GERBIL_PATH" "~/.gerbil"))) (def +pkg-root-dir+ - (path-expand "pkg" +root-dir+)) + (delay (path-expand "pkg" (force +root-dir+)))) (def +pkg-lib-dir+ - (path-expand "lib" +root-dir+)) + (delay (path-expand "lib" (force +root-dir+)))) (def +pkg-lib-static-dir+ - (path-expand "static" +pkg-lib-dir+)) + (delay (path-expand "static" (force +pkg-lib-dir+)))) (def +pkg-bin-dir+ - (path-expand "bin" +root-dir+)) + (delay (path-expand "bin" (force +root-dir+)))) (def pkg-root-dir (let (once (delay (begin - (create-directory* +root-dir+) - (create-directory* +pkg-root-dir+) - (create-directory* +pkg-lib-dir+) - (create-directory* +pkg-lib-static-dir+) - (create-directory* +pkg-bin-dir+)))) + (create-directory* (force +root-dir+)) + (create-directory* (force +pkg-root-dir+)) + (create-directory* (force +pkg-lib-dir+)) + (create-directory* (force +pkg-lib-static-dir+)) + (create-directory* (force +pkg-bin-dir+))))) (lambda () (force once) - +pkg-root-dir+))) + (force +pkg-root-dir+)))) (def (pkg-new prefix name maybe-link) (def (create-template file template . args) @@ -242,32 +351,31 @@ (when maybe-link (pkg-link maybe-link (current-directory)))) -(def (pkg-install pkg) - (def (git-clone-url pkg) - (string-append "https://" pkg ".git")) - (cond - ((or (string-prefix? "github.com/" pkg) - (string-prefix? "gitlab.com/" pkg) - (string-prefix? "bitbucket.org/" pkg)) - (pkg-install-git pkg (git-clone-url pkg))) - (else - (error "Unknown package provider" pkg)))) +(def (pkg+tag pkg) + (let* ((pt (string-split pkg #\@)) + (pkg (car pt)) + (tag (let (kdr (cdr pt)) + (and (not (null? kdr)) + (car kdr))))) + (values pkg tag))) -(def (pkg-install-git pkg clone-url) - (let* ((root (pkg-root-dir)) - (dest (path-expand pkg root))) - (if (file-exists? dest) - #f - (let (path (path-directory dest)) - (displayln "... install " pkg) - (create-directory* path) - (run-process ["git" "clone" "-q" clone-url] - directory: path - coprocess: void - stdout-redirection: #f) - (pkg-install-deps pkg) - (pkg-build pkg) - #t)))) +(def (pkg-install pkg) + (let* (((values pkg tag) (pkg+tag pkg)) + (current-tag (pkg-tag-get pkg))) + (def (install-it tag) + (pkg-fetch pkg tag) + (pkg-install-deps pkg) + (pkg-build pkg)) + + (if current-tag + (cond + ((pkg-tag-incompatible? current-tag tag) + (error "Package already installed with an incompatible tag" pkg tag current-tag)) + ((pkg-tag-choose current-tag tag) + => install-it) + (else + (install-it tag))) + (install-it tag)))) (def (pkg-install-deps pkg) (let* ((plist (pkg-plist pkg)) @@ -286,8 +394,11 @@ (error "Refuse to uninstall package; orphaned dependencies" deps)))) (pkg-clean pkg) (displayln "... uninstall " pkg) - (run-process ["rm" "-rf" (path-normalize dest)] + (run-process ["rm" "-rf" (path-normalize* dest)] coprocess: void) + (let (tagf (pkg-tag-file pkg)) + (when (file-exists? tagf) + (delete-file tagf))) #t)))) (def (pkg-update pkg) @@ -303,16 +414,125 @@ (def (pkg-update-git pkg) (let* ((root (pkg-root-dir)) + ((values pkg tag) (pkg+tag pkg)) (dest (path-expand pkg root))) (unless (file-exists? dest) (error "Cannot update uknown package" pkg)) (and (not (file-symbolic-link? dest)) - (begin - (displayln "... update " pkg) - (let* ((result (run-process ["git" "pull"] - directory: dest)) - (update? (not (equal? result "Already up-to-date.\n")))) - update?))))) + (pkg-fetch-git pkg tag)))) + +(def (pkg-fetch pkg tag) + (cond + ((or (string-prefix? "github.com/" pkg) + (string-prefix? "gitlab.com/" pkg) + (string-prefix? "bitbucket.org/" pkg)) + (pkg-fetch-git pkg tag)) + (else + (error "Unknown package provider" pkg)))) + +(def (pkg-fetch-git pkg tag) + (let* ((root (pkg-root-dir)) + (dest (path-expand pkg root))) + (if (file-exists? dest) + (begin + (displayln "... fetching " pkg) + (run-process ["git" "fetch" "-q"] + directory: dest + coprocess: void + stdout-redirection: #f)) + (let ((path (path-directory dest)) + (clone-url (git-clone-url pkg))) + (displayln "... cloning " pkg) + (create-directory* path) + (run-process ["git" "clone" "-q" clone-url] + directory: path + coprocess: void + stdout-redirection: #f))) + (when tag + (displayln "... checking out " tag) + (run-process ["git" "checkout" "-q" tag] + directory: dest + coprocess: void + stdout-redirection: #f) + (call-with-output-file (pkg-tag-file pkg) + (cut write tag <>))) + (let (tag (pkg-tag-get pkg)) + (when (not (pkg-tag-semver? tag)) + (displayln "... pulling") + (run-process ["git" "pull" "-q" "origin" tag] + directory: dest + coprocess: void + stdout-redirection: #f))))) + +(def (pkg-tag-file pkg) + (let* ((root (pkg-root-dir)) + (dest (path-expand pkg root))) + (string-append dest ".tag"))) + +(def (pkg-tag-get pkg) + (let ((tagf (pkg-tag-file pkg)) + (top (path-expand pkg (pkg-root-dir)))) + (cond + ((file-exists? tagf) + (call-with-input-file tagf read)) + ((file-exists? top) + (run-process ["git" "branch" "--show-current"] + directory: top + coprocess: read-line)) + (else #f)))) + +(def (pkg-tag-incompatible? current other) + (cond + ((or (not current) (not other)) #f) + ((and (pkg-tag-semver? current) + (pkg-tag-semver? other)) + #f) + ((or (member current '("master" "main")) + (member other '("master" "main"))) + #f) + (else + (not (equal? current other))))) + +;; Note: in this implementation of semver, we always keep the greatest version. +;; We don't pay attention to majors and we consider master/main to be the frontier. +(def (pkg-tag-choose current other) + (cond + ((equal? current other) + current) + ((not other) + current) + ((member current '("master" "main")) + current) + ((member other '("master" "main")) + other) + (else + (let ((current-version (pkg-tag-semver current)) + (other-version (pkg-tag-semver other))) + (let lp ((current-rest current-version) + (other-rest other-version)) + (match current-rest + ([current-hd . current-rest] + (match other-rest + ([other-hd . other-rest] + (cond + ((= current-hd other-hd) + (lp current-rest other-rest)) + ((> current-hd other-hd) + current) + (else other))) + (else current))) + (else other))))))) + +(def +rx-semver+ + (pregexp "v(\\d+\\.)*\\d+")) + +(def (pkg-tag-semver? tag) + (pregexp-match +rx-semver+ tag)) + +(def (pkg-tag-semver tag) + (map string->number + (string-split (substring tag 1 (string-length tag)) ; drop the v + #\.))) (def (pkg-link pkg src) (let* ((root (pkg-root-dir)) @@ -361,6 +581,7 @@ (for-each (cut pkg-build <> #f) (map car sorted)))) ((equal? pkg ".") (displayln "... build in current directory") + (pkg-manifest! pkg) (let (build.ss (path-expand "build.ss" (current-directory))) (run-process [build.ss "compile" build-options ...] stdout-redirection: #f))) @@ -371,6 +592,7 @@ (error "Cannot build unknown package" pkg))) (build.ss (pkg-build-script pkg))) (displayln "... build " pkg) + (pkg-manifest! pkg) (run-process [build.ss "compile" build-options ...] directory: path coprocess: void @@ -378,6 +600,82 @@ (when dependents? (for-each pkg-build (pkg-dependents pkg))))))) +(def (pkg-manifest! pkg) + (let* (((values pkg _) (pkg+tag pkg)) + (plist (pkg-plist pkg)) + (deps (pgetq depend: plist [])) + (deps + (let recur ((rest deps) (result [])) + (match rest + ([dep . rest] + (let ((values dep _) (pkg+tag dep)) + ;; check for external package manager installed deps (eg NiX) + (if (file-exists? (pkg-plist-path dep)) + (let* ((plist (pkg-plist dep)) + (deps (pgetq depend: plist []))) + (recur rest (recur deps (cons dep result)))) + ;; just record the dep, we don't have the pkg contents + ;; for transitive + (recur rest (cons dep result))))) + (else + (remove-duplicates result))))) + (manifests + (let lp ((rest deps) (result [])) + (match rest + ([dep . rest] + (let (manifest + (call-with-input-file + (path-expand (string-append dep ".manifest") + (pkg-root-dir)) + read)) + (lp rest (append result manifest)))) + (else + (remove-duplicates result))))) + (gerbil-version + (cons "Gerbil" (gerbil-version-string))) + (gambit-version + (cons "Gambit" (system-version-string))) + (write-version-manifest + (lambda (manifest1 output) + (pretty-print + `(def version-manifest + (quote + ,(remove-duplicates + (cons* manifest1 gerbil-version gambit-version manifests)))) + output))) + (write-pkg-manifest + (lambda (manifest1 output) + (pretty-print + (remove-duplicates (cons* manifest1 gerbil-version gambit-version manifests)) + output)))) + + (if (equal? pkg ".") + (let* ((version + (if (file-exists? ".git") + (run-process ["git" "describe" "--tags" "--always"] + coprocess: read-line) + "unknown")) + (manifest1 + (cons (path-strip-directory + (path-normalize (current-directory))) + version))) + (call-with-output-file [path: "manifest.ss" create: 'maybe truncate: #t] + (cut write-version-manifest manifest1 <>))) + (let (pkg-path (path-expand pkg (pkg-root-dir))) + (when (file-exists? pkg-path) + (let* ((version + (run-process ["git" "describe" "--tags" "--always"] + directory: pkg-path + coprocess: read-line)) + (manifest1 + (cons pkg version))) + (call-with-output-file [path: (path-expand "manifest.ss" pkg-path) + create: 'maybe truncate: #t] + (cut write-version-manifest manifest1 <>)) + (call-with-output-file [path: (string-append pkg-path ".manifest") + create: 'maybe truncate: #t] + (cut write-pkg-manifest manifest1 <>)))))))) + (def (pkg-clean pkg) (cond ((equal? pkg "all") @@ -433,50 +731,250 @@ directory: root))) ;; package directory search -(def (pkg-search keywords) - (def (search alst) - (let lp ((rest alst) (r [])) +(def (pkg-search keywords dir as-list?) + (def (search lst) + (def (try-match kw) + (let (rx (pregexp (string-append "(?i:" kw ")"))) + (lambda (pkg desc) + (or (pregexp-match rx pkg) (pregexp-match rx desc))))) + + (def matching + (map try-match keywords)) + + (let lp ((rest lst) (result [])) (match rest - ([(and hd [pkg . desc]) . rest] - (if (andmap (lambda (kw) - (let (rx (pregexp (string-append "(?i:" kw ")"))) - (or (pregexp-match rx pkg) (pregexp-match rx desc)))) - keywords) - (lp rest (cons hd r)) - (lp rest r))) + ([hd . rest] + (match hd + ([pkg . plist] + (let (description (pgetq description: plist)) + (if (andmap (lambda (matches?) (matches? pkg description)) + matching) + (lp rest (cons (cons pkg description) result)) + (lp rest result)))) + (else + (lp rest result)))) (else - (reverse r))))) + (reverse result))))) (def (display-pkgs alst) - (for ([pkg . desc] alst) - (displayln pkg ": " desc))) - - (let (alst (pkg-directory-list)) - (if (null? keywords) - (display-pkgs alst) - (let (matches (search alst)) - (display-pkgs matches))))) - -(def +pkg-directory+ - "https://raw.githubusercontent.com/vyzo/gerbil-directory/master/README.md") - -(def (pkg-directory-list) - (let* ((txt (request-text (http-get +pkg-directory+))) - (lines (string-split txt #\newline))) - (let lp ((rest lines)) - (match rest - ([hd . rest] - (if (equal? hd "") - (let lp2 ((rest (cddr rest)) (pkgs [])) - (match rest - ([hd . rest] - (if (equal? hd "") - (reverse pkgs) - (match (string-split hd #\|) - ([_ pkg-link pkg-desc . _] - (with ([_ pkg] (pregexp-match "\\[([^]]+)\\]" pkg-link)) - (lp2 rest (cons (cons pkg (string-trim pkg-desc)) pkgs))))))))) - (lp rest))))))) + (if as-list? + (pretty-print alst) + (for ([pkg . desc] alst) + (displayln pkg ": " desc)))) + + (let (alst (if dir (pkg-directory-list dir) (pkg-directory-list-all))) + (let (matches (search alst)) + (display-pkgs matches)))) + +(def +mighty-gerbils-pkg-directory+ + "github.com/mighty-gerbils/gerbil-directory") + +(def (pkg-directory-url dir) + (cond + ((string-prefix? "https://" dir) + dir) + ((string-prefix? "github.com/" dir) + (let (repo (substring dir (string-index dir #\/) (string-length dir))) + (string-append "https://raw.githubusercontent.com" repo "/main/package-list"))) + (else + (error "bad directory" dir)))) + +(def (pkg-directory-user-dirs-path) + (path-expand "pkg/directory-list" (path-expand "~/.gerbil"))) + +(def (pkg-directory-local-dirs-path) + (path-expand "pkg/directory-list" (path-expand (getenv "GERBIL_PATH" "~/.gerbil")))) + +(def (pkg-directory-dirs) + (let* ((user-dir (pkg-directory-user-dirs-path)) + (local-dir (pkg-directory-local-dirs-path)) + (user-dirs + (if (file-exists? user-dir) + (call-with-input-file user-dir read) + []))) + (remove-duplicates + (cond + ((equal? user-dir local-dir) + user-dirs) + ((file-exists? local-dir) + (append (call-with-input-file local-dir read) + user-dirs)) + (else + user-dirs))))) + +(def (pkg-directory-user-dirs (get-path pkg-directory-user-dirs-path)) + (let (dir (get-path)) + (if (file-exists? dir) + (call-with-input-file dir read) + []))) + +(def (pkg-directory-local-dirs) + (pkg-directory-user-dirs pkg-directory-local-dirs-path)) + +(def (pkg-directory-dirs-add add-dirs local?) + (let* ((current + (if local? + (pkg-directory-local-dirs) + (pkg-directory-user-dirs))) + (new + (let lp ((rest add-dirs) (new [])) + (match rest + ([dir . rest] + (if (or (member dir current) + (member dir new)) + (lp rest new) + (lp rest (cons dir new)))) + (else + (remove-duplicates + (append current (reverse new)))))))) + (call-with-output-file + (if local? + (pkg-directory-local-dirs-path) + (pkg-directory-user-dirs-path)) + (cut write new <>)))) + +(def (pkg-directory-dirs-remove remove-dirs local?) + (let* ((current + (if local? + (pkg-directory-local-dirs) + (pkg-directory-user-dirs))) + (new + (let lp ((rest current) (new [])) + (match rest + ([dir . rest] + (if (member dir remove-dirs) + (lp rest new) + (lp rest (cons dir new)))) + (else + (reverse new)))))) + (call-with-output-file + (if local? + (pkg-directory-local-dirs-path) + (pkg-directory-user-dirs-path)) + (cut write new <>)))) + +(def (pkg-directory-urls) + (let* ((default-dirs [+mighty-gerbils-pkg-directory+]) + (other-dirs (pkg-directory-dirs)) + (all-dirs (remove-duplicates (append default-dirs other-dirs)))) + (map pkg-directory-url all-dirs))) + +(def (pkg-directory-list-all) + (remove-duplicates + (for/fold (result []) (url (pkg-directory-urls)) + (let (req (with-catch + (lambda (exn) + (displayln/err "*** WARNING error retrieving packages from " url + ": " (or (error-message exn) "(unknown error)")) + #f) + (cut http-get url redirect: #t))) + (if (and req (fx= (request-status req) 200)) + (let (pkgs (with-catch + (lambda (exn) + (displayln/err "*** WARNING error retrieving packages from " + (request-url req) + ": " (or (error-message exn) "(unknown error)")) + []) + (lambda () (call-with-input-string (request-text req) read)))) + (append result pkgs)) + (begin + (displayln/err "error retrieving packages from " url + ": " (request-status-text req)) + result)))))) + +(def (pkg-directory-list dir) + (let* ((url (pkg-directory-url dir)) + (req (http-get url redirect: #t))) + (if (fx= (request-status req) 200) + (call-with-input-string (request-text req) read) + (error "error retrieving packages" url (request-status-text req))))) + +;; package directory management +(def (pkg-directory-manage dirs add? remove? local?) + (cond + ((null? dirs) + (if (or add? remove?) + (error "no directory specified") + (let (user-dirs (pkg-directory-dirs)) + (for (dir user-dirs) + (let (url (pkg-directory-url dir)) + (if (equal? dir url) + (displayln dir) + (displayln dir " -> " url))))))) + ((and add? remove?) + (error "do you want to add or remove")) + (add? + (pkg-directory-dirs-add dirs local?)) + (remove? + (pkg-directory-dirs-remove dirs local?)) + (else + (for (dir dirs) + (pretty-print (pkg-directory-list dir)))))) + +;; package dependency management +(def (pkg-deps-manage deps add? install? update? remove?) + (let* ((plist (pkg-plist ".")) + (current-deps (pgetq depend: plist []))) + + (def (add-dep! dep) + (let ((values xpkg _) (pkg+tag dep)) + (let lp ((rest current-deps)) + (match rest + ([hd . rest] + (let ((values dpkg _) (pkg+tag hd)) + (if (equal? xpkg dpkg) + (set! (car rest) dep) + (lp rest)))) + (else + (set! current-deps (append current-deps [dep]))))))) + + (def (remove-dep! dep) + (let ((values xpkg _) (pkg+tag dep)) + (set! current-deps + (filter (lambda (hd) + (let ((values dpkg _) (pkg+tag hd)) + (not (equal? dpkg xpkg)))) + current-deps)))) + + (def (write-deps!) + (let (hd (member depend: plist)) + (if hd + (set! (car (cdr hd)) current-deps) + (set! plist (append plist [depend: current-deps])))) + (call-with-output-file (path-expand "gerbil.pkg" (current-directory)) + (cut pretty-print plist <>))) + + (if (null? deps) + (cond + (add? (error "nothing to add")) + (remove? (error "nothing to remove")) + (install? + (install-pkgs current-deps #t)) + (update? + (update-pkgs current-deps #t)) + (else + (for-each displayln current-deps))) + (cond + ((and add? remove?) + (error "cannot both add and remove")) + ((and remove? install?) + (error "cannot both remove and install")) + ((and add? update?) + (error "cannot both add and update")) + (add? + (for (dep deps) + (add-dep! dep)) + (write-deps!) + (when install? + (install-pkgs deps #t))) + (update? + (update-pkgs deps #t)) + (remove? + (for (dep deps) + (remove-dep! dep)) + (write-deps!)) + (else + (error "unspecified action; use --add, --update or --remove")))))) ;;; internal (def +pkg-plist+ @@ -484,36 +982,51 @@ (def (pkg-plist pkg) (cond + ((equal? pkg ".") + (let* ((gerbil.pkg (path-expand "gerbil.pkg" (current-directory))) + (plist (call-with-input-file gerbil.pkg read))) + (if (eof-object? plist) [] plist))) ((hash-get +pkg-plist+ pkg) => values) (else - (let* ((root (pkg-root-dir)) - (path (path-expand pkg root)) - (gerbil.pkg (path-expand "gerbil.pkg" path)) + (let* ((gerbil.pkg (pkg-plist-path pkg)) (_ (unless (file-exists? gerbil.pkg) - (error "Bad package; missing gerbil.pkg" pkg))) + (error "bad package; missing gerbil.pkg" pkg))) (plist (call-with-input-file gerbil.pkg read)) (plist (if (eof-object? plist) [] plist))) (hash-put! +pkg-plist+ pkg plist) plist)))) +(def (pkg-plist-path pkg) + (let* ((root (pkg-root-dir)) + (path (path-expand pkg root))) + (path-expand "gerbil.pkg" path))) + (def (pkg-build-script pkg) (let* ((root (pkg-root-dir)) (path (path-expand pkg root)) - (plist (pkg-plist pkg)) + (plist (pkg-plist pkg)) (build (pgetq build: plist)) (build.ss (path-expand (or build "build.ss") path))) (unless (file-exists? build.ss) - (error "Bad package; missing build script" pkg build.ss)) + (error "bad package; missing build script" pkg build.ss)) (path-normalize build.ss))) (def (pkg-dependents pkg (pkgs (pkg-list))) - (def (dependent xpkg) - (let* ((plist (pkg-plist xpkg)) - (deps (pgetq depend: plist []))) - (and (member pkg deps) - xpkg))) - (filter-map dependent pkgs)) + (let ((values pkg _) (pkg+tag pkg)) + (def (dependent xpkg) + (let* ((plist (pkg-plist xpkg)) + (deps (pgetq depend: plist []))) + (let lp ((rest deps) (dpkgs [])) + (match rest + ([hd . rest] + (let ((values dpkg _) (pkg+tag hd)) + (lp rest (cons dpkg dpkgs)))) + (else + (and (member pkg dpkgs) + (let ((values xpkg _) (pkg+tag xpkg)) + xpkg))))))) + (filter-map dependent pkgs))) (def (pkg-dependents* pkg (pkgs (pkg-list))) (let (deps (pkg-dependents pkg pkgs)) @@ -534,6 +1047,39 @@ (eq? (file-info-type (file-info path #f)) 'symbolic-link)) +(def (displayln/err . args) + (parameterize ((current-output-port (current-error-port))) + (apply displayln args))) + + +(def (remove-duplicates lst) + (def seen (make-hash-table)) + (let lp ((rest lst) (result [])) + (match rest + ([hd . rest] + (if (hash-get seen hd) + (lp rest result) + (begin + (hash-put! seen hd #t) + (lp rest (cons hd result))))) + (else + (reverse! result))))) + +(def (git-clone-url pkg) + (if (getenv "GERBIL_PKG_GIT_USER" #f) + (let* ((split-at (string-index pkg #\/)) + (base (substring pkg 0 split-at)) + (repo (substring pkg (1+ split-at) (string-length pkg)))) + (string-append "git@" base ":" repo ".git")) + (string-append "https://" pkg ".git"))) + +(def (path-normalize* path) + (let* ((path (path-normalize (current-directory))) + (last (fx1- (string-length path)))) + (if (eqv? (string-ref path last) #\/) + (substring path 0 last) + path))) + ;;; templates (def gerbil.pkg-template #<