install deps

Author: jcs090218

cmds/core/build.lisp

@@ -41,3 +41,5 @@
    :usage "-n <name> -o <path>"
    :options (options)
    :handler #'handler))
+
+;;; End of cmds/core/build.lisp

cmds/core/dists.lisp

@@ -28,3 +28,5 @@
    :description "List out all installed dists"
    :options (options)
    :handler #'handler))
+
+;;; End of cmds/core/dist.lisp

cmds/core/install-deps.lisp

@@ -0,0 +1,37 @@
+;;;; cmds/core/install-deps.lisp --- Build executable
+
+;;; Commentary
+;;
+;; The `install-deps' command definition.
+;;
+
+;;; Code
+
+(defpackage qob-cli/install-deps
+  (:use cl)
+  (:export command))
+
+(in-package :qob-cli/install-deps)
+
+(defun options ()
+  "Options for `install-deps' command."
+  (list
+   (clingon:make-option
+    :flag
+    :description "install include development dependencies"
+    :long-name "dev"
+    :key :dev)))
+
+(defun handler (cmd)
+  "Handler for `install-deps' command."
+  (qob-cli:call-script "core/install-deps" cmd))
+
+(defun command ()
+  "The `install-deps' command."
+  (clingon:make-command
+   :name "install-deps"
+   :description "Automatically install system dependencies"
+   :options (options)
+   :handler #'handler))
+
+;;; End of cmds/core/install-deps.lisp

cmds/core/install.lisp

@@ -29,3 +29,5 @@
    :usage "[names..]"
    :options (options)
    :handler #'handler))
+
+;;; End of cmds/core/install.lisp

cmds/core/list.lisp

@@ -28,3 +28,5 @@
    :description "List the registered system"
    :options (options)
    :handler #'handler))
+
+;;; End of cmds/core/list.lisp

cmds/qob.lisp

@@ -58,4 +58,7 @@
    :sub-commands `(,(qob-cli/build:command)
                    ,(qob-cli/dists:command)
                    ,(qob-cli/install:command)
+                   ,(qob-cli/install-deps:command)
                    ,(qob-cli/list:command))))
+
+;;; End of cmds/qob.lisp

lisp/_color.lisp

@@ -26,20 +26,13 @@
               #\Esc (qob-color-code color) str #\Esc)
       str))
 
-(defun qob-ansi-red (str)
-  "Color STR in red."
-  (qob-color-it :red str))
-
-(defun qob-ansi-green (str)
-  "Color STR in green."
-  (qob-color-it :green str))
-
-(defun qob-ansi-yellow (str)
-  "Color STR in yellow."
-  (qob-color-it :yellow str))
-
-(defun qob-ansi-cyan (str)
-  "Color STR in cyan."
-  (qob-color-it :cyan str))
+(defun qob-ansi-black (str) (qob-color-it :black str))
+(defun qob-ansi-red (str) (qob-color-it :red str))
+(defun qob-ansi-green (str) (qob-color-it :green str))
+(defun qob-ansi-yellow (str) (qob-color-it :yellow str))
+(defun qob-ansi-blue (str) (qob-color-it :blue str))
+(defun qob-ansi-magenta (str) (qob-color-it :magenta str))
+(defun qob-ansi-cyan (str) (qob-color-it :cyan str))
+(defun qob-ansi-white (str) (qob-color-it :white str))
 
 ;;; End of lisp/_color.lisp

lisp/_prepare.lisp

@@ -37,23 +37,28 @@ The arguments FMT and ARGS are used to form the output message."
 
 (defun qob-trace (msg &rest args)
   "Send trace message; see function `qob--msg' for arguments MSG and ARGS."
-  (apply #'qob-msg msg args))
+  (let ((msg (apply #'format nil msg args)))
+    (qob-msg (qob-ansi-white msg))))
 
 (defun qob-debug (msg &rest args)
   "Send debug message; see function `qob--msg' for arguments MSG and ARGS."
-  (apply #'qob-msg msg args))
+  (let ((msg (apply #'format nil msg args)))
+    (qob-msg (qob-ansi-blue msg))))
 
 (defun qob-info (msg &rest args)
   "Send info message; see function `qob--msg' for arguments MSG and ARGS."
-  (qob-msg (qob-ansi-cyan (format nil msg args))))
+  (let ((msg (apply #'format nil msg args)))
+    (qob-msg (qob-ansi-cyan msg))))
 
 (defun qob-warn (msg &rest args)
   "Send warning message; see function `qob--msg' for arguments MSG and ARGS."
-  (qob-msg (qob-ansi-yellow (format nil msg args))))
+  (let ((msg (apply #'format nil msg args)))
+    (qob-msg (qob-ansi-yellow msg))))
 
 (defun qob-error (msg &rest args)
   "Send error message; see function `qob--msg' for arguments MSG and ARGS."
-  (qob-msg (qob-ansi-red (format nil msg args))))
+  (let ((msg (apply #'format nil msg args)))
+    (qob-msg (qob-ansi-red msg))))
 
 ;;
 ;;; Environment
@@ -170,27 +175,33 @@ the `qob-start' execution.")
 ;;; Package
 
 (defconstant qob-source-mapping
-  `((quicklisp . "https://www.quicklisp.org/")
+  `((quicklisp . "http://beta.quicklisp.org/")
     (ultralisp . "http://dist.ultralisp.org/"))
   "Mapping of source name and url.")
 
+(defvar qob-ql-init-p nil
+  "Set to t when QuickLisp is initialized.")
+
 (defun qob-ql-installed-dir ()
   "Return the QuickLisp installed directory base on scope."
   (uiop:merge-pathnames* "quicklisp/" (if (qob-global-p)
                                           (user-homedir-pathname)
                                           (qob-dot-home))))
 
-(defun qob-init-ql ()
+(defun qob-init-ql (&optional force)
   "Initialize QuickLisp."
-  (let* ((ql-dir (qob-ql-installed-dir))
-         (ql-init (uiop:merge-pathnames* "setup.lisp" ql-dir)))
-    (unless qob-quicklisp-installed-p
-      (qob-quicklisp-install ql-dir))
-    (when (probe-file ql-init)
-      (load ql-init))))
+  (when (or (not qob-ql-init-p)
+            force)
+    (let* ((ql-dir (qob-ql-installed-dir))
+           (ql-init (uiop:merge-pathnames* "setup.lisp" ql-dir)))
+      (unless qob-quicklisp-installed-p
+        (qob-quicklisp-install ql-dir))
+      (when (probe-file ql-init)
+        (load ql-init)))
+    (setq qob-ql-init-p t)))
 
 ;;
-;;; Core
+;;; ASDF file
 
 (defun qob-asd-test-files ()
   "Return a list of ASD test files."
@@ -206,6 +217,30 @@ If optional argument WITH-TEST is non-nil; include test ASD files as well."
     (remove-if (lambda (filename) (qob-el-memq filename tests)) files)
     files))
 
+(defvar qob-asds-init-p nil
+  "Set to t when ASDF files are initialized.")
+
+(defvar qob-loaded-asds nil
+  "Loaded ASD files.")
+
+(defun qob-init-asds (&optional force)
+  "Initialize the ASD files."
+  (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))))
+
+;;
+;;; ASDF system
+
+(defvar qob-systems-init-p nil
+  "Set to t when system is initialized.")
+
 (defun qob-load-system (filename)
   "Load the system from ASD's FILENAME; and return the registered name."
   (let ((dir (qob-el-file-name-directory filename))
@@ -218,14 +253,21 @@ If optional argument WITH-TEST is non-nil; include test ASD files as well."
   "Return a system of given NAME."
   (asdf/system-registry:registered-system name))
 
-(defun qob-init-system ()
-  "Setup the system."
-  (qob-init-ql)
-  (let ((files (qob-asd-files t)))
-    (mapc (lambda (file)
-            (qob-load-system file)
-            (qob-info "Load ASD file ~A" file))
-          files)))
+(defvar qob-loaded-systems nil
+  "List of loaded systems.")
+
+(defun qob-init-systems(&optional force)
+  "Initialize the ASD systems."
+  (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))
+    (setq qob-systems-init-p t)))
 
 ;;
 ;;; Externals

lisp/core/build.lisp

@@ -10,12 +10,11 @@
 ;;  Optional arguments:
 ;;
 ;;    --name, -n         path to the ASD file
-;;    --output, -o       output directory
 ;;
 
 ;;; Code
 
-(qob-init-system)
+(qob-init-systems)
 
 (let ((names qob-args))
   ;; Delete if exists to prevent errors.

lisp/core/dists.lisp

@@ -14,8 +14,10 @@
 (defun qob-dists--print (dists)
   "Print list of dists."
   (dolist (dist dists)
-    ;; TODO: Print useful information.
-    (qob-println "~A" (ql-dist:archive-url dist))))
+    (let ((name    (slot-value dist 'ql-dist:name))
+          (version (slot-value dist 'ql-dist:version))
+          (url     (slot-value dist 'ql-dist::distinfo-subscription-url)))
+      (qob-println "   ~A  ~A  ~A" name version url))))
 
 (let ((dists (ql-dist:all-dists)))
   (qob-info "Available dists:")

lisp/core/install-deps.lisp

@@ -10,7 +10,10 @@
 ;;; Code
 
 (qob-init-ql)
+(qob-init-asds)
 
-
+(dolist (asd qob-loaded-asds)
+  (qob-println "ASD: ~A" (asdf:component-depends-on asd nil))
+  )
 
 ;;; End of lisp/core/install-deps.lisp

lisp/core/install.lisp

@@ -16,8 +16,12 @@
 
 (qob-init-ql)
 
-(dolist (name qob-args)
-  (qob-info "Installing package ~A..." name)
-  (ql:quickload name))
+(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)))))
 
 ;;; End of lisp/core/install.lisp

lisp/core/list.lisp

@@ -11,16 +11,33 @@
 
 (qob-init-ql)
 
-(defun qob-list--print-system (name)
+(defun qob-list--print-system (name system)
+  "Print the SYSTEM."
+  (let ((version (or (asdf:component-version system)
+                     "0"))
+        (desc (or (asdf:system-description system)
+                  "")))
+    (qob-println "   [+] ~A  ~A  ~A"
+                 name version desc)))
+
+(defun qob-list--print-system-by-name (name)
   "Print the system info by NAME."
-  (let* ((system (asdf:find-system name))
-         (version (or (asdf:component-version system)
-                      "0")))
-    (qob-println "   ~A (~A)"
-                 (qob-ansi-green name)
-                 (qob-ansi-yellow version))))
-
-(let* ((pre-systems (asdf/system-registry:registered-systems))
+  (let ((system (asdf:find-system name)))
+    (qob-list--print-system name system)))
+
+(defun qob-list--print-dist (dist)
+  ""
+  (let ((systems (ql-dist:provided-systems dist)))
+    (dolist (system systems)
+      (let ((name    (ql-dist:name system))
+            (version (or (ql-dist:version system)
+                         "0"))
+            )
+        (qob-println "   [+] ~A (~A)"
+                     name version)
+        ))))
+
+(let* ((pre-systems (asdf:registered-systems))
        (pre-systems (reverse pre-systems))
        (post-systems)
        (local-p (qob-local-p)))
@@ -29,15 +46,26 @@
 
   (setq post-systems (remove-if (lambda (system)
                                   (qob-el-memq system pre-systems))
-                                (asdf/system-registry:registered-systems))
+                                (asdf:registered-systems))
         post-systems (reverse post-systems))
 
   (qob-println "Pre-built systems:")
-  (mapc #'qob-list--print-system pre-systems)
+  (qob-msg "")
+  (mapc #'qob-list--print-system-by-name pre-systems)
+  (qob-msg "")
+  (qob-info "(Total of ~A system registered)" (length pre-systems)
+            (qob--sinr pre-systems "" "s"))
 
   (when local-p
     (qob-msg "")
     (qob-println "User systems:")
-    (mapc #'qob-list--print-system post-systems)))
+    (qob-msg "")
+    (mapc #'qob-list--print-system-by-name post-systems)
+    (qob-msg "")
+    (qob-info "(Total of ~A system~A registered)" (length post-systems)
+              (qob--sinr post-systems "" "s")))
+
+  (when (qob-all-p)
+    (mapc #'qob-list--print-dist (ql-dist:all-dists))))
 
 ;;; End of lisp/core/list.lisp

qob-cli.asd

@@ -13,6 +13,7 @@
                (:file "cmds/core/build")
                (:file "cmds/core/dists")
                (:file "cmds/core/install")
+               (:file "cmds/core/install-deps")
                (:file "cmds/core/list")
                (:file "cmds/qob")
                ;; Program