3分たったら知らせてほしい時とかあるよね。汁全部なくなったりしたら悲しいもんね。
使った。
(defcommand alarm (seconds message) ((:number "seconds: ") (:string "message: "))
"alarm"
(sb-thread:make-thread
(lambda ()
(sleep seconds)
(stumpwm::message-no-timeout "^3*~
~a
☆ * . ☆
☆ . ∧＿∧ ∩ * ☆
ｷﾀ━━━( ・∀・)/ . ━━━！！
. ⊂ ノ* ☆
☆ * (つ ノ .☆
(ノ" message))))
StumpWM は手軽るにこういうことができるのがいい。
これで疲労ぬきして出撃できる。
ラグドールのタオがうちに来てから一週間たった。だいぶ調子がでてきた感じ。
ダイエーでたまたま見かけた。誕生日が私と同じだから5か月ほど売れ残っていたことになる。これは運命とか縁とかいうものかね。
Debian sid で sudo apt-get dist-upgrade したら「メジャーバージョン 9.1 はもはや使われません」とか言われたので、素直にアップグレードした。
sudo apt-get install postgresql-9.3
sudo pg_dropcluster 9.3 main --stop
sudo pg_upgradecluster 9.1 main
(ql:quickload :info.read-eval-print.sed)
(ql:quickload :trivial-shell)
(use-package :info.read-eval-print.sed)
(let ((odd-total 0)
(even-total 0))
(with-input-from-string (in (trivial-shell:shell-command "ls -l /tmp"))
(sed (:in in :n t)
(when ($ 5)
(let (($5 (parse-integer ($ 5))))
(if (oddp (parse-integer ($ 2)))
(incf odd-total $5)
(incf even-total $5))))))
(values odd-total even-total))
Google Reader がなくなってブログ読まなくなったな。それであまり書かなくなった。というわけではない。
今年も鳥取に帰省した。だれもいなく、くらげもいなかった。
Common Lisp 関連は https://github.com/quek/unpyo を書いて遊んでる。
Common Lisp でサーバプログラムを書いている時、エラーは (handler-case ... (error (e) ...) って感じで全てにぎりつぶしたい。
でも、そうすると開発中はデバッガ起動しなくて困る。
どうしよう・・・ということで Hunchentoot のソース読んでみた。 with-simple-restart で invoke-debugger をかこめばいいみたい。
次のようにすると変数1つでデバッガの起動するしないを切り替えられるんだね。
(defvar *invoke-debugger-p* t)
(defun my-debugger (e)
(when *invoke-debugger-p*
(with-simple-restart (continue "Return from here.")
(invoke-debugger e))))
(defmacro with-debugger (&body body)
`(handler-bind ((error #'my-debugger))
,@body))
;; サーバのループ処理イメージ
(loop for socket = (accept)
do (handler-case
(with-debugger (call socket))
(error (e)
(error-handle e))))
*invoke-debugger-p* を t にしておけばエラー発生時にデバッガがあがる。そのデバッガで Continue リスタートを選べば handler-case により error-handle がちゃんと呼ばれる。
invoke-debugger はそのままだと処理が戻らないから with-simple-restart でかこんであげるってことだね。
腱鞘炎気味だったのでキー入力をちょっと変えみた。
<>がつらい感じだったので
<>にしてみた。
;; キー定義。
(set-sequence ((+any+ +no-meta+ +no-shift+ KEY_COMMA) (+any+ +shift+ KEY_9)) ;, → (
((+any+ +shift+ KEY_COMMA) (+any+ KEY_COMMA)) ;shift + , → ,
((+any+ +no-meta+ +no-shift+ KEY_DOT) (+any+ +shift+ KEY_0)) ;. → )
((+any+ +shift+ KEY_DOT) (+any+ KEY_DOT)) ;shift + . → .
((+any+ +shift+ KEY_9) (+any+ +shift+ KEY_COMMA)) ;shift + 9 → <
((+any+ +shift+ KEY_0) (+any+ +shift+ KEY_DOT)) ;shift + 0 → >
((+any+ +meta+ KEY_COMMA) (+any+ +shift+ KEY_COMMA)) ;mata + , → <
((+any+ +meta+ KEY_DOT) (+any+ +shift+ KEY_DOT))) ;mata + . → >
Common Lisp といえばマクロ。マクロのいきつく先といえばコードウォーカー。ということで hu.dwim.walker というコードウォーカ一を使ってみた。
使い方としては次のような感じ。
cl-json を使うと次のように JSON をデコードできる。
(json:decode-json-from-string "{\"a\": 1, \"b\": {\"bb\": 2}, \"c\": 3}")
;;⇒ ((:A . 1) (:B (:BB . 2)) (:C . 3))
これに対する assoc をちまち書きたくないので、シンボル1つで次のように展開されるマクロを書いてみる。
@a ⇒ (ASSOC "A" '((:A . 1) (:B (:BB . 2)) (:C . 3)) :TEST #'STRING-EQUAL)
@b.bb ⇒ (CDR (ASSOC "BB"
(CDR (ASSOC "B" '((:A . 1) (:B (:BB . 2)) (:C . 3)) :TEST #'STRING-EQUAL))
:TEST #'STRING-EQUAL))
これだけなら S式を単純に置換していくだけでも可能だけど
となるとコードウォーカーが必要になる。
ちゃんとしたドキュメントとかないようなので、テストやソースを見ながら書いたのがこれ。
(ql:quickload "hu.dwim.walker")
(ql:quickload "cl-json")
(ql:quickload "split-sequence")
(defun symbol-to-assoc-form (symbol decoded)
(let ((names (split-sequence:split-sequence #\. (subseq (symbol-name symbol) 1))))
(hu.dwim.walker:walk-form
(reduce (lambda (acc x)
`(cdr (assoc ,x ,acc :test #'string-equal)))
names
:initial-value decoded))))
(defun free-and-@-p (form)
(and (typep form 'hu.dwim.walker:free-variable-reference-form)
(char= #\@ (char (symbol-name (hu.dwim.walker:name-of form)) 0))))
(defun walk-with-json-body (decoded form env)
(let* ((walked (hu.dwim.walker:walk-form form
:environment (hu.dwim.walker:make-walk-environment env)))
(walked (hu.dwim.walker:rewrite-ast
walked
(lambda (parent field form)
(declare (ignore parent field))
(if (free-and-@-p form)
(symbol-to-assoc-form (hu.dwim.walker:name-of form) decoded)
form)))))
(hu.dwim.walker:unwalk-form walked)))
(defmacro with-json (json &body body &environment env)
(let ((decoded (gensym)))
`(let ((,decoded (json:decode-json-from-string ,json)))
,@(mapcar (lambda (form)
(walk-with-json-body decoded form env))
body))))
;; @a と @b.bb は json の値 1, 2 に @c は let の 999 になる。
;; with-json がネストしてても問題ない。
(with-json "{\"a\": 1, \"b\": {\"bb\": 2}, \"c\": 3}"
(let ((@c 999))
(list @a @b.bb @c
(with-json "{\"a\": 10, \"b\": {\"bb\": 20}, \"c\": 30}"
(let ((@c 9990))
(list @a @b.bb @c))))))
;;⇒ (1 2 999 (10 20 9990))
cl-mongo があるのは知っていましたが、それでも Common Lisp の MongoDB ドライバを作ってみました。
Quicklisp には入ってません。
いろいろ足りないかもしれませんが、とりあえず動きます。仕事でログ解析に使ったりしています。
;; 他にも https://github.com/quek/ の下にある何かが必要かも・・・
(eval-when (:compile-toplevel :load-toplevel :execute)
;; https://github.com/quek/info.read-eval-print.bson
(ql:quickload :info.read-eval-print.bson)
;; https://github.com/quek/info.read-eval-print.mongo
(ql:quickload :info.read-eval-print.mongo))
(defpackage :mongo
(:use :cl)
;; SBCL の local-nicknames を使ってみたりする。これいいよね。
(:local-nicknames (:m :info.read-eval-print.mongo)
(:b :info.read-eval-print.bson)))
(in-package :mongo)
(defvar *connection* (m:connect "localhost:27017"))
;;⇒ *CONNECTION*
(defvar *db* (m:db *connection* "test"))
;;⇒ *DB*
(defvar *foo* (m:collection *db* "foo"))
;;⇒ *FOO*
;; 登録する
(loop for i from 1 to 10
do (m:insert *foo* (b:bson :a "hello" :b i)))
(m:insert *foo* (b:bson :a "world" :b 1))
;; 検索する。Series を使う。
(series:collect (m:scan-mongo *foo* nil))
;;⇒ ({"_id": ObjectId("51734E4BCF15ED0A74C21E61"), "a": "hello", "b": 1}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E62"), "a": "hello", "b": 2}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E63"), "a": "hello", "b": 3}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E64"), "a": "hello", "b": 4}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E65"), "a": "hello", "b": 5}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E66"), "a": "hello", "b": 6}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E67"), "a": "hello", "b": 7}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E68"), "a": "hello", "b": 8}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E69"), "a": "hello", "b": 9}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E6A"), "a": "hello", "b": 10}
;; {"_id": ObjectId("51734E4DCF15ED0A74C21E6B"), "a": "world", "b": 1})
(series:collect (m:scan-mongo *foo* (b:bson (m:$< :b 3) :a "hello")))
;;⇒ ({"_id": ObjectId("51734E4BCF15ED0A74C21E61"), "a": "hello", "b": 1}
;; {"_id": ObjectId("51734E4BCF15ED0A74C21E62"), "a": "hello", "b": 2})
oauth2 は https://github.com/Neronus/oauth2 を使う。
(defpackage oauth2.test.google-analytics
(:use :cl :oauth2))
(in-package oauth2.test.google-analytics)
(defparameter *token*
(oauth2::string->token ""
:refresh-token "your refresh token"
:scope "https://www.googleapis.com/auth/analytics.readonly"))
(defparameter *refreshed-token*
(oauth2:refresh-token "https://accounts.google.com/o/oauth2/token" *token*
:method :post
:scope "https://www.googleapis.com/auth/analytics.readonly"
:other `(("client_id" . "your client id")
("client_secret" . "your client secret"))))
(let ((drakma:*text-content-types* '(("application" . "json"))))
(json:decode-json-from-string
(request-resource "https://www.googleapis.com/analytics/v3/data/ga"
*refreshed-token*
:parameters ' (("ids" . "ga:999999999")
("metrics" . "ga:pageviews")
("dimensions" . "ga:pagePath")
("start-date" . "2013-01-01")
("end-date" . "2013-01-03")))))
これはいい。
http://www.sbcl.org/manual/index.html#Package_002dLocal-Nicknames
CL-USER> (defpackage :foo.bar.baz (:use :cl))
#<PACKAGE "FOO.BAR.BAZ">
CL-USER> (defparameter foo.bar.baz::foo 1)
FBZ::FOO
CL-USER> (defpackage :aaa (:use :cl))
#<PACKAGE "AAA">
CL-USER> (defpackage :bbb (:use :cl))
#<PACKAGE "BBB">
CL-USER> (sb-ext:add-package-local-nickname :fbz :foo.bar.baz :aaa)
#<PACKAGE "AAA">
CL-USER> (in-package :aaa)
#<PACKAGE "AAA">
AAA> fbz::foo
1
AAA> (in-package :bbb)
#<PACKAGE "BBB">
BBB> fbz::foo
; Evaluation aborted on #<SB-INT:SIMPLE-READER-PACKAGE-ERROR "Package ~A does not exist." {1005DE7C93}>.
BBB> (sb-ext:add-package-local-nickname :fbz :foo.bar.baz)
#<PACKAGE "BBB">
BBB> fbz::foo
1
最近 Common Lisp で MongoDB のドライバを書いたりしている。
restart-bind とか使ってカッコよく再接続したいのだけど、 try catch のエラーハンドリングから生長できない・・・
(defmacro with-reconnect-around (connection &key (max-retry-count 10) (retry-sleep 3))
(let ((retry-count (gensym "retry-count")))
`(loop for ,retry-count from 0
do (handler-case (progn
(unless (zerop ,retry-count)
(establish-connection ,connection))
(return (call-next-method)))
(error (e)
(when (< ,max-retry-count ,retry-count)
(signal e))
(warn "reconnecting... ~a" e)
(sleep ,retry-sleep)
(close ,connection))))))
(defmethod send :around ((self replica-set) op size function)
(with-reconnect-around self))
(defmethod send ((connection connection) op size function)
送信処理...)
このあたりを読んで、勉強しましょ。
Lisp Meet Up presented by Shibuya.lisp #1 に行ってきた。
前半は chiku さんによる vim からの Common Lisp の使用についての発表。 swank クライアントしとて動く slimv がおすすめらしい。 vim の人は大変だなぁ、と思った。 vim は好きだけど slime があるから emacs から離れられない。
みんなで自己紹介した後、後半。後半はそれぞれで Common Lisp の処理系をインストールしたり、Lisp 系の会話でもりあがっいた。
私は @ravencoding さんと quicklisp をインストールしたり hunchentoot や clack を動かしたりしていた。
残念ながらバスの時間があるので 22 時前に早退。いいイベントだった。