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 時前に早退。いいイベントだった。
cl-mongo を series で
(defun order-kv (order)
(cond ((null order)
nil)
((atom order)
(cl-mongo:kv order 1))
(t
(apply #'cl-mongo:kv
(mapcar (lambda (x)
(if (atom x)
(cl-mongo:kv x 1)
(cl-mongo:kv (car x)
(if (eq :desc (cadr x)) -1 1))))
order)))))
(series::defS scan-mongo (collection query &key (skip 0) (limit 0) order)
"scan mongoDB collection."
(series::fragl
;; args
((collection) (query) (skip) (limit) (order))
;; rets
((doc t))
;; aux
((doc t) (cursor t) (count integer))
;; alt
()
;; prolog
((setq count 0)
(setq cursor (cl-mongo:db.find
collection
(aif (order-kv order)
(cl-mongo:kv (cl-mongo:kv "query" query)
(cl-mongo:kv "orderby" it))
query)
:skip skip
:limit limit)))
;; body
(L
(setq doc (pop (cadr cursor)))
(unless doc
(push nil (cadr cursor))
(if (zerop (cl-mongo::db.iterator cursor))
(go series::end)
(progn
(incf count (nth 7 (car cursor)))
(if (and (plusp limit) (<= limit count))
(go series::end)
(progn
(setq cursor (cl-mongo:db.iter cursor :limit (- limit count)))
(pop (cadr cursor))
(go L)))))))
;; epilog
((cl-mongo:db.stop cursor))
;; wraprs
()
;; impure
nil))
として
(iterate ((doc (scan-mongo "logs.app" (cl-mongo:$> "_id" last-id))))
(foo doc))
な感じ。
Common Lisp で Amazon Glacier
https://github.com/quek/info.read-eval-print.aws.glacier
できた気するので、今度バックアップデータをアップロードしてみる。
たぶんアップロード時の description にファイル名とか日時とかサイズとか入れといた方がいい気がする。
(ql:quickload :info.read-eval-print.aws.glacier)
(in-package #:info.read-eval-print.aws.glacier)
(load "~/.info.read-eval-print.aws.glacier.lisp")
(list-vaults)
(create-vault "test-vault")
(describe-vault "test-vault")
(upload-archive "test-vault" "/tmp/a.txt" :description "upload-archive")
(upload-archive-multipart "test-vault" "~/archive/apache-solr-4.0.0-src.tgz" :description "multipart")
(list-jobs "test-vault")
(initiate-job "test-vault" :type :inventory-retrieval)
;⇒ "JOBID_EXAMPLEQUXFCTf0xdkZJxIri2id7ijxCKvnpBOCQL0mPIdiCkhjphjphjpdq9f0AAOaIcZm_"
(describe-job "test-vault" "JOBID_EXAMPLEQUXFCTf0xdkZJxIri2id7ijxCKvnpBOCQL0mPIdiCkhjphjphjpdq9f0AAOaIcZm_")
(get-job-output "test-vault" "JOBID_EXAMPLEQUXFCTf0xdkZJxIri2id7ijxCKvnpBOCQL0mPIdiCkhjphjphjpdq9f0AAOaIcZm_")
;; ファイルに保存する
(with-open-stream (in (get-job-output-stream "test-vault" "JOBID_EXAMPLEQUXFCTf0xdkZJxIri2id7ijxCKvnpBOCQL0mPIdiCkhjphjphjpdq9f0AAOaIcZm_"))
(with-open-file (out "/tmp/job-out" :direction :output :if-exists :supersede
:element-type '(unsigned-byte 8))
(alexandria:copy-stream in out :element-type '(unsigned-byte 8))))
ダウンロード時は :element-type '(unsigned-byte 8) を指定すること。
CL-WHO を使えばいいのだけど、デフォルトでエスケープされないのと、 Compojure の tag#id.class という書き方がうらやましかったで作った。
https://github.com/quek/info.read-eval-print.html
(html (:ul#foo.bar.baz
(loop for i from 1 to 3
do (html (:ul :data-value i (format nil "<~a>" i))))))
で次の出力になる。
<ul id="foo" class="bar baz">
<ul data-value="1">
<1>
</ul>
<ul data-value="2">
<2>
</ul>
<ul data-value="3">
<3>
</ul>
</ul>
CL-WHO を使っていた会社のブログをこれで書きなおしてやった。
こんな感じ。多値は。。。
(defgeneric scan% (thing &key &allow-other-keys))
(series::defS scan* (thing &rest args)
"generic scan."
(cl:let ((scan% `(scan% ,thing ,@args)))
(series::fragl
;; args
((thing t)
(scan% function))
;; rets
((value t))
;; aux
((value t)
(f function))
;; alt
()
;; prolog
((setq f scan%))
;; body
((multiple-value-bind (v p) (funcall f)
(unless p
(go series::end))
(setq value v)))
;; epilog
()
;; wraprs
()
;; impure
nil)))
(defmethod scan% ((ting list) &key)
(let ((x ting))
(lambda ()
(if x
(let ((car (car x)))
(setf x (cdr x))
(values car t))
(values nil nil)))))
(defmethod scan% ((thing array) &key (start 0) end)
(let ((i start)
(end (or end (length thing))))
(lambda ()
(if (= i end)
(values nil nil)
(let ((v (aref thing i)))
(incf i)
(values v t))))))
#|
(collect (scan* #(1 2 3)))
;⇒ (1 2 3)
(collect (scan* #(1 2 3) :start 1 :end 2))
;⇒ (2)
(defstruct st
(value 'a)
(next nil))
(defmethod scan% ((st st) &key)
(lambda ()
(if st
(let ((x st))
(setf st (st-next st))
(values x t))
(values nil nil))))
(let ((st (make-st :value 1 :next (make-st :value 2 :next (make-st :value 3)))))
(collect (st-value (scan* st))))
;⇒ (1 2 3)
|#
ひさしぶりに読むグインサーガ。おもしろかった。自分の中の何かが満たされた。グインサーガは中学のころから読んでいて、生活の一部になっていたんだということを、認識した。
これかもずっと読んでいきたい。
(load "~/quicklisp/setup.lisp")
(let* ((*standard-output* (make-broadcast-stream))
(*error-output* *standard-output*))
(ql:quickload :series))
(use-package :series)
(write-string
(collect 'string (scan-stream *standard-input* #'read-char)))
yarn:~% echo "hello\nworld" | sbcl --script /tmp/a.lisp
hello
world
