hubotify.rosにros buildを追加した

これの続き peccu.hatenablog.com

変更点

• JSからroswell/*.rosを実行すると遅いのでhubotify時にビルドするよう変更した
• 吐き出すJSが実行するrosコマンドを*.rosから*に変更した
• 上記でビルドしたものについてhubotifyしてしまうので、指定したパスが*.rosでなければ何もしないようにした
• hubotの警告を減らすため、吐き出すJSにヘッダをつけた
• ros buildした時に終了コードが0になるように最後をtにした
  • cf. built image returns exit code 1 · Issue #207 · roswell/roswell · GitHub 次のリリースでこの修正は不要になる
  • lakeがエラーコード返ってくると止まっているように見えるので

差分

diff --git a/bin/hubotify.ros b/bin/hubotify.ros
index 078f26f..12fb80e 100755
--- a/bin/hubotify.ros
+++ b/bin/hubotify.ros
@@ -10,9 +10,12 @@ Usage:
   $ hubotify <roswell script>
 |#
 
-(ql:quickload '(:parenscript) :silent t)
+(ql:quickload '(:parenscript :cl-ppcre :trivial-shell) :silent t)
 (import '(ps:ps ps:@ ps:lisp))
 
+(defun is-ros-script (path)
+  (ppcre:scan "\.ros$" path))
+
 (defun relative-path (path)
   (make-pathname
    :directory
@@ -23,9 +26,11 @@ Usage:
 
 (defun main (&optional script &rest argv)
   (declare (ignore argv))
+  (when (is-ros-script script)
     (let ((script (probe-file script)))
       (unless script
         (error "File does not exist: ~A" script))
+      (trivial-shell:shell-command (format nil "ros build ~a" script))
       (let ((*error-output* (make-broadcast-stream)))
         (load script))
       (when (fboundp (intern (string :js-main) :cl-user))
@@ -34,15 +39,17 @@ Usage:
                   ;; Write .js file to ./scripts/.
                   :directory (append (pathname-directory *default-pathname-defaults*)
                                '("scripts"))
-                             :type "js")))
+                  :type "js"))
+               (cl-file
+                (make-pathname :defaults script :type nil)))
           (with-open-file (*standard-output* js-file :direction :output :if-exists :supersede)
+            (format t "// Description:~%//   ParenScript from ../~a~%" (relative-path script))
             (princ
               (ps
                 (defun run-main (callback &rest argv)
                   (setf (@ this exec-file) (@ (require "child_process") exec-file))
                   ((@ this exec-file)
-                (+ __dirname "/../" (lisp (namestring (relative-path script))))
+                    (+ __dirname "/../" (lisp (namestring (relative-path cl-file))))
                     argv (new -object)
                     (lambda (error stdout stderr)
                       (funcall callback error stdout stderr)
@@ -52,3 +59,4 @@ Usage:
               (funcall (intern (string :js-main) :cl-user)))
             (fresh-line))
           (format *error-output* "~&Wrote '~A'~%" js-file)))))
+  t)

全文

#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#

#|
Generate a Hubot script (.js file) from the given Roswell script.

Usage:
  $ hubotify <roswell script>
|#

(ql:quickload '(:parenscript :cl-ppcre :trivial-shell) :silent t)
(import '(ps:ps ps:@ ps:lisp))

(defun is-ros-script (path)
  (ppcre:scan "\.ros$" path))

(defun relative-path (path)
  (make-pathname
   :directory
   (cons :relative
         (nthcdr (length (pathname-directory *default-pathname-defaults*))
                 (pathname-directory path)))
   :defaults path))

(defun main (&optional script &rest argv)
  (declare (ignore argv))
  (when (is-ros-script script)
    (let ((script (probe-file script)))
      (unless script
        (error "File does not exist: ~A" script))
      (trivial-shell:shell-command (format nil "ros build ~a" script))
      (let ((*error-output* (make-broadcast-stream)))
        (load script))
      (when (fboundp (intern (string :js-main) :cl-user))
        (let ((js-file
                (make-pathname :defaults script
                  ;; Write .js file to ./scripts/.
                  :directory (append (pathname-directory *default-pathname-defaults*)
                               '("scripts"))
                  :type "js"))
               (cl-file
                (make-pathname :defaults script :type nil)))
          (with-open-file (*standard-output* js-file :direction :output :if-exists :supersede)
            (format t "// Description:~%//   ParenScript from ../~a~%" (relative-path script))
            (princ
              (ps
                (defun run-main (callback &rest argv)
                  (setf (@ this exec-file) (@ (require "child_process") exec-file))
                  ((@ this exec-file)
                    (+ __dirname "/../" (lisp (namestring (relative-path cl-file))))
                    argv (new -object)
                    (lambda (error stdout stderr)
                      (funcall callback error stdout stderr)
                      (values))))))
            (fresh-line)
            (format t "module.exports = function(robot) {~%~A~%};"
              (funcall (intern (string :js-main) :cl-user)))
            (fresh-line))
          (format *error-output* "~&Wrote '~A'~%" js-file)))))
  t)

さて

こういう基盤作って、身近なところからCommon Lispを導入していかないと、Common Lispが使えるようにならない。

参考

trivial-shell