feat: Install systesm

cmds/core/build.lisp

@@ -38,7 +38,7 @@
   (clingon:make-command
    :name "build"
    :description "Build the executable"
-   :usage "-n <name> -o <path>"
+   :usage "[names..]"
    :options (options)
    :handler #'handler))
 

cmds/core/install-deps.lisp

@@ -31,6 +31,7 @@
   (clingon:make-command
    :name "install-deps"
    :description "Automatically install system dependencies"
+   :usage "[names..]"
    :options (options)
    :handler #'handler))
 

lisp/_el_lib.lisp

@@ -10,6 +10,10 @@
 ;;
 ;;; Core
 
+(defun qob-el-format (string &rest objects)
+  "Mimic `format' function."
+  (apply #'format nil string objects))
+
 (defun qob-el-2str (object)
   "Convert to string."
   (cond ((stringp   object) object)

lisp/_prepare.lisp

@@ -21,7 +21,8 @@ The arguments FMT and ARGS are used to form the output message."
                   (stdout *standard-output*)
                   (stderr *error-output*)
                   (t t))))
-    (apply #'format stream fmt args)))
+    (apply #'format stream fmt args)
+    (force-output stream)))
 
 (defun qob-print (msg &rest args)
   "Standard output print MSG and ARGS."
@@ -31,9 +32,13 @@ The arguments FMT and ARGS are used to form the output message."
   "Like function `qob-print' but with newline at the end."
   (apply #'qob-print (concatenate 'string msg "~%") args))
 
-(defun qob-msg (msg &rest args)
+(defun qob-write (msg &rest args)
   "Standard error print MSG and ARGS."
-  (apply #'qob-princ 'stderr (concatenate 'string msg "~%") args))
+  (apply #'qob-princ 'stderr msg args))
+
+(defun qob-msg (msg &rest args)
+  "Standard error print line MSG and ARGS."
+  (apply #'qob-write (concatenate 'string msg "~%") args))
 
 (defun qob-trace (msg &rest args)
   "Send trace message; see function `qob--msg' for arguments MSG and ARGS."
@@ -58,7 +63,8 @@ The arguments FMT and ARGS are used to form the output message."
 (defun qob-error (msg &rest args)
   "Send error message; see function `qob--msg' for arguments MSG and ARGS."
   (let ((msg (apply #'format nil msg args)))
-    (qob-msg (qob-ansi-red msg))))
+    (qob-msg (qob-ansi-red msg)))
+  (uiop:quit 1))
 
 ;;
 ;;; Environment
@@ -107,6 +113,14 @@ For example, `.qob/sbcl/2.4.9/'."
 ;;
 ;;; Utils
 
+(defmacro qob-silent (&rest body)
+  "Execute BODY without output."
+  `(with-open-stream (*standard-output* (make-broadcast-stream)) ,@body))
+
+(defun qob-format (string &rest objects)
+  "Format string."
+  (apply #'qob-el-format string objects))
+
 (defun qob-2str (object)
   "Convert to string."
   (funcall #'qob-el-2str object))
@@ -127,9 +141,9 @@ the `qob-start' execution.")
 (defun qob-call (script)
   "Call another qob SCRIPT."
   (let ((script-file (qob-script script)))
-    (when (uiop:file-exists-p script-file)
-      (load script-file)
-      (qob-error "Script missing %s" script-file))))
+    (if (uiop:file-exists-p script-file)
+        (load script-file)
+        (qob-error "Script missing %s" script-file))))
 
 (defun qob-load (script)
   "Load another qob SCRIPT; so we can reuse functions across all scripts."
@@ -171,6 +185,39 @@ the `qob-start' execution.")
   "Non-nil when flag has value (`-v', `--verbose')."
   (qob--flag-value "--verbose"))
 
+;;
+;;; Verbose
+
+(defun qob--verb2lvl (symbol)
+  "Convert verbosity SYMBOL to level."
+  (case symbol
+    (all   5)
+    (debug 4)
+    (log   3)
+    (info  2)
+    (warn  1)
+    (error 0)
+    (t symbol)))
+
+(defun qob-reach-verbosity-p (symbol)
+  "Return t if SYMBOL reach verbosity (should be printed)."
+  (>= (qob-verbose) (qob--verb2lvl symbol)))
+
+(defmacro qob-with-verbosity (symbol &rest body)
+  "Define verbosity scope.
+
+Execute forms BODY limit by the verbosity level (SYMBOL)."
+  `(if (qob-reach-verbosity-p ,symbol)
+       (progn ,@body)
+       (qob-silent ,@body)))
+
+;;
+;;; Progress
+
+(defmacro qob-with-progress (msg-start body msg-end)
+  "Progress BODY wrapper with prefix (MSG-START) and suffix (MSG-END) messages."
+  `(progn (qob-write ,msg-start) ,body (qob-msg ,msg-end)))
+
 ;;
 ;;; Package
 
@@ -224,16 +271,26 @@ If optional argument WITH-TEST is non-nil; include test ASD files as well."
   "Loaded ASD files.")
 
 (defun qob-init-asds (&optional force)
-  "Initialize the ASD files."
+  "Initialize the ASD files.
+
+This function only loads the ASD file but doesn't actually try to
+set up the system.  You should use the function `qob-init-systems'
+to actually set up the systems."
   (when (and (qob-local-p)
              (or (not qob-asds-init-p)
                  force))
     (setq qob-loaded-asds nil)  ; reset
-    (let ((files (qob-asd-files t)))
-      (mapc (lambda (file)
-              (push (asdf:load-asd file) qob-loaded-asds)
-              (qob-info "Loaded ASD file ~A" file))
-            files))))
+    (qob-with-progress
+     (qob-ansi-green "Loading ASDF files... ")
+     (qob-with-verbosity
+      'debug
+      (let ((files (qob-asd-files t)))
+        (mapc (lambda (file)
+                (push (asdf:load-asd file) qob-loaded-asds)
+                (qob-println "Loaded ASD file ~A" file))
+              files)))
+     (qob-ansi-green "done"))
+    (setq qob-loaded-asds t)))
 
 ;;
 ;;; ASDF system
@@ -256,17 +313,25 @@ If optional argument WITH-TEST is non-nil; include test ASD files as well."
 (defvar qob-loaded-systems nil
   "List of loaded systems.")
 
-(defun qob-init-systems(&optional force)
-  "Initialize the ASD systems."
+(defun qob-init-systems (&optional force)
+  "Initialize the ASD systems.
+
+Set up the systems; on contrary, you should use the function
+`qob-init-asds' if you only want the ASD files to be loaded."
   (when (and (qob-local-p)
              (or (not qob-systems-init-p)
                  force))
     (setq qob-loaded-systems nil)  ; reset
-    (let ((files (qob-asd-files t)))
-      (mapc (lambda (file)
-              (push (qob-load-system file) qob-loaded-systems)
-              (qob-info "Loaded system file ~A" file))
-            files))
+    (qob-with-progress
+     (qob-ansi-green "Loading ASDF systems... ")
+     (qob-with-verbosity
+      'debug
+      (let ((files (qob-asd-files t)))
+        (mapc (lambda (file)
+                (push (qob-load-system file) qob-loaded-systems)
+                (qob-println "Loaded system file ~A" file))
+              files)))
+     (qob-ansi-green "done"))
     (setq qob-systems-init-p t)))
 
 ;;

lisp/core/build.lisp

@@ -14,14 +14,14 @@
 
 ;;; Code
 
+(qob-init-ql)
 (qob-init-systems)
 
 (let ((names qob-args))
-  ;; Delete if exists to prevent errors.
-  ;; (when (uiop:file-exists-p output)
-  ;;   (delete-file output))
   (dolist (name names)
-    (qob-info "Building  system ~A" name)
-    (asdf:operate :build-op name)))
+    (qob-with-progress
+     (qob-format "Building system ~A... " (qob-ansi-green name))
+     (asdf:operate :build-op name)
+     "done ✓")))
 
 ;;; End of lisp/core/build.lisp

lisp/core/install-deps.lisp

@@ -4,16 +4,23 @@
 ;;
 ;; Command use to install dependent systems,
 ;;
-;;   $ qob install-deps
+;;   $ qob install-deps [names..]
 ;;
 
 ;;; Code
 
 (qob-init-ql)
 (qob-init-asds)
 
-(dolist (asd qob-loaded-asds)
-  (qob-println "ASD: ~A" (asdf:component-depends-on asd nil))
-  )
+(qob-load "shared")
+
+(cond ((zerop (length qob-args))
+       (qob-help "core/install-deps"))
+      (t
+       (let ((systems qob-args))
+         (dolist (system-name systems)
+           (let* ((system (asdf:find-system system-name))
+                  (deps   (asdf:system-depends-on system)))
+             (qob-install-systems deps))))))
 
 ;;; End of lisp/core/install-deps.lisp

lisp/core/install.lisp

@@ -16,12 +16,12 @@
 
 (qob-init-ql)
 
+(qob-load "shared")
+
 (let ((names qob-args))
   (cond ((zerop (length names))
          (qob-help "core/install"))
         (t
-         (dolist (name names)
-           (qob-info "Installing package ~A..." name)
-           (ql:quickload name)))))
+         (qob-install-systems names))))
 
 ;;; End of lisp/core/install.lisp

lisp/shared.lisp

@@ -0,0 +1,35 @@
+;;; lisp/shared.el --- Shared functions
+
+;;; Commentary:
+;;
+;; Functions cannot be compiled in `_prepare.el' but can be
+;; compiled later on.
+;;
+
+;;; Code:
+
+(defun qob-install-systems (names)
+  "Install systems by NAMES."
+  (let* ((total (length names))
+         (count 1)
+         (installed 0)
+         (skipped 0))
+    (qob-msg "Installing 2 systems... ")
+    (qob-msg "")
+    (dolist (name names)
+      (let* ((system (asdf:find-system name))
+             (version (asdf:component-version system))
+             (already-installed-p (asdf:find-system name)))
+        (if already-installed-p (incf skipped) (incf installed))
+        (qob-with-progress
+         (qob-format "  - [~A/~A] Installing ~A (~A)... "
+                     count total
+                     (qob-ansi-green name)
+                     (qob-ansi-yellow version))
+         (qob-silent (ql:quickload name))
+         (if already-installed-p "skipped ✗" "done ✓")))
+      (incf count))
+    (qob-msg "")
+    (qob-info "(Total of ~A systems installed; ~A skipped)" installed skipped)))
+
+;;; End of lisp/shared.lisp