HTTPの説明の際に、URLを関数、リクエストパラメータを引数と例えることがあるようなので、実際に引数=リクエストパラメータとなるようにしてみました。
(asdf:load-system :cl-annot)
(asdf:load-system :alexandria)
(asdf:load-system :clack)
(defpackage annotation
(:nicknames a)
(:export httpfn/clack))
(defpackage http-as-function
(:use :cl)
(:nicknames httpfn)
(:export
:with-http-parameters
:*env*
:*request*))
(in-package :http-as-function)
(defparameter *request* nil)
(defparameter *env* nil)
;; clack.request:body-parameterはパラメータ名の大文字/小文字を区別するため、
;; 区別せずに値を取得できる関数を定義する。
(defun body-parameter-ci (request name)
(let ((plist (slot-value request 'clack.request::body-parameters)))
(loop
:for (k v) on plist by #'cddr
:when (string-equal k name)
:do (return-from body-parameter-ci v))
nil))
(defun query-parameter-ci (request name)
(let ((plist (slot-value request 'clack.request::query-parameters)))
(loop
:for (k v) on plist by #'cddr
:when (string-equal k name)
:do (return-from query-parameter-ci v))
nil))
(defmacro with-http-parameters ((&rest params) request &body body)
(let ((gparamfn (gensym))
(greq (gensym)))
`(let* ((,greq ,request)
(,gparamfn
(case (clack.request:request-method ,greq)
(:post #'body-parameter-ci)
(:get #'query-parameter-ci)
(T #'query-parameter-ci))))
(let
,(mapcar
#'(lambda (param)
(if (listp param)
`(,(car param) (funcall ,gparamfn ,greq ,(cdr param)))
`(,param (funcall ,gparamfn ,greq ,(symbol-name param)))))
params)
,@body))))
(defun defun->httpfn (defun-form)
(destructuring-bind (def name lambda-list &rest body) defun-form
(multiple-value-bind
(forms declarations doc-string)
(alexandria:parse-body body :documentation t)
(multiple-value-bind
(required optional rest key allow-other-keys? aux)
(alexandria:parse-ordinary-lambda-list lambda-list)
(when (or optional rest key allow-other-keys? aux)
(error "lambda-list error"))
`(,def ,name (httpfn:*ENV*)
,doc-string
,@declarations
(let ((httpfn:*REQUEST* (clack.request:make-request httpfn:*ENV*)))
(with-http-parameters ,required httpfn:*REQUEST*
,@forms)))))))
(cl-annot:defannotation a:httpfn/clack (defun-form) (:arity 1)
(defun->httpfn defun-form))
;; test
(cl-annot:enable-annot-syntax)
;; アノテーションを付けた関数
@a:httpfn/clack
(defun show-article (id)
"show the article specified by `id'"
(cond
((string= id "1")
`(200 (:content-type "text/html")
("<html><body>page 1</body></html>")))
(T
`(200 (:content-type "text/html")
("<html><body>unexpected id</body></html>")))))
;; アノテーションを付けない関数
(defun show-article-2 (id)
"show the article specified by `id'"
(cond
((string= id "1")
`(200 (:content-type "text/html")
("<html><body>page 1</body></html>")))
(T
`(200 (:content-type "text/html")
("<html><body>unexpected id</body></html>")))))
;; Clackでは属性リスト形式(key1 value1 key2 valu2 ...)でリクエストの内容が渡される
;;(show-article `(:request-method :get :query-string "id=1"))
;; -> (200 (:CONTENT-TYPE "text/html") ("<html><body>page 1</body></html>"))
;;(show-article-2 "1")
;;-> (200 (:CONTENT-TYPE "text/html") ("<html><body>page 1</body></html>"))
(clack.app.route:defroutes app
(GET "/" #'show-article))
(defparameter *app* (clack:clackup #'app :port 5555))
;;(clack:stop *app*)
Webページとして表示させるために、Clackを利用しました。
Hunchentoot、Clack、cl-annot、Alexandriaをインストール(すべてquicklispでインストール可能)後、上記のコードを実行すると、5555ポートでWebサーバが立ち上がります。
http://localhost:5555/ にアクセスすると、show-articleの呼び出し結果が Webページとして表示されます。クエリストリングを追加して、 http://localhost:5555/?id=1 にアクセスすると、前回とは異なる内容が表示されるかと思います。
show-articleは引数idに応じて戻り値を返す普通の関数ですが、 httpfn/clackをアノテーションとして付加すると、引数名と同名のリクエストパラメータの値を受け取るClack用の関数に変化します。
同等の処理を毎回記述するよりも、アノテーションを付加するだけのほうが楽で良いかなぁ、と思いました。 Webアプリケーション開発の経験値がないので、有用であるかはわかりませんが。
Clackを使ってくれてありがとう！
返信削除Caveman (https://github.com/fukamachi/caveman) でも@urlアノテーションがありますが、plistに追加するだけで自動でバインドまではしないですね
@url GET "/:id"
(defun show-article (params)
(let ((id (getf params :id))) ...))
Cavemanの場合はCL-EMBでバインドに頼っている感じ
@url GET "/:id"
(defun show-article (params)
(render "article.tmpl" params))
;; ↓ article.tmpl
<html><body>
ID: <% @var id %>
</body></html>