LINEでオウム返しボットを作ってみました(LISP)
こんにちは
この記事は、Aizu Advent Calendar 2021の21日目の記事です。 (遅刻したけど許して…)
LINEでオウム返しボットを作りました
どうもこんばんは，Enderedです。今回Advent CalendarということでLINEのオウム返しボットを作りました。
開発環境
- サーバ
- Vultr(VPSって安いですね)
- 言語
- ライブラリ
- clack (サーバ要因1)
- ningle (サーバ要因2)
- cl-json
- dexador (LINEAPIにデータを送るため)
- その他
- nginx (HTTPS通信のため)
実装
localhost/parrot以下にLINE用のAPIをはやします。
(defpackage :parrot.view (:use :cl :parrot.util) (:export :*app*)) (in-package :parrot.view) (defvar *app* (make-instance 'ningle:<app>)) (setf (ningle:route *app* "/parrot" :method :POST) (lambda (params) (parrot.util:with-protect-to-json (let* ((events (car (parrot.util:access params "events"))) (message (or (parrot.util:access events "message" "text") "NO MESSAGE")) (reply-token (or (parrot.util:access events "replyToken") "INVALID"))) (dexador:post parrot.config:*post-url* :headers `(("Content-Type" . "application/json") ("Authorization" . ,(format nil "Bearer ~a" parrot.config:*access-token*))) :content (json:encode-json-to-string (list (cons "replyToken" reply-token) (cons "messages" `((("type" . "text") ("text" . ,message)))))))) '(("status" . "OK")))))
(defpackage :parrot.util (:use :cl) (:export :parse-number :with-protect-to-json :access)) (in-package :parrot.util) (defun access (data &rest path) (reduce (lambda (data path) (cdr (assoc path data :test #'equal))) (cons data path))) (defmacro with-protect-to-json (&body body) `(handler-case `(200 (:content-type "application/json") (,(json:encode-json-to-string (progn ,@body)))) (error (e) `(500 (:content-type "application/json") (,(json:encode-json-to-string `((:|error| . ,(format nil "~A" e)))))))))
JS関連の実装例を読んでいるとfetch関数にpayloadというフィールドを含んだデータを渡しているので，なんだろうと思ってたらcontentのことでした(ここで2時間くらい止まりました)。
おまけ
文字列をただ受け取ってただ返すだけのプログラムを書くのは退屈ではありませんか？(そうでない人は精神が強いです)。なので，S式を受け取ったら評価した結果を返すプログラムを書きましょう。
仕様
トークナイザの実装と内部表現に変換するために，受け取るS式の仕様を考えます。今回は簡単なS式を評価したいだけなので，括弧がS式の開始と終了でそれ以外はシンボルとして扱います。
トークナイザ
先程の仕様から，トークナイザを実装します。リーダマクロ等がないのでここは簡単です。
(defun inject-space (str) (map 'string #'identity (loop for ch across str if (or (eq ch #\() (eq ch #\))) append (list #\space ch #\space) else append (list ch)))) (defun split (str del) (let ((pos (search del str :test #'equal))) (if pos (cons (subseq str 0 pos) (split (subseq str (+ pos (length del))) del)) (list str)))) (defun split-by-space (str) (remove "" (split (map 'string (lambda (v) (if (or (eq v #\tab) (eq v #\newline)) #\space v)) str) " ") :test #'equal)) (defun split-s-expression (str) ;; トークナイザのトップレベル (split-by-space (inject-space str)))
括弧の前後にスペースを注入して，その後にスペースがある位置で文字列を分割・邪魔なデータを取り除くだけです。
内部表現への変換
トークナイザ後のデータからS式を構築します。S式を次のようなBNFで定義します。
TOP ::= VALUE | PAREN
VALUE ::= 括弧以外の文字列
PAREN ::= "(" {TOP} ")"
S式は単純でいいですね，それでは書いていきます。
(defun parse-s-expression (str) (labels ((top (lst) (let ((v (paren lst))) (when v (return-from top v))) (let ((v (value lst))) (when v (return-from top v)))) (value (lst) (if (or (null lst) (equal "(" (car lst)) (equal ")" (car lst))) nil lst)) (paren (lst) (unless (equal (car lst) "(") (return-from paren nil)) (labels ((rec (lst) (let ((v (top lst))) (cond (v (let ((v2 (rec (cdr v)))) (when v2 (cons (cons (car v) (car v2)) (cdr v2))))) (t (when (equal (car lst) ")") (cons nil (cdr lst)))))))) (rec (cdr lst))))) (let ((res (top (split-s-expression str)))) (and res (not (cdr res)) (car res)))))
eval
あとは自作Lispに好きな関数/マクロ定義を追加するだけですね。
(defun line-eval (str) (labels ((rec (lst values) (format t "~a:~a~%" lst values) (unless lst (return-from rec nil)) (when (stringp lst) (return-from rec (cond ((parse-integer lst :junk-allowed t) (parse-integer lst :junk-allowed t)) (t (cdr (assoc lst values :test #'equal)))))) (let ((op (car lst))) (cond ((equal op "if") (if (print (rec (nth 1 lst) values)) (rec (nth 2 lst) values) (rec (nth 3 lst) values))) ((equal op "<") (apply #'< (mapcar (lambda (arg) (rec arg values)) (cdr lst)))) ((equal op ">") (apply #'> (mapcar (lambda (arg) (rec arg values)) (cdr lst)))) ((equal op "<=") (apply #'<= (mapcar (lambda (arg) (rec arg values)) (cdr lst)))) ((equal op ">=") (apply #'>= (mapcar (lambda (arg) (rec arg values)) (cdr lst)))) ((equal op "=") (apply #'= (mapcar (lambda (arg) (rec arg values)) (cdr lst)))) ((equal op "/=") (apply #'/= (mapcar (lambda (arg) (rec arg values)) (cdr lst)))) ((equal op "lambda") (lambda (args) (let ((values (append (mapcar #'cons (second lst) args) values))) (car (last (mapcar (lambda (body) (rec body values)) (cddr lst))))))) ((equal op "labels") (let ((next-values (append (mapcar (lambda (func) (cons (car func) nil)) (cadr lst)) values))) (mapc (lambda (func) (setf (cdr (assoc (car func) next-values :test #'equal)) (rec `("lambda" ,@ (cdr func)) next-values))) (cadr lst)) (car (last (mapcar (lambda (body) (rec body next-values)) (cddr lst)))))) (t (let ((args (mapcar (lambda (arg) (rec arg values)) (cdr lst)))) (funcall (cdr (assoc op values :test #'equal)) args))))))) (handler-case (format nil "~a" (rec (parse-s-expression str) (list (cons "+" (lambda (args) (apply #'+ args))) (cons "-" (lambda (args) (apply #'- args))) (cons "*" (lambda (args) (apply #'* args))) (cons "/" (lambda (args) (apply #'/ args))) (cons "funcall" (lambda (args) (funcall (car args) (cdr args))))))) (error (e) (declare (ignore e)) "ERROR"))))
とりあえずで語尾に"天才ですから"を追加しましたが，軽く後悔しています。
感想
LINEでオウム返しボットを作るのは楽しいですね。
