org

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."

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))

cmds/core/list.lisp

@@ -2,9 +2,7 @@
 
 ;;; Commentary
 ;;
-;; Command use to list the registered system
-;;
-;;   $ qob list
+;; The `list' command definition.
 ;;
 
 ;;; Code

cmds/qob.lisp

@@ -23,4 +23,5 @@
    :license "MIT"
    :handler #'handler
    :sub-commands `(,(qob/build:command)
+                   ,(qob/install:command)
                    ,(qob/list:command))))

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"))

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)))

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")

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...")

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

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")

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)))

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)))

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))))