六月の開発局

「業界の人」じゃないよ

野蛮なアプリの作り方

この記事はLisp Advent Calendar 2017の15日目の記事である。

僕は仕事で主にPHPという大変手軽なプログラミング言語を使っている。この言語は非常によくできていて、初心者でも簡単に扱えるにも関わらず、かなり実用的なアプリケーションを作ることができる。IntelliJ IDEAという強力なIDEの支援をうけることで、効率的に書くこともできる。非常に優れたプログラミング言語だ。なにしろ、僕の日銭はすべてこの言語によってもたらされているのである。ダメな言語なら、それができないだろう。

しかし、僕は肝心な多くのソフトウェアをCommon Lispというプログラミング言語で書いている。Common LispにはPHPには到底出来ないとてつもない機能をいくつか持っているが、何より大変簡単でわかりやすい。主な文法が一つしか存在しないので、奇妙なことをしない限り、文法に悩む必要がほぼない。僕はあまりおつむがよろしくないので、こういう言語でないと、複雑な仕事ができない。他にも魅力的な数々の特徴を持っているが、この記事ではちょっとしたアプリケーションを作ることで、この言語がいかに単純な作りでいろいろできるかを見せられたらと思う。

アプリケーション、応用ソフトウェアをどう定義するかが問題だが、僕は「用事を済ませられるならそれはすべてアプリケーション」と定義している。なにかデータを送り込んでやり、それを加工して、取り出すのがコンピュータに仕事をさせる基本形態であり、それを行うのがアプリケーションだ。だから、この記事で作ったプログラムにデータを送り込み、加工して出力させることにしよう。

どうせこんな記事を読む人間はよくわかっているはずだから、処理系とQuicklispのインストールぐらい自分でなんとかできるだろう。では、始めよう。

(ql:quickload "hunchentoot")

手始めにHTTPサーバを作ることにしよう。hunchentootはCommon LispにおけるApacheのようなものだ。ユーザはこいつにリクエストを投げつけて、こいつからJSONを送り返してもらう。そういうアプリケーションを作ろう。うまい具合に画面をこしらえるのはVue.jsとかそういうのが得意なものに任せれば良い。もちろんCommon LIspでHTMLを吐かせることもできるが、そういうことをすると非常にややこしい道具を量産しなければならなくなることがわかっている。餅は餅屋、画面を描くのが得意なものに画面を任せればよいのだ。

そうだ、作業をするためのパッケージも一つ用意しておいたほうがいいだろう。

(defpackage :app
  (:use :common-lisp
        :hunchentoot)
  )
(in-package :app)

以後このappパッケージのなかでコトを進めることにしよう。

なにはともあれHTTPサーバをこしらえよう。

