From 2690a5bfd4f6ea969e5efa754332131c725f1426 Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 17:01:42 +0300 Subject: [PATCH 01/14] gxpkg: rework package directory search - default is the official mighty-gerbils directory - allow user specified directories to search --- src/tools/gxpkg.ss | 125 ++++++++++++++++++++++++++++++--------------- 1 file changed, 85 insertions(+), 40 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 44273ef43..3f4f810ff 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -14,6 +14,7 @@ ;;; clean pkg ... ;;; list ;;; retag +;;; search kw ... ;;; Packages: ;;; github.com/user/package -- github based packages ;;; gitlab.com/user/package -- gitlab based packages @@ -86,7 +87,9 @@ (command 'retag help: "retag installed packages")) (def search-cmd (command 'search help: "search the package directory" - (rest-arguments 'keywords help: "keywords to search for"))) + (option 'directory "-d" "--directory" + help: "A specific directory to use; by default the default directory and all user configured directories are searched") + (rest-arguments 'keywords help: "keywords to search for, as a boolean and"))) (call-with-getopt gxpkg-main args program: "gxpkg" @@ -127,7 +130,7 @@ ((retag) (retag-pkgs)) ((search) - (search-pkgs .keywords))))) + (search-pkgs .keywords .directory))))) ;;; commands (defrules fold-pkgs () @@ -193,8 +196,8 @@ (def (retag-pkgs) (pkg-retag)) -(def (search-pkgs keywords) - (pkg-search keywords)) +(def (search-pkgs keywords dir) + (pkg-search keywords dir)) ;;; action implementation -- script api (def +root-dir+ @@ -433,50 +436,88 @@ directory: root))) ;; package directory search -(def (pkg-search keywords) - (def (search alst) - (let lp ((rest alst) (r [])) +(def (pkg-search keywords dir) + (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))))) + (let (alst (if dir (pkg-directory-list dir) (pkg-directory-list-all))) + (let (matches (search alst)) + (display-pkgs matches)))) -(def +pkg-directory+ - "https://raw.githubusercontent.com/vyzo/gerbil-directory/master/README.md") +(def +mighty-gerbils-pkg-directory+ + "github.com/mighty-gerbils/gerbil-directory") -(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))))))) +(def (pkg-directory-url dir) + (cond + ((string-prefix? "github.com/" dir) + (let (base (substring dir (string-index dir #\/) (string-length dir))) + (string-append "https://raw.githubusercontent.com" base "/package-list"))) + (else + (error "unsupported directory repo" dir)))) + +(def (pkg-directory-urls) + (let* ((default-dirs [+mighty-gerbils-pkg-directory+]) + (user-dirs + (let (user-conf (path-expand "directory-list" (pkg-root-dir))) + (if (file-exists? user-conf) + (call-with-input-file user-conf read) + []))) + (all-dirs (append default-dirs user-dirs))) + (map pkg-directory-url all-dirs))) + +(def (pkg-directory-list-all) + (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))) + (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 () (read (request-text req))))) + (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))) + (if (fx= (request-status req) 200) + (read (request-text req)) + (error "error retrieving packages" url (request-status-text req))))) ;;; internal (def +pkg-plist+ @@ -491,7 +532,7 @@ (path (path-expand pkg root)) (gerbil.pkg (path-expand "gerbil.pkg" path)) (_ (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) @@ -534,6 +575,10 @@ (eq? (file-info-type (file-info path #f)) 'symbolic-link)) +(def (displayln/err . args) + (parameterize ((current-output-port (current-error-port))) + (apply displayln args))) + ;;; templates (def gerbil.pkg-template #< Date: Sat, 23 Sep 2023 17:59:41 +0300 Subject: [PATCH 02/14] improve it --- src/tools/gxpkg.ss | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 3f4f810ff..e3c41760d 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -89,6 +89,8 @@ (command 'search help: "search the package directory" (option 'directory "-d" "--directory" help: "A specific directory to use; by default the default directory and all user configured directories are searched") + (flag 'as-list "-l" "--list" + help: "Print the results as a list, do not format it") (rest-arguments 'keywords help: "keywords to search for, as a boolean and"))) (call-with-getopt gxpkg-main args @@ -130,7 +132,7 @@ ((retag) (retag-pkgs)) ((search) - (search-pkgs .keywords .directory))))) + (search-pkgs .keywords .directory .?as-list))))) ;;; commands (defrules fold-pkgs () @@ -196,8 +198,8 @@ (def (retag-pkgs) (pkg-retag)) -(def (search-pkgs keywords dir) - (pkg-search keywords dir)) +(def (search-pkgs keywords dir as-list?) + (pkg-search keywords dir as-list?)) ;;; action implementation -- script api (def +root-dir+ @@ -436,7 +438,7 @@ directory: root))) ;; package directory search -(def (pkg-search keywords dir) +(def (pkg-search keywords dir as-list?) (def (search lst) (def (try-match kw) (let (rx (pregexp (string-append "(?i:" kw ")"))) @@ -462,23 +464,24 @@ (reverse result))))) (def (display-pkgs alst) - (for ([pkg . desc] alst) - (displayln pkg ": " desc))) + (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") + "https://raw.githubusercontent.com/mighty-gerbils/gerbil-directory/master/package-list") (def (pkg-directory-url dir) (cond - ((string-prefix? "github.com/" dir) - (let (base (substring dir (string-index dir #\/) (string-length dir))) - (string-append "https://raw.githubusercontent.com" base "/package-list"))) + ((string-prefix? "https://" dir) + dir) (else - (error "unsupported directory repo" dir)))) + (string-append "https://" dir)))) (def (pkg-directory-urls) (let* ((default-dirs [+mighty-gerbils-pkg-directory+]) @@ -497,7 +500,7 @@ (displayln/err "*** WARNING error retrieving packages from " url ": " (or (error-message exn) "(unknown error)")) #f) - (cut http-get url))) + (cut http-get url redirect: #t))) (if (and req (fx= (request-status req) 200)) (let (pkgs (with-catch (lambda (exn) @@ -505,7 +508,7 @@ (request-url req) ": " (or (error-message exn) "(unknown error)")) []) - (lambda () (read (request-text req))))) + (lambda () (call-with-input-string (request-text req) read)))) (append result pkgs)) (begin (displayln/err "error retrieving packages from " url From 9f1b1834ab085b191f4db306405af7cbce2d6d45 Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 18:09:43 +0300 Subject: [PATCH 03/14] smarter handling of github directory repos --- src/tools/gxpkg.ss | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index e3c41760d..c15967895 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -474,14 +474,17 @@ (display-pkgs matches)))) (def +mighty-gerbils-pkg-directory+ - "https://raw.githubusercontent.com/mighty-gerbils/gerbil-directory/master/package-list") + "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 - (string-append "https://" dir)))) + (error "bad directory" dir)))) (def (pkg-directory-urls) (let* ((default-dirs [+mighty-gerbils-pkg-directory+]) From db44b39d77610ae4dcc999223c843936b825c373 Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 18:35:00 +0300 Subject: [PATCH 04/14] gxpkg: add user directory management command --- src/tools/gxpkg.ss | 88 +++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 79 insertions(+), 9 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index c15967895..8619ab4a7 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -93,6 +93,15 @@ 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" + (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"))) + (call-with-getopt gxpkg-main args program: "gxpkg" help: "The Gerbil Package Manager" @@ -106,7 +115,8 @@ update-cmd list-cmd retag-cmd - search-cmd)) + search-cmd + dir-cmd)) (def (gxpkg-main cmd opt) (let-hash opt @@ -132,7 +142,9 @@ ((retag) (retag-pkgs)) ((search) - (search-pkgs .keywords .directory .?as-list))))) + (search-pkgs .keywords .directory .?as-list)) + ((dir) + (manage-dirs .directories .?add .?remove))))) ;;; commands (defrules fold-pkgs () @@ -201,6 +213,9 @@ (def (search-pkgs keywords dir as-list?) (pkg-search keywords dir as-list?)) +(def (manage-dirs dirs add? remove?) + (pkg-directory-manage dirs add? remove?)) + ;;; action implementation -- script api (def +root-dir+ (getenv "GERBIL_PATH" "~/.gerbil")) @@ -486,13 +501,46 @@ (else (error "bad directory" dir)))) +(def (pkg-directory-user-dirs-path) + (path-expand "directory-list" (pkg-root-dir))) + +(def (pkg-directory-user-dirs) + (let (user-dir (pkg-directory-user-dirs-path)) + (if (file-exists? user-dir) + (call-with-input-file user-dir read) + []))) +(def (pkg-directory-user-dirs-add add-dirs) + (let* ((current (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 + (append current (reverse new))))))) + (call-with-output-file (pkg-directory-user-dirs-path) + (cut write new <>)))) + +(def (pkg-directory-user-dirs-remove remove-dirs) + (let* ((current (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 (pkg-directory-user-dirs-path) + (cut write new <>)))) + (def (pkg-directory-urls) (let* ((default-dirs [+mighty-gerbils-pkg-directory+]) - (user-dirs - (let (user-conf (path-expand "directory-list" (pkg-root-dir))) - (if (file-exists? user-conf) - (call-with-input-file user-conf read) - []))) + (user-dirs (pkg-directory-user-dirs)) (all-dirs (append default-dirs user-dirs))) (map pkg-directory-url all-dirs))) @@ -520,11 +568,33 @@ (def (pkg-directory-list dir) (let* ((url (pkg-directory-url dir)) - (req (http-get url))) + (req (http-get url redirect: #t))) (if (fx= (request-status req) 200) - (read (request-text req)) + (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?) + (cond + ((null? dirs) + (if (or add? remove?) + (error "no directory specified") + (let (user-dirs (pkg-directory-user-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-user-dirs-add dirs)) + (remove? + (pkg-directory-user-dirs-remove dirs)) + (else + (for (dir dirs) + (pretty-print (pkg-directory-list dir)))))) + ;;; internal (def +pkg-plist+ (make-hash-table)) From d66d0b1c45e2d3c27b3144962aebb6d865c15ce9 Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 19:18:35 +0300 Subject: [PATCH 05/14] gxpkg: add the ability to fetch with tags --- src/tools/gxpkg.ss | 87 +++++++++++++++++++++++++++++----------------- 1 file changed, 55 insertions(+), 32 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 8619ab4a7..de7595a26 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -5,9 +5,9 @@ ;;; Usage: ;;; gxpkg action arg .... ;;; Actions: -;;; install pkg ... +;;; install pkg[@tag] ... +;;; update pkg[@tag] ... ;;; uninstall pkg ... -;;; update pkg ... ;;; link pkg src ;;; unlink pkg ... ;;; build pkg ... @@ -45,14 +45,14 @@ (def (main . args) (def install-cmd (command 'install help: "install one or more packages" - (rest-arguments 'pkg help: "package to install"))) + (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") (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"))) + (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" (argument 'pkg help: "package to link") @@ -88,7 +88,7 @@ (def search-cmd (command 'search help: "search the package directory" (option 'directory "-d" "--directory" - help: "A specific directory to use; by default the default directory and all user configured directories are searched") + help: "A specific directory to use; by default the mighty-gerbils directory and all user configured directories are searched") (flag 'as-list "-l" "--list" help: "Print the results as a list, do not format it") (rest-arguments 'keywords help: "keywords to search for, as a boolean and"))) @@ -262,32 +262,19 @@ (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 pkg+tag)) + (tag (let (kdr (cdr pkg+tag)) + (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)) + (pkg-fetch pkg tag) + (pkg-install-deps pkg) + (pkg-build pkg))) (def (pkg-install-deps pkg) (let* ((plist (pkg-plist pkg)) @@ -323,17 +310,53 @@ (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"] + (pkg-fetch-git pkg tag) + (displayln "... pulling " pkg) + (let* ((result (run-process ["git" "pull" "-q"] directory: dest)) (update? (not (equal? result "Already up-to-date.\n")))) update?))))) +(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 (string-append "https://" pkg ".git"))) + (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)))) + (def (pkg-link pkg src) (let* ((root (pkg-root-dir)) (dest (path-expand pkg root))) From 56657016c4ddbdb29b7ee629c63abc121fc4952f Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 20:51:54 +0300 Subject: [PATCH 06/14] package versioning --- src/tools/gxpkg.ss | 144 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 123 insertions(+), 21 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index de7595a26..561367b49 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -205,7 +205,12 @@ (for-each pkg-clean pkgs))) (def (list-pkgs) - (for-each displayln (pkg-list))) + (for (pkg (pkg-list)) + (let (tag (pkg-tag-get pkg)) + (display pkg) + (when tag + (display* "@" tag)) + (newline)))) (def (retag-pkgs) (pkg-retag)) @@ -271,10 +276,21 @@ (values pkg tag))) (def (pkg-install pkg) - (let ((values pkg tag) (pkg+tag pkg)) - (pkg-fetch pkg tag) - (pkg-install-deps pkg) - (pkg-build pkg))) + (let* (((values pkg tag) (pkg+tag pkg)) + (current-tag (pkg-tag-get pkg))) + (def (install-it) + (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-preserve? current-tag tag)) + (else + (install-it))) + (install-it)))) (def (pkg-install-deps pkg) (let* ((plist (pkg-plist pkg)) @@ -315,13 +331,7 @@ (unless (file-exists? dest) (error "Cannot update uknown package" pkg)) (and (not (file-symbolic-link? dest)) - (begin - (pkg-fetch-git pkg tag) - (displayln "... pulling " pkg) - (let* ((result (run-process ["git" "pull" "-q"] - directory: dest)) - (update? (not (equal? result "Already up-to-date.\n")))) - update?))))) + (pkg-fetch-git pkg tag)))) (def (pkg-fetch pkg tag) (cond @@ -350,12 +360,92 @@ directory: path coprocess: void stdout-redirection: #f))) - (when tag + (cond + (tag (displayln "... checking out " tag) (run-process ["git" "checkout" "-q" tag] directory: dest coprocess: void - stdout-redirection: #f)))) + stdout-redirection: #f) + (call-with-output-file (pkg-tag-file pkg) + (cut write tag <>))) + ((member (pkg-tag-get pkg) '("master" "main")) + (displayln "... pulling") + (run-process ["git" "pull" "-q" tag] + directory: dest + coprocess: void + stdout-redirection: #f))))) + +(def (pkg-tag-file pkg) + (let* ((root (pkg-root-dir)) + (dest (path-expand pkg root)) + (top (path-directory dest))) + (path-expand (string-append pkg ".tag") top))) + +(def (pkg-tag-get pkg) + (let (tagf (pkg-tag-file pkg)) + (cond + ((file-exists? tagf) + (call-with-input-file tagf read)) + ((file-exists? (path-expand pkg (pkg-root-dir))) + "master") + (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-preserve? current other) + (cond + ((equal? current other) + ;; refetch if it is not semver + (pkg-tag-semver? current)) + ((not other) + ;; refetch if it is master/main + (not (member current '("master" "main")))) + ((member current '("master" "main")) + #t) + ((member other '("master" "main")) + #f) + (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) + #t) + (else #f))) + (else #t))) + (else + (null? other-rest)))))))) + +(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)) @@ -624,6 +714,10 @@ (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 @@ -631,7 +725,7 @@ (path (path-expand pkg root)) (gerbil.pkg (path-expand "gerbil.pkg" path)) (_ (unless (file-exists? gerbil.pkg) - (error "bad package; missing gerbil.pkg" pkg))) + (error "bad packagekg; missing gerbil.pkg" pkg))) (plist (call-with-input-file gerbil.pkg read)) (plist (if (eof-object? plist) [] plist))) (hash-put! +pkg-plist+ pkg plist) @@ -648,12 +742,20 @@ (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)) From 80c1d164590d9a42b91c35ee04c68e6413ed566e Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 21:50:49 +0300 Subject: [PATCH 07/14] gxpkg deps command --- src/tools/gxpkg.ss | 104 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 89 insertions(+), 15 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 561367b49..3814c8ca0 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -70,37 +70,47 @@ (command 'clean help: "clean compilation artefacts from one or more packages" (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" + 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)))))) (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 'remove "-r" "--remove" + help: "remove dependencies") + (rest-arguments 'deps + help: "the list of dependencies to add or remove"))) (def list-cmd (command 'list help: "list installed packages")) (def retag-cmd (command 'retag help: "retag installed packages")) (def search-cmd (command 'search help: "search the package directory" - (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 "-l" "--list" - help: "Print the results as a list, do not format it") - (rest-arguments 'keywords help: "keywords to search for, as a boolean and"))) + (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 "-l" "--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" - (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"))) + (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"))) (call-with-getopt gxpkg-main args program: "gxpkg" @@ -108,6 +118,7 @@ new-cmd build-cmd clean-cmd + deps-cmd link-cmd unlink-cmd install-cmd @@ -127,6 +138,8 @@ (build-pkgs .pkg .?build-release .?build-optimized)) ((clean) (clean-pkgs .pkg)) + ((deps) + (manage-deps .deps .?add .?install .?remove)) ((link) (link-pkg .pkg .src)) ((unlink) @@ -221,6 +234,9 @@ (def (manage-dirs dirs add? remove?) (pkg-directory-manage dirs add? remove?)) +(def (manage-deps deps add? install? remove?) + (pkg-deps-manage deps add? install? remove?)) + ;;; action implementation -- script api (def +root-dir+ (getenv "GERBIL_PATH" "~/.gerbil")) @@ -708,6 +724,64 @@ (for (dir dirs) (pretty-print (pkg-directory-list dir)))))) +;; package depnendency management +(def (pkg-deps-manage deps add? install? 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 write plist <>))) + + (if (null? deps) + (cond + (add? (error "nothing to add")) + (remove? (error "nothing to remove")) + (install? + (install-pkgs current-deps)) + (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")) + (add? + (for (dep deps) + (add-dep! dep)) + (write-deps!) + (when install? + (install-pkgs deps))) + (remove? + (for (dep deps) + (remove-dep! dep))) + (else + (error "unspecified action; use --add or --remove")))))) + ;;; internal (def +pkg-plist+ (make-hash-table)) From 9578bca12081c06b0ad3279341015e78ebaa9036 Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 22:14:59 +0300 Subject: [PATCH 08/14] improv --- src/tools/gxpkg.ss | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 3814c8ca0..8c8d59d3e 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -294,7 +294,7 @@ (def (pkg-install pkg) (let* (((values pkg tag) (pkg+tag pkg)) (current-tag (pkg-tag-get pkg))) - (def (install-it) + (def (install-it tag) (pkg-fetch pkg tag) (pkg-install-deps pkg) (pkg-build pkg)) @@ -303,10 +303,11 @@ (cond ((pkg-tag-incompatible? current-tag tag) (error "Package already installed with an incompatible tag" pkg tag current-tag)) - ((pkg-tag-preserve? current-tag tag)) + ((pkg-tag-choose current-tag tag) + => install-it) (else - (install-it))) - (install-it)))) + (install-it tag))) + (install-it tag)))) (def (pkg-install-deps pkg) (let* ((plist (pkg-plist pkg)) @@ -327,6 +328,9 @@ (displayln "... uninstall " pkg) (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) @@ -399,12 +403,14 @@ (path-expand (string-append pkg ".tag") top))) (def (pkg-tag-get pkg) - (let (tagf (pkg-tag-file 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? (path-expand pkg (pkg-root-dir))) - "master") + ((file-exists? top) + (run-process ["git" "branch" "--show-current"] + directory: top)) (else #f)))) (def (pkg-tag-incompatible? current other) @@ -421,18 +427,16 @@ ;; 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-preserve? current other) +(def (pkg-tag-choose current other) (cond ((equal? current other) - ;; refetch if it is not semver - (pkg-tag-semver? current)) + current) ((not other) - ;; refetch if it is master/main - (not (member current '("master" "main")))) + current) ((member current '("master" "main")) - #t) + current) ((member other '("master" "main")) - #f) + other) (else (let ((current-version (pkg-tag-semver current)) (other-version (pkg-tag-semver other))) @@ -446,11 +450,10 @@ ((= current-hd other-hd) (lp current-rest other-rest)) ((> current-hd other-hd) - #t) - (else #f))) - (else #t))) - (else - (null? other-rest)))))))) + current) + (else other))) + (else current))) + (else other))))))) (def +rx-semver+ (pregexp "v(\\d+\\.)*\\d+")) From 8fee4c7c72cec2fe2835314241fd9b64f75a9551 Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 22:31:31 +0300 Subject: [PATCH 09/14] improv --- src/tools/gxpkg.ss | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 8c8d59d3e..9c984c184 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -380,8 +380,7 @@ directory: path coprocess: void stdout-redirection: #f))) - (cond - (tag + (when tag (displayln "... checking out " tag) (run-process ["git" "checkout" "-q" tag] directory: dest @@ -389,12 +388,12 @@ stdout-redirection: #f) (call-with-output-file (pkg-tag-file pkg) (cut write tag <>))) - ((member (pkg-tag-get pkg) '("master" "main")) + (when (not (pkg-tag-semver? (pkg-tag-get pkg))) (displayln "... pulling") (run-process ["git" "pull" "-q" tag] directory: dest coprocess: void - stdout-redirection: #f))))) + stdout-redirection: #f)))) (def (pkg-tag-file pkg) (let* ((root (pkg-root-dir)) From 91bdf3ccbe83c43d5e264a407f061c7ff1b3a42c Mon Sep 17 00:00:00 2001 From: vyzo Date: Sat, 23 Sep 2023 22:47:06 +0300 Subject: [PATCH 10/14] fix bugz --- src/tools/gxpkg.ss | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 9c984c184..912e78d46 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -284,11 +284,11 @@ (pkg-link maybe-link (current-directory)))) (def (pkg+tag pkg) - (let ((pt (string-split pkg #\@)) - (pkg (car pkg+tag)) - (tag (let (kdr (cdr pkg+tag)) - (and (not (null? kdr)) - (car kdr))))) + (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 pkg) @@ -388,18 +388,18 @@ stdout-redirection: #f) (call-with-output-file (pkg-tag-file pkg) (cut write tag <>))) - (when (not (pkg-tag-semver? (pkg-tag-get pkg))) - (displayln "... pulling") - (run-process ["git" "pull" "-q" tag] - directory: dest - coprocess: void - stdout-redirection: #f)))) + (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)) - (top (path-directory dest))) - (path-expand (string-append pkg ".tag") top))) + (dest (path-expand pkg root))) + (string-append dest ".tag"))) (def (pkg-tag-get pkg) (let ((tagf (pkg-tag-file pkg)) @@ -409,7 +409,8 @@ (call-with-input-file tagf read)) ((file-exists? top) (run-process ["git" "branch" "--show-current"] - directory: top)) + directory: top + coprocess: read-line)) (else #f)))) (def (pkg-tag-incompatible? current other) @@ -729,7 +730,7 @@ ;; package depnendency management (def (pkg-deps-manage deps add? install? remove?) (let* ((plist (pkg-plist ".")) - (current-deps (pgetq depend: plist))) + (current-deps (pgetq depend: plist []))) (def (add-dep! dep) (let ((values xpkg _) (pkg+tag dep)) @@ -780,7 +781,8 @@ (install-pkgs deps))) (remove? (for (dep deps) - (remove-dep! dep))) + (remove-dep! dep)) + (write-deps!)) (else (error "unspecified action; use --add or --remove")))))) From 14c6a3d1b74290b5f205f9203ec293de9b045224 Mon Sep 17 00:00:00 2001 From: vyzo Date: Sun, 24 Sep 2023 00:35:26 +0300 Subject: [PATCH 11/14] use pretty print for the plist --- src/tools/gxpkg.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 912e78d46..0373b54bf 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -758,7 +758,7 @@ (set! (car (cdr hd)) current-deps) (set! plist (append plist [depend: current-deps])))) (call-with-output-file (path-expand "gerbil.pkg" (current-directory)) - (cut write plist <>))) + (cut pretty-print plist <>))) (if (null? deps) (cond From 5addc4ca9d403f4196a1eb18252798c6005fef8f Mon Sep 17 00:00:00 2001 From: vyzo Date: Sun, 24 Sep 2023 18:18:01 +0300 Subject: [PATCH 12/14] Build Isolation and Manifests (#918) This addresses the global-vs-local state madness with .gerbil: When we are in local package context, we create a new local .gerbil to use for the build, which gives us isolation. We also create manifests for all the individual packages, so that we can get meaningful error reports. On top of #916. See also #651 --- doc/guide/env-vars.md | 7 + doc/guide/getting-started.md | 180 ++++++++---- doc/guide/package-manager.md | 84 ++++-- doc/reference/dev/bach.md | 253 +++++++++++++++- doc/reference/dev/build.md | 506 +++++++++++++++++++++++++++++++- doc/reference/dev/optimizing.md | 2 +- src/gerbil/main.ss | 5 +- src/tools/gxpkg.ss | 441 +++++++++++++++++++++------- 8 files changed, 1267 insertions(+), 211 deletions(-) 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 0373b54bf..64aa847be 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -22,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 @@ -31,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 @@ -43,31 +44,42 @@ 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" + 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; use @tag to checkout a specific tag; 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" @@ -76,9 +88,7 @@ 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)))))) + default: (path-strip-directory (path-normalize* (current-directory)))) (option 'link "-l" "--link" help: "link this package with a public package name; for example: github.com/your-user/your-package"))) (def deps-cmd @@ -87,24 +97,32 @@ 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 or remove"))) + 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" + 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 "-l" "--list" + (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" @@ -112,6 +130,11 @@ (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" help: "The Gerbil Package Manager" @@ -127,7 +150,8 @@ list-cmd retag-cmd search-cmd - dir-cmd)) + dir-cmd + env-cmd)) (def (gxpkg-main cmd opt) (let-hash opt @@ -135,31 +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 .?remove)) + (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 .directory .?as-list)) ((dir) - (manage-dirs .directories .?add .?remove))))) + (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)) @@ -176,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 @@ -195,29 +234,43 @@ (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) +(def (list-pkgs local?) + (when local? + (set-local-env!)) (for (pkg (pkg-list)) (let (tag (pkg-tag-get pkg)) (display pkg) @@ -225,42 +278,57 @@ (display* "@" tag)) (newline)))) -(def (retag-pkgs) +(def (retag-pkgs local?) + (when local? + (set-local-env!)) (pkg-retag)) (def (search-pkgs keywords dir as-list?) (pkg-search keywords dir as-list?)) -(def (manage-dirs dirs add? remove?) - (pkg-directory-manage dirs add? remove?)) +(def (manage-dirs dirs add? remove? local?) + (pkg-directory-manage dirs add? remove? local?)) -(def (manage-deps deps add? install? remove?) - (pkg-deps-manage deps add? install? remove?)) +(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) @@ -326,7 +394,7 @@ (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) @@ -373,7 +441,7 @@ coprocess: void stdout-redirection: #f)) (let ((path (path-directory dest)) - (clone-url (string-append "https://" pkg ".git"))) + (clone-url (git-clone-url pkg))) (displayln "... cloning " pkg) (create-directory* path) (run-process ["git" "clone" "-q" clone-url] @@ -513,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))) @@ -523,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 @@ -530,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") @@ -634,15 +780,42 @@ (error "bad directory" dir)))) (def (pkg-directory-user-dirs-path) - (path-expand "directory-list" (pkg-root-dir))) - -(def (pkg-directory-user-dirs) - (let (user-dir (pkg-directory-user-dirs-path)) - (if (file-exists? user-dir) - (call-with-input-file user-dir read) + (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-user-dirs-add add-dirs) - (let* ((current (pkg-directory-user-dirs)) + +(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 @@ -652,12 +825,19 @@ (lp rest new) (lp rest (cons dir new)))) (else - (append current (reverse new))))))) - (call-with-output-file (pkg-directory-user-dirs-path) + (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-user-dirs-remove remove-dirs) - (let* ((current (pkg-directory-user-dirs)) +(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 @@ -667,36 +847,40 @@ (lp rest (cons dir new)))) (else (reverse new)))))) - (call-with-output-file (pkg-directory-user-dirs-path) + (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+]) - (user-dirs (pkg-directory-user-dirs)) - (all-dirs (append default-dirs user-dirs))) + (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) - (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))))) + (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)) @@ -706,12 +890,12 @@ (error "error retrieving packages" url (request-status-text req))))) ;; package directory management -(def (pkg-directory-manage dirs add? remove?) +(def (pkg-directory-manage dirs add? remove? local?) (cond ((null? dirs) (if (or add? remove?) (error "no directory specified") - (let (user-dirs (pkg-directory-user-dirs)) + (let (user-dirs (pkg-directory-dirs)) (for (dir user-dirs) (let (url (pkg-directory-url dir)) (if (equal? dir url) @@ -720,15 +904,15 @@ ((and add? remove?) (error "do you want to add or remove")) (add? - (pkg-directory-user-dirs-add dirs)) + (pkg-directory-dirs-add dirs local?)) (remove? - (pkg-directory-user-dirs-remove dirs)) + (pkg-directory-dirs-remove dirs local?)) (else (for (dir dirs) (pretty-print (pkg-directory-list dir)))))) ;; package depnendency management -(def (pkg-deps-manage deps add? install? remove?) +(def (pkg-deps-manage deps add? install? update? remove?) (let* ((plist (pkg-plist ".")) (current-deps (pgetq depend: plist []))) @@ -765,7 +949,9 @@ (add? (error "nothing to add")) (remove? (error "nothing to remove")) (install? - (install-pkgs current-deps)) + (install-pkgs current-deps #t)) + (update? + (update-pkgs current-deps #t)) (else (for-each displayln current-deps))) (cond @@ -773,18 +959,22 @@ (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))) + (install-pkgs deps #t))) + (update? + (update-pkgs deps #t)) (remove? (for (dep deps) (remove-dep! dep)) (write-deps!)) (else - (error "unspecified action; use --add or --remove")))))) + (error "unspecified action; use --add, --update or --remove")))))) ;;; internal (def +pkg-plist+ @@ -799,20 +989,23 @@ ((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 packagekg; 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) @@ -858,6 +1051,35 @@ (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 #< Date: Sun, 24 Sep 2023 18:19:55 +0300 Subject: [PATCH 13/14] fix typos --- src/tools/gxpkg.ss | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 64aa847be..880b489b4 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -911,7 +911,7 @@ (for (dir dirs) (pretty-print (pkg-directory-list dir)))))) -;; package depnendency management +;; package dependency management (def (pkg-deps-manage deps add? install? update? remove?) (let* ((plist (pkg-plist ".")) (current-deps (pgetq depend: plist []))) @@ -1009,7 +1009,7 @@ (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))) From fd8a7b539371b057e34ff6c59bc65a503f66686f Mon Sep 17 00:00:00 2001 From: vyzo Date: Sun, 24 Sep 2023 18:58:44 +0300 Subject: [PATCH 14/14] use gerbil clean to clean in the Maskefile template --- src/tools/gxpkg.ss | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss index 880b489b4..d84b764f5 100644 --- a/src/tools/gxpkg.ss +++ b/src/tools/gxpkg.ss @@ -1143,7 +1143,7 @@ default: linux-static build-release: /opt/gerbil/bin/gxpkg link ${name} /src || true - /opt/gerbil/bin/gxpkg deps --install + /opt/gerbil/bin/gxpkg deps -i /opt/gerbil/bin/gxpkg build --release ${name} linux-static: clean @@ -1158,7 +1158,8 @@ install: mv .gerbil/bin/${name} /usr/local/bin/${name} clean: - rm -rf .gerbil + gerbil clean + gerbil clean all END )