Common LispでSlack botを作る

チャットbotなるものにも(今さら)手を出してみようと、Slack用のサンプルbotCommon Lispで書いてみました。

github.com

使い方

一応使い方です。

  1. 上記プロジェクトをquicklispからロード可能な場所にclone
  2. settings.json.inを参考にsettings.json(下記参照)を作成
  3. REPL上でサーバを立ち上げる。
    1. (ql:quickload :sample-cl-bot)
    2. (clack:clackup sample-cl-bot:*app* :port 16111)
  4. SlackのOutgoing hookにhttp://<アドレス>:16111/を登録

基本編:Slackとのやりとり

f:id:eshamster:20160812001309p:plain

そもそもSlackとどうやりとりするのか、という話です。この手の解説は既に良いものが沢山あると思いますので、実装を簡単に見る程度にします。

流れだけ言いますと、Slack側ではOutgoing Hookにキーワード(上記の画像では"alien:")とLispサーバのアドレスを設定し、サーバ側ではSlackから受け取ったポストを元に適切なIncoming HookのURLへメッセージ(JSON形式)を投げ返すだけです。

サーバ部分は以下のような感じで、ningleを使ってルーティングしています。

(defvar *app* (make-instance 'ningle:<app>))

(setf (ningle:route *app* "/" :method :POST)
      #'(lambda (params)
          (aif (get-incoming-hook-url params)
               (dex:post it
                         :content (parse-input (extract-posted-text params) params)
                         :headers '(("content-type" . "application/json"))))))

get-incoming-hook-urlparse-inputについて簡単に解説。

まず、get-incoming-hook-urlはその名の通り、投稿すべきIncoming Hookのアドレスを取り出す関数です。Outgoing Hookによるポストはtokenの情報を持っているので、下記の設定ファイルを基にこのtokenと宛先のIncoming Hookの対応をとります。

{
    "pairs": [
        {
            "token": "<XXX>"
            "incoming_hook": "https://hooks.slack.com/services/XXXX/XXXX/XXXX"
        },
        {
            "token": "<YYY>"
            "incoming_hook": "https://hooks.slack.com/services/YYYY/YYYY/YYYY"
        }
    ]
}

次に、parse-inputですが、これは受け取ったメッセージを解析して、適切なメッセージ(JSON形式)を作り出す関数(の入り口)です。内部では最終的に以下の関数を呼び出してJSONを構成します。

(defun make-post-content (text)
  (jonathan:to-json
   (list :|text| text
         :|icon_url| "http://www.lisperati.com/lisplogo_alien_128.png"
         :|username| "Lisp Alien")))

応用編:対話式のやりとり

このbotでは下記画像のように対話式のやりとりをサポートしています(画像ではrememberコマンドの後2つの応答。getコマンドは単なる結果確認用)。その実装に関する話です。

f:id:eshamster:20160812000035p:plain

実現機構

肝になる部分は下記のように簡単な実装になっています(上記基本編で呼んでいたparse-input関数の定義がこれ)。なお、slet, itanaphoraライブラリからインポートしたものです*1

(defvar *continuity-table* (make-hash-table :test 'equalp))

(defun parse-input (text params)
  (slet (gethash (make-params-hash params) *continuity-table*)
    (multiple-value-bind (content continuity)
        (if it (funcall it text params) (parse-command text params))
      (setf it continuity)
      content)))

Slackから受け取ったメッセージをパースしているのは、(if it (funcall it text params) (parse-command text params))の部分です。ifの分岐方向によらず下記のように動作します。

  • 引数
    • text:受け取ったメッセージ
    • params:その他Slackから受け取ったパラメータ一式*2
  • 返り値
    • 第1(content):Slackに投げるJSON
    • 第2(continuity):なし(= NIL)もしくは、textparamsを受け取り、content(とcontinuity)を返す関数

ポイントとなるのが第2返り値であるcontinuityです。この関数(またはNIL)は*continuity-table*に格納されます。このテーブルのキーとなっているのはユーザ識別情報です。したがって、同じユーザから再度メッセージが来た場合、下記のように動作します。

  1. テーブルにNILが格納されている → 標準のパーサであるparse-commandを呼び出す
  2. テーブルに関数が格納されている → 対話用のパーサであるその関数を呼び出す((funcall it text params)

結局、普段はparse-commandで標準的な処理を行い、対話処理をしたい場合は後継の対話処理を登録しておき次回はそれを使う、というのが全体像です。

上記画像の例では下記のように対応します。

  1. "alien: remember", "alien: get 斑鳩"(標準パーサ利用)
  2. "alien: 斑鳩", "alien: the best game"(対話用パーサ利用)

なお、聞きかじった程度の「継続」に近い気がしたので、continuityと名付けていますが、違うかもしれません…。

継続して利用する値の受け渡しについて

もう1点、"alien: the best game"とした時点で、ひとつ前の入力内容("斑鳩")がどこかに保存されている必要があります。これをどこに保存しているかという話ですが、クロージャに捕捉しています。

実例を見るのが早いかと思います。下記のmake-asking-value-fn関数がこの"alien: the best game"とした時点で呼ばれる関数を生成します。前段の"斑鳩"はkeyとして捕捉され、後で呼ばれる関数であるlambda以下から「見る」ことができます。

(defun make-asking-value-fn (key)
  (lambda (text params)
    (if (is-empty-string text)
        (values (make-post-to-mention ;; 「@<ユーザ名> ...」なポストを作る関数
                 (format nil "What is '~A'?" key)
                 params)
                (make-asking-value-fn key))
        (register-pair-and-make-post key text params))))

(一応)機能紹介

機能紹介…といっても、サンプル用に実装しただけなので、特に実用的な機能はありません。

remember/get/forget

多少実用的なものその1。

f:id:eshamster:20160814182852p:plain

見てのとおりのkey, valueストアです。覚えた情報は基本的にtoken単位(≒チャンネル単位)で管理しているので、同じチャンネルであれば他の人が登録した情報もgetで見ることができます。

なお、永続化していないので環境を再起動すると消えます…*3

rememberコマンドは「応用編」では対話式に覚えさせましたが、この画像のようにremember <key> = <value>で一発登録もできます。

画像にはありませんが、forget <key>で覚えた<key>の情報を削除します。

weather

多少実用的なものその2。

f:id:eshamster:20160814182902p:plain

livedoorお天気WebサービスAPI*4を利用して、指定した地域の天気予報をとってきます。

なお、上記画像ではweatherエイリアスであるwf("Weather Forecasts")を利用しています。

f:id:eshamster:20160814182909p:plain

また、地味にrememberコマンドと連係しています。この画像のように、rememberコマンドで覚えたキー(上記のremember/getの例で覚えさせたもの)を地域名の代わりに利用できます。

その他

純粋なサンプル達

  • hello:こんにちは

f:id:eshamster:20160814182944p:plain

  • echo:そのまま返します
    • 余談ですが、下記画像のように、echoした情報にキーワード(alien:)が含まれればコマンドとして解釈してしまいます
      • 必ずキーワードを消費するので無限ループはしない…はず

f:id:eshamster:20160814183000p:plain

  • number game:対話式インタフェースのサンプルに作りました
    • エイリアンの考えている番号を当てるだけのゲームです
    • 勝率おおよそ1/7の○○ゲーです

f:id:eshamster:20160814183015p:plain


*1:記事を書いていて気づきましたが、itの中身が全て定義で置き換えられることを考えると、恐ろしく無駄な処理をしていますね…。気が向いたら直します

*2:textはこのparamsから生成できますが、少し加工(キーワードと空白のトリミング)が必要で、かつメインの処理対象なので加工済みのものを渡しています

*3:一応、src/kv-storage.lispさえ対応すれば永続化対応できる作りです。面倒なのはテストですね…。

*4:登録不要で使えたのでこれにしました。

Common Lisp開発環境 on Docker

Docker上でCommon Lisp開発環境(by Emacs+SLIME)を起こしてみました。何が入っているか分からない開発環境だとどうしてもアップデートが億劫になるので、その辺をきっちりコード化したかったというのが動機です。

どちらかと言うとAnsibleやChefのように直接サーバを設定するタイプの方がこの用途ではスタンダードな気がします(単なる印象)が、Dockerの方が試行錯誤で出るゴミ*1が残らないので好みでした。

注意点

執筆時点(2016/08/11)では、CentOS 7のyumではDocker 1.10が入りますが、事実上1.11以上が必須です。1.10ではEmacsの描画が激しく崩れるという問題があるためです(参考の前回記事:Dockerを1.10から1.11へアップデート on CentOS7 - eshamster’s diary)。

また、Dockerfileからビルドする場合にも必要な可能性があります。Emacsのビルド部分で詰まる可能性があるためです(参考の前々回記事:Docker上のEmacsのビルドでハマった話 - eshamster’s diary)。どういう訳か1.11.2では参考記事の問題は起きていないので、1.11にしておくとスムーズ…かもしれません*2

概説

まずは作ったものへの諸リンク*3

元々は以前書いた記事「Common Lisp開発環境を新規に作ったのでメモ - eshamster’s diary」をそのまま再現してCentOS 6ベースで作った(1.0~1.3)のですが、Clozure CLの最新版が入らないなど問題しかないので、CentOS 7をベースに作り直しました(2.0~)。やっていることは変わらないので気になった部分だけメモ。

  • CentOS 7化周りの話
    • 一番困った点はw3mのインストール(emacsからのHyperSpec閲覧用)です。標準リポジトリからなくなったので、ソースからビルドが必要ですが、単純にはできません。「[CentOS7] emacs24にemacs-w3mインストール - Qiita」にあるように細工が必要です
      • もうサポートしないということかと思うので、移行先を探すのが正道ですかね…
    • roswellのビルドには標準リポジトリのautoconfで十分でした
      • roswellのバージョンを固定した方がいいか迷いどころですが、適宜最新化しながら使う予定なので都度対応で良いかなと
    • Emacsは24系であればいいので、CentOS 7ならyumでいいはず…と思っていたら、yumで入る24.3では動かないEmacs拡張(どれかは忘れました)がありました。そのため、結局ソースから24.5を入れました
      • 探した範囲ではCentOS 7用の24.5のrpmは見つからなかったので、ソースからのビルドという手段を塞がれた場合CentOS 6より厄介かもしれません…
  • その他の話
    • ビルド時点でsbcl, sbcl-bin, ccl-binを入れていますが、コンテナの容量が膨らむので微妙かもしれません…
    • 同じく容量が膨らむのでEmacs拡張をインストールするためのRUN emacs --batch --load .emacs.d/init.elも…

実際に使うとき

実際に開発に利用する上ではeshamster/cl-develだけでは不足です。GitHubにpushするためのSSH鍵の設定や、コンテナ終了後もデータを残すためのボリュームの設定等が必要です。とはいえ、こうしたパーソナルな設定を公開Dockerfileに書くのも違う気がします。

そのため、下記の3ファイル(Dockerfile, 設定ファイルのsetenv, 起動用のrun.sh)とSSH*4を用意し、run.shを叩いてコンテナを起こしています。なお、ホストのマウント先に指定した${HOME}/work/lispは事前にchown -R 1000:1000 ${HOME}/work/lisp*5と所有者設定をしておかないとゲスト側から触れません。

run.shでコンテナを起動した後は、emacsを立ち上げ*6M-x slimeですぐにslimeが使えます。保存の必要なものは~/work/lisp以下に保存します。また、コンテナをdetach*7した後は、docker attach clで再接続できます(プロセス名clsetenvで設定)。

  • Dockerfile
FROM eshamster/cl-devel:2.0

# --- git settings --- #
RUN git config --global user.name "<ユーザ名>" && \
    git config --global user.email "<メールアドレス>"

# --- ssh settings --- #
ARG user=dev

ARG SSH_HOME=/home/${user}/.ssh
RUN mkdir ${SSH_HOME} && \
    chmod 700 ${SSH_HOME}

USER root
COPY id_rsa ${SSH_HOME}
COPY id_rsa.pub ${SSH_HOME}
RUN chown ${user}:${user} ${SSH_HOME}/* && \
    chmod 600 ${SSH_HOME}/*

# --- other settings --- #
USER ${user}
RUN ros install prove
RUN echo "export PATH=${HOME}/.roswell/bin:${PATH}" >> ${HOME}/.bashrc
RUN echo "export LANG=ja_JP.UTF-8" >> ${HOME}/.bashrc
  • 設定ファイル(setenv)*8
export HOST_PORT=17380
export GUEST_PORT=18616
export RUN_NAME=cl
  • 起動用シェル(run.sh)
#!/bin/bash

set -eu

. "${1:-$(dirname ${0})/setenv}"

docker rmi $(docker images | awk '/^<none>/ { print $3 }') || echo "ignore rmi error"
docker rm `docker ps -a -q` || echo "ignore rm error"

docker build -t cl .
docker run --name=${RUN_NAME} -p ${HOST_PORT}:${GUEST_PORT} -e "OPEN_PORT=${GUEST_PORT}" -e "HOST_PORT=${HOST_PORT}" -v ${HOME}/work/lisp:/home/dev/work/lisp -it cl /bin/bash

感想

上記の環境が整ってしまえば、後はrun.shをたたくだけで簡単にフレッシュな環境が得られるので良い感じです(気づいたら環境が壊れて色々動かなくなった…となってもすぐ戻せますし)。しばらく使ってみましたが、Dockerを1.11にアップデートしてEmacsの描画問題が解決してからは快適に利用できています。

後続の関連記事

eshamster.hatenablog.com

eshamster.hatenablog.com


*1:実はそのゴミ(だと思っていたもの)のおかげで動いていたとか、設定に書いていない元々入っていたもののおかげで動いていたとか、心配性なのでその辺りがどうしても気になります…

*2:曖昧な言い方になっているのは、きちんと調査できていないためです。本当に1.11にアップデートしたことで解消されたのか半信半疑です…

*3:DocekrHubとGitHubの連係機能を後から知ったので連係できていないという…。後からできるのでしょうか

*4:.pubの方は必須ではないですが、一緒に持っておかないと対応が分からなくなりそうなので…

*5:設定すべきID(ここでは1000番)はゲスト側で/etc/passswdを見れば確認できます

*6:最初からrun.shで/usr/bin/emacsを立ち上げても良い気がします。Emacsの走る環境も触れた方が良いかと思い、/bin/bashで立ち上げています

*7:なお、Dockerの初期設定ではdetachがCtrl-P Ctrl-Qという正気とは思えないキーバインドになっているので、「docker-1.10.0からデタッチキーが変更できるようになった - Qiita」あたりを参考に変更しましょう。Ctrl-Pはないよなあ…

*8:portの設定は必須ではないですが、Webアプリケーションを開発するような想定でつけています。ゲスト側ではGUEST_PORTで接続を待ち受け、つなぐ側はホストのHOST_PORTに繋ぎます

Dockerを1.10から1.11へアップデート on CentOS7

メモ記事

前説

前回の記事↓で首尾良く?Docker上でEmacsを動かせるようになったのは良いものの、表示が崩れまくって非常にストレスフルという問題がありました。

Docker上のEmacsのビルドでハマった話 - eshamster’s diary

調べてみると、Dockerの下記のissueが引っ掛かりました。バージョン1.7~1.10では壊れてるけど、1.11で直るとのこと。現時点(2016/7/31)ではCentOSのデフォリポジトリからとれるのは1.10だったので、1.11にアップデートした次第です。

regression terminal drawing on 1.7.1 · Issue #15373 · docker/docker · GitHub

本題

とりあえずサービスを止めます。

$ sudo systemctl stop docker

Docker 1.10をサクッと消します*1

$ sudo yum remove docker docker-selinux docker-common

Docker 1.11のリポジトリを登録します。

$ sudo cat<<EOF>/etc/yum.repos.d/docker.repo
[dockerrepo]
name=Docker Repository
baseurl=https://packages.docker.com/1.11/yum/repo/main/centos/7
enabled=1
gpgcheck=1
gpgkey=https://yum.dockerproject.org/gpg
EOF

インストール&起動(完)。

$ sudo yum install docker-engine   # "docker"ではない
$ sudo systemctl start docker      # サービス名やコマンドは"docker"で変わらず

少し使ってみたところ、Emacsの表示が崩れなくなり大変快適になりました。ただ、pareditの挙動が相変わらずあやしい…。


*1:docker-commonの削除が常に必要かは不明です。自身の環境ではこれも消しておかないと、コンフリクトで1.11のインストールに失敗しました。

Docker上のEmacsのビルドでハマった話

Docker上でEmacsをビルドしようとしてハマったので対処方法と、ついでに簡単に調査したメモです。

現象

環境は次のような感じでした。

  • ホスト: CentOS 7.2 (Conoha VPSのデフォルトイメージ利用)
  • Docker 1.10.3

まず、確認用に次のDockerfileを用意します。なお、centos:7としても現象は同じでした(ただし、yumのインストール対象にmakeを追加する必要があります)。

FROM centos:6

ARG emacs=emacs-24.5
RUN yum install -y gcc lcurses-devel wget ncurses-devel

ARG work_dir=/tmp/setup
RUN mkdir ${work_dir}

RUN cd ${work_dir} && \
    wget http://mirror.jre655.com/GNU/emacs/${emacs}.tar.gz && \
    tar zxf ${emacs}.tar.gz && \
    cd ${emacs} && \
    ./configure --without-x && \
    make

これをビルドしてみると・・・

$ docker build --no-cache -t test-emacs-build .
~略~
Finding pointers to doc strings...
Finding pointers to doc strings...done
Dumping under the name emacs
**************************************************
Warning: Your system has a gap between BSS and the
heap (22442648 bytes).  This usually means that exec-shield
or something similar is in effect.  The dump may
fail because of this.  See the section about
exec-shield in etc/PROBLEMS for more information.
**************************************************
/bin/sh: line 7:  5952 Segmentation fault      (core dumped) ./temacs --batch --load loadup bootstrap
make[1]: *** [bootstrap-emacs] Error 1
make[1]: Leaving directory `/tmp/setup/emacs-24.5/src'
make: *** [src] Error 2

makeで死にます。

対処方法その1

とりあえず、メッセージに従ってetc/PROBLEMS(テキストファイル)でexec-shieldを検索してみます。見てみると、Linuxのセキュリティ機構であるExec-shield(プロセスのメモリ配置のランダム化?)が問題のようです。

解決方法だけ抜粋すると、下記の通りです。

    echo 0 > /proc/sys/kernel/exec-shield
    echo 0 > /proc/sys/kernel/randomize_va_space

ということで以下のようにして、「ホスト側で」一時的にrandomize_va_spaceを無効化してからdocker buildすればOKです(exec-shieldの方は無関係でした)。

$ cat /proc/sys/kernel/randomize_va_space
2
$ sudo bash -c "echo 0 > /proc/sys/kernel/randomize_va_space"
$ docker build --no-cache -t test-emacs-build .

emacsのビルド部分が通った後はrandomize_va_spaceを元に戻して問題ありませんでした。といっても、Emacsのビルド部分を通るたびにこれが必要なのは何かと不便そうです。

少し調査

randomize_va_spaceというキーワードが手に入ったのでGoogle先生に聞いてみると、次のissueが引っ掛かりました。

Ubuntu 16.04: Dockerfile cannot build emacs · Issue #22801 · docker/docker · GitHub

これはDocker側のissueですが、ここからEmacs側のスレッド(同じ人?)にもリンクが張られています。

https://debbugs.gnu.org/cgi/bugreport.cgi?bug=23529

で、斜め読みしかしていないのですが、Emacsのスレッドで示されている下記コードのpersonalityというsyscallが問題になっているようです。これで、一時的にrandomize_va_spaceに0をセットするのに相当する操作をしているようですが、これがDockerのゲスト上ではうまく働かない(ホスト側を変更する必要があるのにそれができない)ということだと思います。

https://github.com/emacs-mirror/emacs/blob/master/src/emacs.c#L802-819

結局のところ、Docker側がpersonalityが動作するようなオプションを入れるかEmacs側がこの動作を修正するかですが、前者はDockerのポリシー的におそらく難しく、後者は望ましいが技術的に難しいという話になっているようです(斜め読みなので違ったらすみません)。

対処方法その2

最新版の利用や細かいバージョンの指定ができないのは残念ですが、この辺りの融通が効くのであれば大人しくRPM使っとけというのが多くの場合正しいでしょう。

個人的には24系が入ればそれで良かったので、CentOS6系であれば、「centos6.5にemacs24.5をrpmからインストールする | joppot」を参考に以下のようにすればOKでした。なお、CentOS7系であれば単にyum installするだけで24系のEmacsが入るはずです。

FROM centos:6

RUN yum install -y gcc lcurses-devel wget ncurses-devel gpm-libs alsa-lib perl gnutls-devel

RUN cd /etc/yum.repos.d && \
    wget https://gist.githubusercontent.com/AaronTheApe/5540012/raw/5782a8d6a95f76daeed6073dc0c90612fefe2fb3/emacs.repo && \
    yum --disablerepo="*" --enablerepo="emacs" --nogpgcheck -y install emacs-nox

追記(2016/08/11)

今現在は/proc/sys/kernel/randomize_va_spaceが2でも、上記の問題は起きず問題なくビルドできています。

Emacsの描画崩れの問題でDocker側を1.11にアップデートしたのですが(参考:「Dockerを1.10から1.11へアップデート on CentOS7 - eshamster’s diary」)、その影響でしょうか?ただ、上記のissueの時点では1.11.1や当時のmaster(1.12)でも再現しているようですが…。続報もないので(また、改めて1.10に戻して試す気もないので)結局良く分からないです。

一応バージョンはissueの時点よりも少し進んで、1.11.2だという差はあります。

$ docker --version
Docker version 1.11.2-cs3, build c81a77d

JavaScriptのモジュール定義構文をParenscriptで抽象化(マクロで遊ぶ)

前書き

JavaScriptを書いていて「ここでマクロがあれば…」と思う事案があったので、マクロ欲を満たすためのエントリです。

JavaScriptでのモジュール定義

JavaScriptcounterモジュールを作ってみます。

var counter = (function() {
  var count = 0;
  var add = function(x) { // こんな感じでprivateな関数も書けます、というためだけに用意した関数
    count += x;
    return count;
  };
  
  return {
    get: function() { return count; },
    increment: function(x) { return add(x); },
    decrement: function(x) { return add(-x); }
  };
}());

// 使い方
counter.get();         // -> 0
counter.increment(10); // -> 10
counter.decrement(3);  // -> 7
counter.get();         // -> 7

モジュール定義用の構文という訳でもないですが、下記のような基本的な要素の組み合わせでクラスっぽい機能が実現できています。暗記アレルギーな人間としては、こういう考えれば辿れる系のものは覚えやすくて好きです。

  • クロージャ
  • ハッシュの要素にはドットでアクセス可能
  • 変数を通した関数アクセスに(Common Lispのfuncallのような)特別な処理は不要

とはいえ、何度も書いているとやはり面倒です。ここでマクロがあれば…ということで、Common Lisp(のサブセット)をJavsScriptに変換するライブラリParenscriptを使ってCommon Lispで書きなおしてみます。

Parenscriptで書き直す

準備:JavaScriptと(ほぼ)1対1の書き方へ

Parenscriptで上記のJavaScriptと1対1に対応するコードを書くには少し準備が必要です。

Parenscriptではなぜかhash-tableがサポートされていないので、とりあえず必要なサブセットだけサポートします*1

(defpsmacro make-hash-table ()
  `(@ {}))

(defpsmacro gethash (key hash-table)
  `(aref ,hash-table ,key))

まずはこれを直接使って書いてみます。

(defun make-js-module-1 ()
  (ps (defvar counter
        (funcall (lambda ()
                   (let* ((count 0)
                          (add (lambda (x)
                                 (incf count x)))
                          (public-body (make-hash-table)))
                     (setf (gethash :get public-body)
                           (lambda () count)
                           (gethash :increment public-body)
                           (lambda (x) (add x))
                           (gethash :decrement public-body)
                           (lambda (x) (add (* x -1))))
                     public-body))))))

少し脇道ですが、make-js-module-1関数を呼び出すと次のようなJavaScriptコードが得られます。

var counter = (function () {
    var count = 0;
    var add = function (x) {
        return count += x;
    };
    var publicBody = {  };
    publicBody['get'] = function () {
        return count;
    };
    publicBody['increment'] = function (x) {
        return add(x);
    };
    publicBody['decrement'] = function (x) {
        return add(x * -1);
    };
    return publicBody;
})();

さて、純JSなコードに比べると、make-js-module-1では一時変数public-bodyを利用していたりと、ハッシュの扱いが不格好です。Common Lispにハッシュの初期化構文に相当するものがないためですが、なければ作ればよいですね。

(defmacro+ps init-hash-table (&rest pairs)
  (let ((hash (gensym)))
    `(let ((,hash (make-hash-table)))
       ,(cons 'setf (mapcan (lambda (pair)
                              `((gethash ,(car pair) ,hash)
                                ,(cadr pair)))
                            pairs))
       ,hash)))

これを使ってmake-js-module-1を書き直すと次のようになります。

(defun make-js-module-2 ()
  (ps (defvar counter
        (funcall (lambda ()
                   (let* ((count 0)
                          (add (lambda (x)
                                 (incf count x))))
                     (init-hash-table
                      (:get (lambda () count))
                      (:increment (lambda (x) (add x)))
                      (:decrement (lambda (x) (add (* x -1)))))))))))

これで純JSのコードと大体1対1の対応になったので、ようやくスタートラインです。

マクロでイディオムを隠蔽する

まずは、頭のfuncalllambdaが鬱陶しいのでdefmoduleマクロで隠してみます。

;; make-js-moduleと番号を合わせるため1, 2は欠番
(defmacro+ps defmodule-3 (name &body body)
  `(defvar ,name
     (funcall (lambda ()
                ,@body))))

(defun make-js-module-3 ()
  (ps (defmodule-3 counter
        (let* ((count 0)
               (add (lambda (x)
                      (incf count x))))
          (init-hash-table
           (:get (lambda () count))
           (:increment (lambda (x) (add x)))
           (:decrement (lambda (x) (add (* x -1)))))))))

これだけだと、むしろ分かりにくくなっています。funcalllambdaが消えたことで、let*init-hash-tableの意味合いが不明瞭になったためです。

ということで、次の「ルール」を導入することで、この2つを隠します。

  • モジュール名の次にはプライベートな名前・値のペアをリストで渡す
  • 以降はパブリック名前・値のペアを並べる
(defmacro+ps defmodule-4 (name private-vars &body body)
  `(defvar ,name
     (funcall (lambda ()
                (let* ,private-vars
                  (init-hash-table ,@body))))))

(defun make-js-module-4 ()
  (ps (defmodule-4 counter
        ((count 0)
         (add (lambda (x)
                (incf count x))))
        (:get (lambda () count))
        (:increment (lambda (x) (add x)))
        (:decrement (lambda (x) (add (* x -1)))))))

だいぶすっきりしました。

さらに、パブリックな値の定義部分にあるlambdaを省略します。ただし、定数を直接公開するような使い方ができないという制限がつきます*2

(defmacro+ps defmodule (name private-vars &body body)
  `(defvar ,name
     (funcall (lambda ()
                (let* ,private-vars
                  (init-hash-table
                   ,@(mapcar (lambda (method-def)
                               `(,(car method-def) (lambda ,@(cdr method-def))))
                             body)))))))

(defun make-js-module ()
  (ps (defmodule counter
        ((count 0)
         (add (lambda (x)
                (incf count x))))
        (:get () count)
        (:increment (x) (add x))
        (:decrement (x) (add (* x -1))))))

そんな訳でBefore, Afterです。いくつかの「ルール」や制限*3の導入と引き換えに、モジュール作成に本質的には無関係なキーワードがきれいサッパリなくなりました。

1対1のコードから、たった8行でこれを実現できるLispのマクロは実に強力で気分が良いです。

// Before
var counter = (function() {
  var count = 0;
  var add = function(x) {
    count += x;
    return count;
  };
  
  return {
    get: function() { return count; },
    increment: function(x) { return add(x); },
    decrement: function(x) { return add(-x); }
  };
}());
;; After
(defmodule counter
  ((count 0)
   (add (lambda (x)
          (incf count x))))
  (:get () count)
  (:increment (x) (add x))
  (:decrement (x) (add (* x -1))))

マクロの功罪

今回の狭い範囲から見えるマクロの功罪は次のような感じでしょうか。

    1. 構文を簡単に抽象化できる
    2. マクロ名で元になった構文の意図を明確にできる
    1. 構文を簡単に抽象化できすぎる
    2. 知らなければならないルールが増える
    3. 意図的かどうかを問わず、何らかの制限がつく

何か書こうかと思っていましたが、こう並べてみると抽象化一般の功罪と変わらないですね。プログラムの中でもより基盤に近い部分を触るので、影響がより際立つ感じでしょうか。

コード貼り付け

最後に、ここまでを一通りまとめたRoswellスクリプトです。

*1:オプションが足りないのは見て通りですが、他に問題として 'hoge のようなquoteされたシンボルをキーにできないという問題があります。対応するには(quote hoge)のようなリストが来た場合に、hogeの部分を取り出すようにする必要があります。

*2:atomが来たらそのまま返すようにマクロを拡張することで対応は可能です

*3:ルールを追加することで制限を緩和することは可能で、トレードオフの関係です。

[JavaScript] ブラウザからSuperAgentでファイルをPOST

ブラウザからSuperAgentでファイルをPOSTしようとしてハマったのでメモ。なお、SuperAgentAJAX通信に特化した軽量なJavaScriptライブラリです。

SuperAgent紹介記事リンク:jQuery.ajaxの代わりにSuperAgentを使う - Qiita

ハマった部分

まず、HTMLでformのsubmitを使ってファイルを送る場合は次のようになります。enctype="multipart/form-data"が唯一ポイントで、後はtype=fileなinputを利用するだけです。

<form name="main_form" action="/some-url" enctype="multipart/form-data" method="POST">
  <input name="submit_file" type="file">
  <input type="submit" value="ファイル送信">
</form>

もう少し柔軟に制御したかったのでSuperAgentで自分でAJAX通信をしようと思いました。そこでドキュメントを見ると、ファイルを送るには.attach(name, [path], [filename])関数を使うように書いてあります。

// SuperAgentのドキュメントから引用
 request
   .post('/upload')
   .field('user[name]', 'Tobi')
   .field('user[email]', 'tobi@learnboost.com')
   .attach('image', 'path/to/tobi.png')
   .end(callback);

第2引数のpathって何さと思い、フルパスを渡してみたりと色々的はずれな試行錯誤をしていました。しかし、どうやらこの記述はNode.jsすなわちサーバ側で利用する場合の説明であって、ブラウザ側ではまた違うものを渡す必要があるようです。

そしてそのブラウザ側での話は書かれていない(はず)…。

結論

結局どうするかですが、Fileオブジェクトを渡せば良いようです。冒頭のformを例に取ると、Fileオブジェクトは下記のように取り出せます。

document.main_form.submit_file.files[0]

実際、SuperAgentのソースで.attach()関数のコメントを見るとFileオブジェクトかBlobオブジェクトを渡せと書いてあります。

引用元:https://cdnjs.cloudflare.com/ajax/libs/superagent/1.2.0/superagent.js

/**
 * Queue the given `file` as an attachment to the specified `field`,
 * with optional `filename`.
 *
 * ``` js
 * request.post('/upload')
 *   .attach(new Blob(['<a id="a"><b id="b">hey!</b></a>'], { type: "text/html"}))
 *   .end(callback);
 * ```
 *
 * @param {String} field
 * @param {Blob|File} file
 * @param {String} filename
 * @return {Request} for chaining
 * @api public
 */

…なんとなく尻切れ感がありますが、他に書きたいこともないので終わり。

[Common Lisp] システム内のパッケージ間の関係をグラフ化

システム内に存在するパッケージ間の参照関係をgraphvizでグラフ化するRoswellスクリプトmake-package-tree.rosを書いてみました。リファクタリングに使える…かもしれません。

github.com

前説

これを作ったきっかけの話です。

Common Lispを始めた頃に、とりあえず練習用でオセロのプログラムを書いていました。単純なミニマックス探索(αβ法)と単純なモンテカルロ木探索(UCT)*1を備えていて、簡単なCUIインタフェースもつけてます。

そうして右も左も分からない中で書いたのがothello-clです*2。パッケージを分けたり、SBCL, CCLの両対応にしたりと、これをもう少し整えたものが下のcl-othelloです。

github.com

このとき、とりあえずテストを通すこと優先で各パッケージでひたすらexportしていたのですが、だいぶ余計なものをexportしている気がしました。そんなわけで、リファクタリングついでにグラフ化して見てみよう、というのが今回のスクリプトを作った動機です。

使用感

使い方

引数なしでヘルプが見れます。こうしたヘルプの生成兼コマンドライン引数の処理にはCL-CLIを利用しています。

$ ./make-package-tree.ros
./make-package-tree.ros [OPTION]... SYSTEM-NAME

 [ OPTIONS ]

Global options:
  -P,--only-package                Show only packages (doesn't show symbols)
  -o,--output        <file>        Place the output into <file> (default: 
                                   temp.png)
  -e,--exclude       <package names> Exclude packages from graph (if you 
                                   exclude multiple packages, write them 
                                   separating by space)
  • システム名には(ql:quickload ...)でロードできるシステムの名前(小文字可)を入れます
  • アウトプット名は特に解析していないので、拡張子に関わらずPNGしか出ません
  • excludeの複数指定は"cl-othello cl-othello.utils"のような感じです

次に適用結果の一部を拡大して見方を説明します。

f:id:eshamster:20160321034045p:plain

  • 四角いボックスはパッケージ
    • 内部の楕円はエクスポートしているシンボル
      • 入ってくる矢印は他パッケージからの参照
        • ただし、use-pacakgeされている場合は省略
    • 小さい円はパッケージ自身*3
      • 入ってくる矢印はuse-packageされていることを示す(上の例にはないですが…)
      • 出て行く矢印はシンボルをimportもしくはパッケージをuse-packageしていることを示す

cl-othelloに適用した結果

Before: おおむねothello-clからの移植が終わった時点。コミットID:ba72a26...

f:id:eshamster:20160321012823p:plain 原寸大リンク(3047x4615)

After: 記事時点のコミット。コミットID:eb3fe18...("CL-OTHELLO"パッケージをexclude)

f:id:eshamster:20160321032745p:plain 原寸大リンク(2925x4126)

なるほど、分からん。

まあパッと見をどうこうするというよりは、ざっと眺めていって、参照されてないシンボルがあるけどこれexport必要だっけ、とか、このパッケージのシンボル1個だけ参照してるけど不要な参照してないっけ、とかを考えるためのものです。

ちなみに、--only-packageをつけるとこんな感じの出力になります。汚い…。

f:id:eshamster:20160321161612p:plain 原寸大リンク(1035x943)

実装について

対象となるパッケージを取り出す

まずは、システム内のパッケージを一通り取り出す部分です。怪しげなので、もっと賢い方法があれば知りたいです…。

;; ロードメッセージ省略コードやreadtableを戻すコードは省略
(defvar *unprocessed-pack-list* nil)

(defun make-macroexpand-hook-fun (old-hook)
  (lambda (fun form env)
    (when (and (consp form)
               (eq (car form) 'cl:defpackage))
      (pushnew (cadr form) *unprocessed-pack-list*
               :test #'string=))
    (funcall old-hook fun form env)))

(defun load-target-package-list (system-name)
  (ql:quickload system-name)
  (let ((*macroexpand-hook* (make-macroexpand-hook-fun *macroexpand-hook*)))
    (asdf:load-system (intern system-name "KEYWORD") :force t)))

ここはql:quickloadのパッケージ名出力コードを参考にしています。*macroexpand-hook*にフックをかけて、defpackageが来たらそのパッケージ名をリストに入れるというのが基本的な考え方です。しかし、ql:quickloadでは依存パッケージが全て読まれてしまうため、どれが対象のsystem下のパッケージか分からないという問題があります*4。そこで次のような力業に出ています。

  1. とりあえずql:quickloadで全てロード
  2. 上記のフックをかける
  3. (asdf:load-system ... :force t)で対象システムを無理やり読み直す
    • 依存システムはロード済みなので、対象システム下のパッケージだけがとれる…はず

参照している他パッケージのシンボルを取り出す

残りは末尾に全コードを貼り付けたので、書きたいところだけ簡潔に…。

どのパッケージのシンボルをインポートしているかを調べる処理のメインはinterpret-package関数です。do-symbolsで各パッケージ内の全シンボルを調べて、exportされているシンボルと、同システム内の別パッケージから継承したシンボルを記録しています。これで漏れが出ない…はず。

また、パッケージ間の関係を木構造(正確には有向グラフ?)と見た場合、幅優先探索の順序でパッケージを見ています(起点は上記のパッケージ探しで最初に見つけたもの)。この方がgraphviz上で元の木構造に近い形が得られやすいためです。実際、深さ優先探索版をcl-othelloに適用したところ、ほぼ全パッケージが縦に並んでしまい、うまく配置できないようでした。ただ、こうした探索自体が歴史的経緯*5で必要だったもので、今なら単に上記で見つけた順で問題ない気もします。

グラフ化

graphviz用のコードを出すためにs-dotというライブラリを利用しています。graphvizのドット形式をS式で書くためのDSL兼レンダラです。

ただ困ったことに、DSLのキーワードであるnodeやらedgeやらが全てs-dotパッケージのシンボルとeq判定をとっていて、しかもexportされていません…*6。一個や二個ではないので、対症療法としても一々s-dot::nodeのように書くのも面倒です。そんなわけで、下記のリードマクロで$nodeのように書けるようにしています。

(set-macro-character #\$ #'(lambda (stream &rest rest)
                             (declare (ignore rest))
                             (let ((sym (read stream nil)))
                               (intern (symbol-name sym) "S-DOT"))))

全コード

この記事時点のコードを貼り付けます。

gist.github.com

感想

こうメタな情報に普通にアクセスできるのはなんだか気分がいいですね。


*1:モンテカルロ木探索といえばAlpha Goが話題ですね。Deep Learningばかり話題になっている感もありますが、2004年に登場したモンテカルロ木探索というブレイクスルーあってのものだとこっそり主張しておきたかったりします。個人的には、モンテカルロ木探索がDeep Learningという翼を得てさらに飛翔するのか、翼だけ飛んでいってしまうのか気になってます。

*2:「clなんとか」という名前順になっていない辺り分かってなかった感が目に見えます

*3:本当はボックス(cluster)から直接線を伸ばしたいのですが、それができないので代替手段です

*4:quickloadの方は依存パッケージも全て出力するのでこの問題は関係ありません

*5:元々system内のパッケージ一覧を取り出す方法を思いつかなかったので、システム名と同名のパッケージがあると仮定(ないとエラー)して、そこから辿っていました

*6:まあ大量にexportされても困るのでキーワードにしておいて欲しかったという話です。実際、キーワード利用に変更したs-dot2というプロジェクトがあったりします(quicklispのリポジトリには登録されていませんが…)