From 21e4817c9a7ec8dbf8da1565f14430cc7bc827cd Mon Sep 17 00:00:00 2001 From: Jen-Chieh Shen Date: Wed, 16 Oct 2024 00:33:14 +0800 Subject: [PATCH] org --- cmds/core/build.lisp | 19 ++------------- cmds/core/install.lisp | 32 ++++++++++++++++++++++++ cmds/core/list.lisp | 4 +-- cmds/qob.lisp | 1 + lisp/_prepare.lisp | 43 +++++++++++++++++++++++++++++++++ lisp/core/build.lisp | 26 ++++++++++++++++++++ lisp/core/install.lisp | 17 +++++++++++++ lisp/core/list.lisp | 12 +++++++++ qob.asd | 1 + scripts/build.lisp | 17 +++++++------ src/el-lib.lisp | 52 ++++++++------------------------------- src/main.lisp | 8 ++++++ src/utils.lisp | 55 +++++++++--------------------------------- 13 files changed, 173 insertions(+), 114 deletions(-) create mode 100644 cmds/core/install.lisp create mode 100644 lisp/_prepare.lisp create mode 100644 lisp/core/build.lisp create mode 100644 lisp/core/install.lisp create mode 100644 lisp/core/list.lisp diff --git a/cmds/core/build.lisp b/cmds/core/build.lisp index 60986cd..a819e13 100644 --- a/cmds/core/build.lisp +++ b/cmds/core/build.lisp @@ -2,15 +2,7 @@ ;;; Commentary ;; -;; Command use to build the executable -;; -;; $ qob build -;; -;; -;; Optional arguments: -;; -;; --name, -n path to the ASD file -;; --output, -o output directory +;; The `build' command definition. ;; ;;; Code @@ -40,14 +32,7 @@ (defun handler (cmd) "Handler for `build' command." - (let* ((name (clingon:getopt cmd :name)) - (output (clingon:getopt cmd :output))) - ;; Delete if exists to prevent errors. - (when (uiop:file-exists-p output) - (delete-file output)) - ;; TODO: Change build path. - (qob:setup) - (asdf:operate :build-op name))) + (qob:call-lisp "core/build")) (defun command () "Build command." diff --git a/cmds/core/install.lisp b/cmds/core/install.lisp new file mode 100644 index 0000000..1a17b24 --- /dev/null +++ b/cmds/core/install.lisp @@ -0,0 +1,32 @@ +;;;; cmds/core/install.lisp --- Build executable + +;;; Commentary +;; +;; The `install' command definition. +;; + +;;; Code + +(defpackage qob/install + (:use cl) + (:export command)) + +(in-package :qob/install) + +(defun options () + "Options for `install' command." + (list )) + +(defun handler (cmd) + "Handler for `list' command." + (declare (ignore cmd)) + (qob:call-lisp "core/install")) + +(defun command () + "List command." + (clingon:make-command + :name "install" + :description "Install packages" + :usage "[names..]" + :options (options) + :handler #'handler)) diff --git a/cmds/core/list.lisp b/cmds/core/list.lisp index ad4e945..9c7ab29 100644 --- a/cmds/core/list.lisp +++ b/cmds/core/list.lisp @@ -2,9 +2,7 @@ ;;; Commentary ;; -;; Command use to list the registered system -;; -;; $ qob list +;; The `list' command definition. ;; ;;; Code diff --git a/cmds/qob.lisp b/cmds/qob.lisp index 3ead0ea..0ff3756 100644 --- a/cmds/qob.lisp +++ b/cmds/qob.lisp @@ -23,4 +23,5 @@ :license "MIT" :handler #'handler :sub-commands `(,(qob/build:command) + ,(qob/install:command) ,(qob/list:command)))) diff --git a/lisp/_prepare.lisp b/lisp/_prepare.lisp new file mode 100644 index 0000000..64738aa --- /dev/null +++ b/lisp/_prepare.lisp @@ -0,0 +1,43 @@ +;;; _prepare.el --- Prepare for command tasks +;;; Commentary: Prepare to setup Qob environment for sandboxing +;;; Code: + +(format t "Preparing...") + +(defmacro qob-start (&rest body) + "Execute BODY with workspace setup." + (declare (indent 0) (debug t))) + +(defun setup () + "Setup the system." + (let ((files (asd-files t))) + (mapc (lambda (file) + (load-system file) + (-info "Load ASD file ~A" file)) + files))) + +(defun load-system (filename) + "Load the system from ASD's FILENAME; and return the registered name." + (let ((dir (uiop:pathname-parent-directory-pathname filename)) + (file (pathname-name filename))) + (push dir asdf:*central-registry*) + (asdf:load-system file) + file)) ; registered name + +(defun find-system (name) + "Return a system of given NAME." + (asdf/system-registry:registered-system name)) + +(defun asd-files (&optional with-test) + "Return a list of ASD files. + +If optional argument WITH-TEST is non-nil; include test ASD files as well." + (uiop:if-let ((files (directory "*.asd")) + (_ (not with-test)) + (tests (asd-test-files))) + (remove-if (lambda (filename) (el-lib:el-memq filename tests)) files) + files)) + +(defun asd-test-files () + "Return a list of ASD test files." + (directory "*-test*.asd")) diff --git a/lisp/core/build.lisp b/lisp/core/build.lisp new file mode 100644 index 0000000..d53eba6 --- /dev/null +++ b/lisp/core/build.lisp @@ -0,0 +1,26 @@ +;;;; lisp/core/build.lisp --- Build executable + +;;; Commentary +;; +;; Command use to build the executable +;; +;; $ qob build +;; +;; +;; Optional arguments: +;; +;; --name, -n path to the ASD file +;; --output, -o output directory +;; + +;;; Code + +(qob-start + (let* ((name (clingon:getopt cmd :name)) + (output (clingon:getopt cmd :output))) + ;; Delete if exists to prevent errors. + (when (uiop:file-exists-p output) + (delete-file output)) + ;; TODO: Change build path. + (qob:setup) + (asdf:operate :build-op name))) diff --git a/lisp/core/install.lisp b/lisp/core/install.lisp new file mode 100644 index 0000000..2af83df --- /dev/null +++ b/lisp/core/install.lisp @@ -0,0 +1,17 @@ +;;;; lisp/core/install.lisp --- Build executable + +;;; Commentary +;; +;; Command use to install packages, +;; +;; $ qob install [names..] +;; +;; +;; Optional arguments: +;; +;; [names..] name of the package(s) to install +;; + +;;; Code + +(format t "Installlllll") diff --git a/lisp/core/list.lisp b/lisp/core/list.lisp new file mode 100644 index 0000000..62130ea --- /dev/null +++ b/lisp/core/list.lisp @@ -0,0 +1,12 @@ +;;;; lisp/core/list.lisp --- Build executable + +;;; Commentary +;; +;; Command use to list the registered system +;; +;; $ qob list +;; + +;;; Code + +(format t "Listing...") diff --git a/qob.asd b/qob.asd index 95bb09c..5e304fd 100644 --- a/qob.asd +++ b/qob.asd @@ -12,6 +12,7 @@ (:file "src/utils") ;; Commands (:file "cmds/core/build") + (:file "cmds/core/install") (:file "cmds/core/list") (:file "cmds/qob") ;; Program diff --git a/scripts/build.lisp b/scripts/build.lisp index b0c72e3..4838e5f 100644 --- a/scripts/build.lisp +++ b/scripts/build.lisp @@ -11,23 +11,24 @@ (push '*default-pathname-defaults* asdf:*central-registry*) (asdf:load-system "qob") +(asdf:load-system "copy-directory") ;;(ql:quickload "cl-autorepo") ;;(ql:quickload "clingon") +;;(ql:quickload "copy-directory") -;;(load "./src/build.lisp") -;;(load "./src/main.lisp") - -;;(setq uiop:*image-entry-point* #'qob:main) - -;;(uiop:dump-image "./bin/qob.exe" :executable t) - -(el-lib:el-copy-directory "lisp/" "bin/lisp/") +;;; Copy lisp directory +(progn + (el-lib:el-delete-directory "bin/lisp/") + (copy-directory:copy (el-lib:el-expand-fn "lisp/") + (el-lib:el-expand-fn "bin/lisp/"))) +;; Delete executable (let ((exec (el-lib:el-expand-fn (if (uiop:os-windows-p) "bin/qob.exe" "bin/qob")))) (when (uiop:file-exists-p exec) (delete-file exec))) +;; Build executable (asdf:operate :build-op "qob") diff --git a/src/el-lib.lisp b/src/el-lib.lisp index ab405f1..5387556 100644 --- a/src/el-lib.lisp +++ b/src/el-lib.lisp @@ -14,7 +14,8 @@ el-expand-fn el-executable-find el-move-path - el-copy-directory)) + el-delete-directory + el-directory-files)) (in-package :el-lib) @@ -43,51 +44,18 @@ (member elt list :test #'eq)) (defun el-member (elt list) + "Mimic `member' function." (member elt list :test #'string=)) (defun el-expand-fn (path &optional (dir-name (uiop:getcwd))) "Like `expand-file-name' function." (uiop:ensure-absolute-pathname (uiop:merge-pathnames* path dir-name))) -(defun el-directory-files (directory) - "Return a list of names of files in DIRECTORY." - (append (uiop:subdirectories directory) - (directory-files directory))) +(defun el-delete-directory (dir) + "Delete the DIR." + (sb-ext:delete-directory (el-lib:el-expand-fn dir) :recursive t)) -(defun el-subdirectory-p (to-pathname from-pathname) - "Return non-nil if TO-PATHNAME is part of the subdirectory to FROM-PATHNAME." - (let ((to-dir (pathname-directory to-pathname)) - (from-dir (pathname-directory from-pathname))) - (assert (eq :absolute (car to-dir))) - (assert (eq :absolute (car from-dir))) - (and (<= (length from-dir) - (length to-dir)) - (loop :for from-elt :in (cdr from-dir) - :for to-elt :in (cdr to-dir) - :when (not (equal from-elt to-elt)) - :do (return nil) - :finally (return t))))) - -(defun el-list-directory (directory &key directory-only (sort-method :pathname)) - "TODO: .." - (delete nil - (mapcar (lambda (x) (and (virtual-probe-file x directory) x)) - (append (sort-files-with-method - (copy-list (uiop:subdirectories directory)) - :sort-method sort-method) - (unless directory-only - (sort-files-with-method (uiop:directory-files directory) - :sort-method sort-method)))))) - -(defun el-copy-directory (src dst) - "Recursively copy the contents of SRC to DST." - (setf dst (uiop:ensure-directory-pathname dst)) - (let* ((src (el-expand-fn src)) - (dst (el-expand-fn dst))) - (when (el-subdirectory-p dst src) - (error "Cannot copy `~A' into its subdirectory `~A'" src dst)) - (let ((dst (ensure-directories-exist dst))) - (dolist (file (el-list-directory src)) - (copy-file file dst))) - (when *rename-p* (uiop:delete-empty-directory src)) - )) +(defun el-directory-files (dir) + "Return a list of names of files in DIR." + (append (uiop:subdirectories dir) + (directory-files dir))) diff --git a/src/main.lisp b/src/main.lisp index ebd46a8..d110533 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -9,7 +9,15 @@ (in-package :qob) +(defvar *dot-root* ".qob/" + "The .qob directory.") + +(defun make-dot-folder () + "Create the dot folder." + (ensure-directories-exist *dot-root*)) + (defun main () "The main entry point of our CLI program." + (make-dot-folder) (let ((app (command))) (clingon:run app))) diff --git a/src/utils.lisp b/src/utils.lisp index eb44983..f192727 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -19,53 +19,20 @@ (defun lisp-script (name) "Form lisp script path." - (concatenate 'string name ".lisp")) + (let* ((lisp-dir (el-lib:el-expand-fn *lisp-root* sb-ext:*runtime-pathname*)) + (name (concatenate 'string name ".lisp")) + (name (el-lib:el-expand-fn name lisp-dir))) + (namestring name))) (defun call-lisp (script &rest args) "Run the lisp implementation." (let ((lisp-impls (program-name))) (unless (el-lib:el-executable-find lisp-impls) (error "Defined Lisp implementation is not installed: ~A" lisp-impls)) - (let* ((lisp-dir (el-lib:el-expand-fn *lisp-root* sb-ext:*runtime-pathname*)) - (script (lisp-script script))) - (format t "~A" (el-lib:el-expand-fn script lisp-dir)) - ;; (uiop:run-program (list lisp-impls - ;; "--load" (el-lib:el-expand-fn script *lisp-root*) - ;; ) - ;; :output t - ;; :force-shell t) - ))) - -(defun setup () - "Setup the system." - (let ((files (asd-files t))) - (mapc (lambda (file) - (load-system file) - (-info "Load ASD file ~A" file)) - files))) - -(defun load-system (filename) - "Load the system from ASD's FILENAME; and return the registered name." - (let ((dir (uiop:pathname-parent-directory-pathname filename)) - (file (pathname-name filename))) - (push dir asdf:*central-registry*) - (asdf:load-system file) - file)) ; registered name - -(defun find-system (name) - "Return a system of given NAME." - (asdf/system-registry:registered-system name)) - -(defun asd-files (&optional with-test) - "Return a list of ASD files. - -If optional argument WITH-TEST is non-nil; include test ASD files as well." - (uiop:if-let ((files (directory "*.asd")) - (_ (not with-test)) - (tests (asd-test-files))) - (remove-if (lambda (filename) (el-lib:el-memq filename tests)) files) - files)) - -(defun asd-test-files () - "Return a list of ASD test files." - (directory "*-test*.asd")) + (let ((prepare (lisp-script "_prepare")) + (script (lisp-script script))) + (uiop:run-program (list lisp-impls + "--load" prepare + "--load" script) + :output t + :force-shell t))))