run.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(eval-when (:load-toplevel :compile-toplevel :execute)
  (dolist (lib '(:uiop :anaphora))
    (ql:quickload lib :silent t)))

(defpackage :ros.script.run.ros.3661998313
  (:use :cl
        :anaphora))
(in-package :ros.script.run.ros.3661998313)

(defun error-quit (msg)
  (format t "ERROR: ~F~%" msg)
  (uiop:quit))

(defvar *work-dir* "WORK/")

(defun join (lst &optional (sep " "))
  (with-output-to-string (s)
    (labels ((rec (rest)
               (when rest
                 (princ (car rest) s)
                 (when (cdr rest)
                   (princ sep s)
                   (rec (cdr rest))))))
      (rec lst))))

(defun run-shell (com)
  (uiop:run-program com
                    :output *standard-output*
                    :error-output *error-output*
                    :ignore-error-status t))

(defun check-if-installed (lib-name)
  (probe-file (format nil "./node_modules/~F/" lib-name)))

(defun install-by-npm (lst)
  (let ((not-installed-lst (remove-if #'check-if-installed lst)))
    (when not-installed-lst
      (format t "Install npm modules: ~A~%" not-installed-lst)
      (run-shell (format nil "npm install ~F" (join not-installed-lst))))))

(defun output-js (js-file pack-name args)
  (ensure-directories-exist (uiop:pathname-directory-pathname js-file))
  (with-open-file (out js-file
                       :direction :output
                       :if-exists :supersede
                       :if-does-not-exist :create)
    (princ (funcall (intern "MAIN" (string-upcase pack-name)) args)
           out)
    (format t "Create ~F~%" js-file)))

(defun get-or-default (sym-name pack-name default)
  (aif (find-symbol sym-name pack-name)
       (symbol-value it)
       default))

(defun main (&rest argv)
  (declare (ignorable argv))
  (when (< (length argv) 2)
    (error-quit "Please input a 'directory' name and a 'file' name (& rest is argv)"))
  (let* ((dir (car argv))
         (name (cadr argv))
         (pack-name (string-upcase name))
         (lisp-file (make-pathname :name name
                                   :directory `(:relative ,dir)
                                   :type "lisp"))
         (js-file (make-pathname :name name
                                 :directory `(:relative ,*work-dir*)
                                 :type "js")))
    (unless (probe-file lisp-file)
      (error-quit (format nil "The file '~F' is not exist" lisp-file)))
    (load lisp-file)
    (output-js js-file pack-name (cddr argv))
    (install-by-npm (symbol-value (intern "*DEPENDENCIES*" pack-name)))
    (run-shell (format nil "(cd ~F ; ~F ~F.js)"
                       *work-dir*
                       (get-or-default "*EXECUTOR*" pack-name "node")
                       name))))