diff --git a/modules/fruix/packages/freebsd.scm b/modules/fruix/packages/freebsd.scm index e54c9dc..083af17 100644 --- a/modules/fruix/packages/freebsd.scm +++ b/modules/fruix/packages/freebsd.scm @@ -58,6 +58,10 @@ freebsd-ripgrep freebsd-tmux freebsd-neovim + %freebsd-all-packages + all-freebsd-packages + find-freebsd-package + search-freebsd-packages freebsd-native-kernel freebsd-native-world freebsd-native-runtime @@ -978,3 +982,41 @@ FreeBSD base input." (define %freebsd-core-packages %freebsd-host-staged-core-packages) (define %freebsd-development-profile-packages %freebsd-host-staged-development-profile-packages) (define %freebsd-system-packages %freebsd-host-staged-system-packages) + +(define (freebsd-package-name&2; exit 1; }\n" + " shift 1\n" + " package_command \"$@\"\n" + " ;;\n" " --help|-h|'')\n" " usage\n" " ;;\n" diff --git a/scripts/fruix.scm b/scripts/fruix.scm index 8a6d017..bd91aa3 100644 --- a/scripts/fruix.scm +++ b/scripts/fruix.scm @@ -3,11 +3,13 @@ (use-modules (fruix installer) (fruix system freebsd) + (fruix system freebsd build) (fruix system storage) (fruix system freebsd utils) (fruix packages freebsd) (ice-9 format) (ice-9 match) + (ice-9 hash-table) (srfi srfi-1) (srfi srfi-13) (rnrs io ports)) @@ -18,6 +20,7 @@ \n\ Commands:\n\ system ACTION ... Build or materialize Fruix system artifacts.\n\ + package ACTION ... Inspect or materialize Fruix packages.\n\ source ACTION ... Fetch or snapshot declarative FreeBSD source inputs.\n\ native-build ACTION ... Promote native build results into Fruix store objects.\n\ \n\ @@ -47,6 +50,15 @@ System options:\n\ --identity FILE SSH identity file for 'deploy'.\n\ --reboot Reboot the remote node after 'deploy'.\n\ \n\ +Package actions:\n\ + list List known Fruix packages.\n\ + search QUERY Search known Fruix packages by name or text.\n\ + show NAME Show metadata for one Fruix package.\n\ + build NAME Materialize one Fruix package in /frx/store.\n\ +\n\ +Package options:\n\ + --store DIR Store directory to use for 'build' (default: /frx/store).\n\ +\n\ Source actions:\n\ materialize Materialize a declared FreeBSD source tree in /frx/store.\n\ \n\ @@ -274,6 +286,28 @@ Common options:\n\ ((arg . tail) (loop tail (cons arg positional) source-name store-dir cache-dir))))) +(define (parse-package-arguments action rest) + (let loop ((args rest) + (positional '()) + (store-dir "/frx/store")) + (match args + (() + (let ((positional (reverse positional))) + `((command . "package") + (action . ,action) + (positional . ,positional) + (store-dir . ,store-dir)))) + (("--help") + (usage 0)) + (((? (lambda (arg) (string-prefix? "--store=" arg)) arg) . tail) + (loop tail positional (option-value arg "--store="))) + (("--store" value . tail) + (loop tail positional value)) + (((? (lambda (arg) (string-prefix? "--" arg)) arg) . _) + (error "unknown option" arg)) + ((arg . tail) + (loop tail (cons arg positional) store-dir))))) + (define (parse-native-build-arguments action rest) (let loop ((args rest) (positional '()) @@ -306,12 +340,16 @@ Common options:\n\ (usage 0)) ((_ "system" "--help") (usage 0)) + ((_ "package" "--help") + (usage 0)) ((_ "source" "--help") (usage 0)) ((_ "native-build" "--help") (usage 0)) ((_ "system" action . rest) (parse-system-arguments action rest)) + ((_ "package" action . rest) + (parse-package-arguments action rest)) ((_ "source" action . rest) (parse-source-arguments action rest)) ((_ "native-build" action . rest) @@ -674,6 +712,48 @@ Common options:\n\ (headers_store . ,(assoc-ref result 'headers-store)) (bootloader_store . ,(assoc-ref result 'bootloader-store))))) +(define (package-summary-line package) + (string-append (freebsd-package-name package) + "\t" + (freebsd-package-version package) + "\t" + (symbol->string (freebsd-package-build-system package)) + "\t" + (freebsd-package-synopsis package))) + +(define (emit-package-show-metadata package) + (emit-metadata + `((action . "package-show") + (package_name . ,(freebsd-package-name package)) + (package_version . ,(freebsd-package-version package)) + (build_system . ,(freebsd-package-build-system package)) + (input_count . ,(length (freebsd-package-inputs package))) + (inputs . ,(string-join (map freebsd-package-name + (freebsd-package-inputs package)) + ",")) + (home_page . ,(freebsd-package-home-page package)) + (synopsis . ,(freebsd-package-synopsis package)) + (description . ,(freebsd-package-description package)) + (license . ,(freebsd-package-license package)) + (install_target_count . ,(length (freebsd-package-install-plan package))) + (install_targets + . ,(string-join (map (lambda (entry) + (match entry + ((_ _ target) target))) + (freebsd-package-install-plan package)) + ","))))) + +(define (emit-package-build-metadata store-dir package store-path) + (emit-metadata + `((action . "package-build") + (store_dir . ,store-dir) + (package_name . ,(freebsd-package-name package)) + (package_version . ,(freebsd-package-version package)) + (build_system . ,(freebsd-package-build-system package)) + (store_path . ,store-path) + (references_file . ,(string-append store-path "/.references")) + (package_metadata_file . ,(string-append store-path "/.fruix-package"))))) + (define (shell-quote text) (string-append "'" (string-replace-all text "'" "'\"'\"'") "'")) @@ -1072,6 +1152,43 @@ Common options:\n\ #:declaration-system-symbol resolved-symbol #:root-size root-size #:disk-capacity disk-capacity)))))))))))) + ((string=? command "package") + (let* ((positional (assoc-ref parsed 'positional)) + (name-or-query (match positional + ((value . _) value) + (() #f)))) + (unless (member action '("list" "search" "show" "build")) + (error "unknown package action" action)) + (cond + ((string=? action "list") + (for-each (lambda (package) + (format #t "~a~%" (package-summary-line package))) + (all-freebsd-packages))) + ((string=? action "search") + (unless name-or-query + (error "package search requires QUERY")) + (for-each (lambda (package) + (format #t "~a~%" (package-summary-line package))) + (search-freebsd-packages name-or-query))) + ((string=? action "show") + (unless name-or-query + (error "package show requires NAME")) + (let ((package (find-freebsd-package name-or-query))) + (unless package + (error "unknown package" name-or-query)) + (emit-package-show-metadata package))) + ((string=? action "build") + (unless name-or-query + (error "package build requires NAME")) + (let ((package (find-freebsd-package name-or-query))) + (unless package + (error "unknown package" name-or-query)) + (emit-package-build-metadata + store-dir package + (materialize-freebsd-package package + store-dir + (make-hash-table) + (make-hash-table)))))))) ((string=? command "source") (let* ((positional (assoc-ref parsed 'positional)) (cache-dir (assoc-ref parsed 'cache-dir)) diff --git a/tests/package-cli.scm b/tests/package-cli.scm new file mode 100644 index 0000000..a0eac02 --- /dev/null +++ b/tests/package-cli.scm @@ -0,0 +1,102 @@ +(use-modules (ice-9 match) + (srfi srfi-1) + (srfi srfi-13) + (srfi srfi-64) + (fruix packages freebsd) + (fruix system freebsd utils)) + +(define repo-root + (or (getenv "FRUIX_REPO_ROOT") + (error "FRUIX_REPO_ROOT is not set"))) + +(define guile-bin + (or (getenv "GUILE_BIN") + (error "GUILE_BIN is not set"))) + +(define fruix-script + (string-append repo-root "/scripts/fruix.scm")) + +(define (cli-output . args) + (apply command-output guile-bin + (append '("--no-auto-compile" "-s") + (list fruix-script) + args))) + +(define (output-lines text) + (filter (lambda (line) (not (string-null? line))) + (string-split text #\newline))) + +(define (summary-line-name line) + (car (string-split line #\tab))) + +(define (metadata-value text key) + (let ((prefix (string-append key "="))) + (let loop ((lines (output-lines text))) + (match lines + (() #f) + ((line . rest) + (if (string-prefix? prefix line) + (substring line (string-length prefix)) + (loop rest))))))) + +(test-begin "package-cli") + +(test-assert "find-freebsd-package locates nodejs" + (let ((package (find-freebsd-package "freebsd-nodejs"))) + (and package + (string=? (freebsd-package-version package) "24.14.0_2")))) + +(test-assert "search-freebsd-packages finds nodejs by name" + (member "freebsd-nodejs" + (map freebsd-package-name + (search-freebsd-packages "node")))) + +(test-assert "search-freebsd-packages finds npm by text" + (member "freebsd-npm" + (map freebsd-package-name + (search-freebsd-packages "node")))) + +(let ((list-output (cli-output "package" "list"))) + (test-assert "package list prints nodejs" + (member "freebsd-nodejs" + (map summary-line-name (output-lines list-output)))) + (test-assert "package list prints neovim" + (member "freebsd-neovim" + (map summary-line-name (output-lines list-output))))) + +(let ((search-output (cli-output "package" "search" "node"))) + (test-assert "package search prints nodejs" + (member "freebsd-nodejs" + (map summary-line-name (output-lines search-output)))) + (test-assert "package search prints npm" + (member "freebsd-npm" + (map summary-line-name (output-lines search-output))))) + +(let ((show-output (cli-output "package" "show" "freebsd-nodejs"))) + (test-equal "package show reports name" + "freebsd-nodejs" + (metadata-value show-output "package_name")) + (test-equal "package show reports version" + "24.14.0_2" + (metadata-value show-output "package_version")) + (test-equal "package show reports build system" + "copy-build-system" + (metadata-value show-output "build_system")) + (test-assert "package show reports node binary target" + (string-contains (metadata-value show-output "install_targets") "bin/node"))) + +(let* ((store-dir (mktemp-directory "/tmp/fruix-package-cli-store.XXXXXX")) + (build-output (cli-output "package" "build" "freebsd-ripgrep" "--store" store-dir)) + (store-path (metadata-value build-output "store_path"))) + (test-equal "package build reports action" + "package-build" + (metadata-value build-output "action")) + (test-equal "package build reports package name" + "freebsd-ripgrep" + (metadata-value build-output "package_name")) + (test-assert "package build creates store path" + (file-exists? store-path)) + (test-assert "package build stages rg binary" + (file-exists? (string-append store-path "/bin/rg")))) + +(test-end "package-cli") diff --git a/tests/run-package-cli.sh b/tests/run-package-cli.sh new file mode 100755 index 0000000..48af039 --- /dev/null +++ b/tests/run-package-cli.sh @@ -0,0 +1,17 @@ +#!/bin/sh +set -eu + +repo_root=$(CDPATH= cd -- "$(dirname "$0")/.." && pwd) +. "$HOME/.local/opt/fruix-builder/env.sh" + +guile_version=$($GUILE_BIN -c '(display (effective-version))') +guile_load_path="$repo_root/modules:$GUIX_SOURCE_DIR:$HOME/.local/opt/fruix-builder/shepherd/share/guile/site/$guile_version${GUILE_LOAD_PATH:+:$GUILE_LOAD_PATH}" +guile_load_compiled_path="$HOME/.local/opt/fruix-builder/shepherd/lib/guile/$guile_version/site-ccache${GUILE_LOAD_COMPILED_PATH:+:$GUILE_LOAD_COMPILED_PATH}" + +env \ + FRUIX_REPO_ROOT="$repo_root" \ + GUILE_BIN="$GUILE_BIN" \ + GUILE_AUTO_COMPILE=0 \ + GUILE_LOAD_PATH="$guile_load_path" \ + GUILE_LOAD_COMPILED_PATH="$guile_load_compiled_path" \ + "$GUILE_BIN" --no-auto-compile "$repo_root/tests/package-cli.scm"