(defvar *main-acceptor* (make-instance 'easy-acceptor :port 2001))

defvar*main-acceptorという変数を宣言し、そこに2001番ポートを利用するACCEPTORを束縛する。ACCEPTORとはなんぞやと思うと思うが、リクエストを受け取るものだからこういう名前がついているのだ。

このhunchentootという道具は非常に行儀が悪く、グローバル変数を多用して行動するので、先に必要なものを確保しておこう。

(defvar *debug-output* *standard-output*)

*standard-output*は読んでの通り標準出力だが、hunchentootはこれを乗っ取ってしまって、こっちがprintデバッグを試みた時に内容をアルファ・ケンタウリに持ち去ってしまう。だからこうして*debug-output*に束縛しておこう、というわけだ。

(defun print-debug (var)
  (format *debug-output* "~a~%" var))

関数を一つ宣言しておく。こいつがあれば、怪しい変数を標準出力に書き出せるから、困ったらこれを使えば良い。

(start *main-acceptor*)

おもむろにACCEPTORを起動しよう。これで手持ちのウェブブラウザからhttp://localhost:2001/にアクセスすれば、Welcomeページが見える筈だ。標準出力にはログも出てくるだろう。

127.0.0.1 - [2017-12-14 22:11:34] "GET / HTTP/1.1" 200 393 "-" 
127.0.0.1 - [2017-12-14 22:11:34] "GET /img/made-with-lisp-logo.jpg HTTP/1.1" 200 12583 "http://localhost:2001/"

今はいわゆるindex.htmlを返しているわけだが、これがこっちの作った関数の返り値を返すようにしてやれば、その関数を好き勝手いじるだけでアプリができる、という寸法だ。実に手軽である。

さて、いきなりだが、こういうものを作っておこう。

(defun handler ()
  (setf (header-out "Access-Control-Allow-Origin" *reply*) "*")
  (setf (header-out "Access-Control-Allow-Methods" *reply*) "GET, PUT, POST, DELETE, OPTIONS")
  (setf (header-out "Access-Control-Allow-Headers" *reply*) "Content-type")
  (setf (header-out "Content-type" *reply*) "application/json; charset=UTF-8")
  (handler-case
      (case (request-method *request*)
        (:GET (get-handler *request*))
        (:PUT (put-handler *request*))
        (:DELETE (delete-handler *request*))
        (:POST (post-handler *request* )))
    (t (e) (print-debug e))
    )
  )

いきなり巨大な関数が出現して面食らったかもしれないが、先にこいつを作っておいたほうが具合が良いのだから我慢してほしい。

まず、最初の3行だが、これはレスポンスヘッダにXSSではないよというおまじないを添付してブラウザを静かにするためのものだったはずだ。細かいことは自分で調べてほしい。最後の1行はもちろん「これからJSONを返すぜ、UTF-8のな」である。

さて、Common Lispが初めての諸兄の中にはhandler-caseを知らない方も多いと思うが、お察しの通り、これはいわゆるtry catchだ。(t (e) (print-debug e))とあるわけで、まあ例外が起きてしまったら、内容を出力して終わりにしよう。そしてhandler-caseの下にあるcaseは見れば分かる通り、リクエストのHTTPメソッドによって分岐していて、それぞれ別の関数を呼び出している。この関数を好きに書けばよい、というわけだ。まだこれらの関数は宣言していないから、警告を処理系が吐いただろうが、これから作ればよい。

ところで、このhandlerはまだACCEPTORに登録されていない。だからACCEPTORはリクエストを受け取ってもこのhandlerを呼び出してはくれない。ので、登録しよう。

(push (create-regex-dispatcher "^/[0-9a-zA-Z/_]*$" #'handler) *dispatch-table*)

*dispatch-table*はその名の通り、リクエストをどう処理するかを割り付けている表で、この表に正規表現マッチャが正を返した時にhandlerを呼び出す関数を割り付けた。この正規表現は見れば分かる通り、英数字とスラッシュそれからアンダースコアで構成された文字列にマッチする。適当なアドレスにアクセスすれば、標準出力にはエラーとログが出るだろう。

The function APP::GET-HANDLER is undefined.
127.0.0.1 - [2017-12-14 22:28:48] "GET /htkra HTTP/1.1" 200 - "-" 

get-handlerがないと怒られてしまったから、一つ用意しよう。

(defun get-handler (request)
  "{\"message\": \"Hello, world!\"}")

requestを使っていないじゃないか、と怒られると思うが、とりあえずこれでJSONを返すことはできた。

では何かデータを返したいものだから、データを用意しよう。データベースというとSQL系が思いつくが、あれは非常に難しいクエリを書かなければいけない。面倒だ。あれさえなければ資格欄にソフトウェア開発技術者を記すこともできたというのに。というわけで、ここではお手軽なデータベースを使うことにする。

(ql:quickload "bknr.datastore")
(defpackage :app
  (:use :common-lisp
        :hunchentoot
        :bknr.datastore)
  )

新たにbknr.datastoreをロードして、これをappパッケージから使えるようにした。とりあえずデータストアを立ち上げることにしよう。

(defvar *datastore* (make-instance 'mp-store
                       :directory (merge-pathnames "app-store/" (user-homedir-pathname))
                       :subsystems (list (make-instance 'store-object-subsystem))))

これで変数*datastore*に束縛されたデータストアを立ち上げることができた。諸々はホームディレクトリ以下app-storeの下に収めてある。

おもしろくもへったくれもないが、社員というクラスを用意しよう。ご覧の通り、姓名を記録することができるようになっている。

(define-persistent-class employee ()
  ((first-name :read :initarg :first-name :reader employee-first-name :type string)
   (last-name :read :initarg :last-name :reader employee-last-name :type string))
  )

では我々の会社に新入社員を迎えることにしよう。

(make-instance 'employee :last-name "Hiroshi" :first-name "SATO")

サトウ・ヒロシさんが入社してくれた。続いて、今の全社員、正確には今データストアに入っているものを出力してみよう。

(all-store-objects)

を評価すれば、

(#<EMPLOYEE ID: 0>) 

と、返ってくるはずだ。このたった一人のIDが0の社員がサトウさんらしいから、ちょっくら呼び出してみる。

(store-object-with-id 0)

とすれば

#<EMPLOYEE ID: 0>

当然だが、こうなる。彼がサトウさんか確認したければ、

(employee-first-name (store-object-with-id 0))

としてやれば

"SATO"

とくるはずだ。もうわかったかもしれないが、クラスをインスタンス化した瞬間にデータはデータストアに書き込まれている。 all-store-objectsしてその中から愚直に検索することもできるし、bknr.indicesindexed-classを用いればインデックスを貼ることもできる。

では、彼のデータをブラウザから呼び出せるようにしてやろう。まず、JSONのエンコーダを書くのは面倒なので、ライブラリに手助けしてもらおう。

(ql:quickload "yason")
(defpackage :app
  (:use :common-lisp
        :hunchentoot
        :bknr.datastore
        :yason
        )
  )

さて、このYASONにサトウさんをJSONエンコードさせるための処理を書こう。

   (defgeneric object-to-json (object))
    (defmethod object-to-json ((employee employee))
      (with-output-to-string (stream)
        (encode-alist (list (cons "id" (store-object-id employee))
                            (cons "first_name" (employee-first-name employee))
                            (cons "last_name" (employee-last-name employee)))
                      stream)
        )
      )

単に関数にしてもよかったのだが、様々なクラスのインスタンスJSONエンコードすることになることを想定して、総称関数object-to-jsonを宣言した。defmethodではobject-to-jsonの引数objectemployeeクラスのインスタンスだったときだけ、引数をemployeeとして処理を実行するようにしてある。YASONのencode-alistは連想リストをJSONエンコードし、ストリームに結果をかきこむ仕掛けになっているので文字列ストリームを用意してやった。

(object-to-json (store-object-with-id 0))

この結果は、こうなる。

"{\"id\":0,\"first_name\":\"SATO\",\"last_name\":\"Hiroshi\"}"

なお、Common Lispの総称関数は多重ディスパッチという方式が採用されている。これを駆使すると、例えば社員と部署どちらでも出力することになるIDの出力部分を一度しか書かない、といったことができるようになる。興味があったら調べてほしい。

さて、JSONエンコードもできたことだし、get-handlerを改良しよう、と言いたいところだが、先にエラー処理のための関数を書いておこう。

(defun error-message (status-code message)
  (setf (return-code *reply*) status-code)
  (with-output-to-string (stream)
    (encode-alist (list (cons "message" message)) stream)))

HTTPステータスコードとメッセージを受け取って、ステータスコードをセットして、メッセージをJSONに包んで返す関数である。利用されている*reply*がレスポンスを取り扱う変数である。HUNCHENTOOTはこの手の変数の扱いが大好きで多用するのだが、はっきり言って危険なのであまり好きではない。

(defun get-handler (request)
  (let ((id (get-parameter "id" request)))
    (when (null id)
      (return-from get-handler (error-message +http-bad-request+ "Parameter 'id' is not found.")))
    (let ((object (store-object-with-id (handler-case (parse-integer id)
                                          (t ()
                                            (return-from get-handler (error-message +http-bad-request+ "Parameter 'id' is not integer."))
                                            )))))
    (when (null object)
      (return-from get-handler (error-message +http-not-found+ (format nil "Object (ID=~a) is not found." id))))
    (handler-case (object-to-json object)
      (t ()
        (return-from get-handler (error-message +http-service-unavailable+ "Sorry, system cannot encode this object."))))
    )))

さあこれでget-handlerが一応の完成を見た。お好きなブラウザやcURLなどのソフトウェアからhttp://localhost:2001/?id=0を叩けばJSONエンコードされたサトウさんが、なにかやらかせばエラーメッセージが返ってくるはずである。

さて、ではよりアプリを拡張していくとして、と行きたいところだが、月曜日が40%オフの早期入稿締め切りなのである。ちょっとコツを教えておくと、POSTPUTで送られてきたデータは

(raw-post-data :force-text t :request request)

で取得できる。取得したJSONデータはYASONのparseメソッドでハッシュテーブルにして扱えるだろう。

ただし、DELETEのパラメタはget-parameterで取得できることを忘れてはいけない。

それから、オブジェクトはdelete-objectで削除できるし、スロットの値は(setf (slot-value object ‘slot-name) value)で設定できるが、これらは(with-transaction () (setf …))として、with-transactionで包んでやる必要がある。

好評だったら続きを書くかもしれないが、多分、ないだろう。