feat: clean all

Author: jcs090218

cmds/clean/all.lisp

@@ -0,0 +1,32 @@
+;;;; cmds/clean/all.lisp --- Do all cleaning tasks
+
+;;; Commentary
+;;
+;; The `clean all' command definition.
+;;
+
+;;; Code
+
+(defpackage qob-cli/clean/all
+  (:use cl)
+  (:export command))
+
+(in-package :qob-cli/clean/all)
+
+(defun options ()
+  "Options for `clean all' command."
+  (list ))
+
+(defun handler (cmd)
+  "Handler for `clean all' command."
+  (qob-cli:call-script "clean/all" cmd))
+
+(defun command ()
+  "The `clean all' command."
+  (clingon:make-command
+   :name "all"
+   :description "Do all cleaning tasks"
+   :options (options)
+   :handler #'handler))
+
+;;; End of cmds/clean/all.lisp

cmds/clean/dist.lisp

@@ -19,7 +19,7 @@
 
 (defun handler (cmd)
   "Handler for `clean dist' command."
-  (let ((qob-cli:inhibit-ql-download t))
+  (let ((qob-cli:inhibit-ql-download-p t))
     (qob-cli:call-script "clean/dist" cmd)))
 
 (defun command ()

cmds/clean/workspace.lisp

@@ -19,7 +19,7 @@
 
 (defun handler (cmd)
   "Handler for `clean workspace' command."
-  (let ((qob-cli:inhibit-ql-download t))
+  (let ((qob-cli:inhibit-ql-download-p t))
     (qob-cli:call-script "clean/workspace" cmd)))
 
 (defun command ()

cmds/core/clean.lisp

@@ -29,7 +29,8 @@
    :usage "<type>"
    :options (options)
    :handler #'handler
-   :sub-commands `(,(qob-cli/clean/dist:command)
+   :sub-commands `(,(qob-cli/clean/all:command)
+                   ,(qob-cli/clean/dist:command)
                    ,(qob-cli/clean/workspace:command))))
 
 ;;; End of cmds/core/clean.lisp

lisp/_prepare.lisp

@@ -196,6 +196,9 @@ Argument ENV-NAME is used to get the argument string."
 (defvar qob-quicklisp-installed-p (uiop:getenv "QOB_QUICKLISP_INSTALLED")
   "Return non-nil if Quicklisp is already installed.")
 
+(defvar qob-inhibit-ql-download-p (uiop:getenv "QOB_INHIBIT_QL_DOWNLOAD")
+  "Return non-nil if Quicklisp is inhibit to be downloaded.")
+
 (defun qob-dot-impls ()
   "Return the directory path to `.qob/type/version'.
 

lisp/clean/all.lisp

@@ -0,0 +1,49 @@
+;;;; lisp/clean/all.lisp --- Do all cleaning tasks
+
+;;; Commentary
+;;
+;; Command use to do all cleaning tasks
+;;
+;;   $ qob clean all
+;;
+
+;;; Code
+
+(defconstant qob-clean-all--tasks-total 2
+  "Count cleaning task.")
+
+(defvar qob-clean-all--tasks-count 0
+  "Count cleaning task.")
+
+(defvar qob-clean-all--tasks-cleaned 0
+  "Total cleaned tasks.")
+
+(defmacro qob--clean-section (title &rest body)
+  "Print clean up TITLE and execute BODY."
+  `(let (qob-no-cleaning-operation-p)
+     (incf qob-clean-all--tasks-count)
+     (qob-with-progress
+      (concatenate 'string
+                   (qob-format "  - [~A/~a] " qob-clean-all--tasks-count qob-clean-all--tasks-total)
+                   (qob-format "~A... " ,title))
+      (qob-with-verbosity 'debug ,@body)
+      (if qob-no-cleaning-operation-p
+          "skipped ✗"
+          (progn
+            (incf qob-clean-all--tasks-cleaned)
+            "done ✓")))))
+
+(qob-start
+ (qob-msg "Applying ~A cleaning tasks..." qob-clean-all--tasks-total)
+ (qob-msg "")
+ (qob--clean-section (qob-format "Cleaning ~A" (qob-ansi-green "workspace"))
+                     (qob-call "clean/workspace"))
+ (qob--clean-section (qob-format "Cleaning ~A" (qob-ansi-green "dist"))
+                     (qob-call "clean/dist"))
+ (qob-msg "")
+ (qob-info "(Total of ~A task~A cleaned, ~A skipped)"
+           qob-clean-all--tasks-cleaned
+           (qob--sinr qob-clean-all--tasks-cleaned "" "s")
+           (- qob-clean-all--tasks-count qob-clean-all--tasks-cleaned)))
+
+;;; End of lisp/clean/all.lisp

lisp/clean/workspace.lisp

@@ -10,12 +10,16 @@
 ;;; Code
 
 (qob-start
- (qob-with-progress
-  (qob-format "Deleting ~A... " qob-dot)
-  (uiop:delete-directory-tree (pathname qob-dot) :validate t)
-  "done ✓")
-
- (qob-println "")
- (qob-info "(Workspace is now cleaned)"))
+ (let ((deleted))
+   (qob-with-progress
+    (qob-format "Deleting ~A... " qob-dot)
+    (setq deleted (ignore-errors (delete-directory qob-dot :recursive t)))
+    (if deleted "done ✓" "skipped ✗"))
+   (qob-println "")
+   (if deleted
+       (qob-info "(Workspace is now cleaned)")
+       (progn
+         (qob-info "(Failed to clean up workspace)")
+         (setq qob-no-cleaning-operation-p t)))))
 
 ;;; End of lisp/clean/workspace.lisp

qob-cli.asd

@@ -12,6 +12,7 @@
                (:file "src/utils")
                ;; Commands
                (:file "cmds/create/cl-project")
+               (:file "cmds/clean/all")
                (:file "cmds/clean/dist")
                (:file "cmds/clean/workspace")
                (:file "cmds/core/build")

scripts/_prepare.lisp

@@ -19,7 +19,7 @@
 (defun qob-copy-lisp-dir ()
   "Copy `lisp' directory over."
   (when (probe-file "bin/lisp/")
-    (el-lib:el-delete-directory "bin/lisp/"))
+    (delete-directory "bin/lisp/" :recursive t))
   (copy-directory:copy (el-lib:el-expand-fn "lisp/")
                        (el-lib:el-expand-fn "bin/lisp/")))
 

src/el-lib.lisp

@@ -17,7 +17,6 @@
            el-expand-file-name
            el-executable-find
            el-move-path
-           el-delete-directory
            el-directory-files
            el-file-name-directory))
 
@@ -69,10 +68,6 @@
   "Like `expand-file-name' function; returns a string."
   (namestring (el-expand-fn path dir-name)))
 
-(defun el-delete-directory (dir)
-  "Delete the DIR."
-  (sb-ext:delete-directory (el-lib:el-expand-fn dir) :recursive t))
-
 (defun el-directory-files (dir)
   "Return a list of names of files in DIR."
   (append (uiop:subdirectories dir)

src/packages.lisp

@@ -11,7 +11,7 @@
   (:use cl)
   (:export
    ;; src/utils.lsip
-   inhibit-ql-download
+   inhibit-ql-download-p
    force-global-p
    exec-dir
    call-script

src/utils.lisp

@@ -9,7 +9,7 @@
 
 (in-package :qob-cli)
 
-(defvar inhibit-ql-download nil
+(defvar inhibit-ql-download-p nil
   "Set to t if you don't  want download `quicklisp.lisp' file on start.")
 
 (defvar force-global-p nil
@@ -103,10 +103,9 @@ Argument CMD is used to extract positional arguments and options."
   (setf (uiop:getenv "QOB_TEMP_FILE") (el-lib:el-expand-file-name "tmp" (dot-global)))
   (setf (uiop:getenv "QOB_LISP_ROOT") (lisp-root))
   (setf (uiop:getenv "QOB_USER_INIT") (user-init cmd))
-  (unless inhibit-ql-download
-    (if (quicklisp-installed-p cmd)
-        (setf (uiop:getenv "QOB_QUICKLISP_INSTALLED") "t")
-        (quicklisp-download cmd))))
+  (if (quicklisp-installed-p cmd)
+      (setf (uiop:getenv "QOB_QUICKLISP_INSTALLED") "t")
+      (quicklisp-download cmd)))
 
 (defun program-name ()
   "Lisp program we target to run."
@@ -142,7 +141,7 @@ Argument CMD is used to extract positional arguments and options."
         (ql      (lisp-script "_ql"))
         (script  (lisp-script script)))
     (call-impls (concatenate 'list
-                             (if (or inhibit-ql-download
+                             (if (or inhibit-ql-download-p
                                      (quicklisp-installed-p cmd))
                                  (list "--load" no-ql)
                                  (list "--load" (quicklisp-lisp cmd)