噂の「英単語を覚えるスクリプト」をClojureで

第1回 Scheme コードバトンのお知らせ - Higepon’s blogでネタとして挙がっている英単語を覚えるスクリプトをClojureで書いてみた、という話。

コード自体はid:higeponさんのScheme(R6RS)版をほぼそのままClojureに移植しただけ。

ソースコード

(追記：ソースコードは http://gist.github.com/273985 からも見られます。)

(use '[clojure.contrib.duck-streams :only (reader writer)]
     '[clojure.contrib.fcase :only (case)])

(defn make-word-spec
  ([word meaning] [word meaning 0 0])
  ([word meaning ok ng] [word meaning ok ng]))

(defn sort-word-specs [word-specs]
  (sort #(> (- (%1 3) (%1 2))
	    (- (%2 3) (%2 2)))
	word-specs))

(defn file->sexp-list [f]
  (letfn [(rec [r]
	    (lazy-seq
	      (if-let [sexp (read r false false)]
		(cons sexp (rec r))
		(.close r))))]
    (rec (java.io.PushbackReader. (reader f)))))

(defn main-loop [questions results]
  (let [[[word meaning ok ng :as question] & more] questions]
    (letfn [(read-char-ci []
	      (Character/toLowerCase (first (Character/toChars (.read *in*)))))
	    (update-result [ok ng]
	      (cons (make-word-spec word meaning ok ng) results))
	    (p [format & args] (apply printf format args) (flush))]
      (if (nil? question)
	results
	(do (p "%s: \n" word)
	    (read-char-ci)
	    (p "%s: y/n? " meaning)
	    (case (read-char-ci)
	      \y (recur more (update-result (inc ok) ng))
	      \n (recur more (update-result ok (inc ng)))
	      (concat (reverse results) questions)))))))

(defn main [filename]
  (let [word-specs (map #(apply make-word-spec %) (file->sexp-list filename))
	questions (sort-word-specs word-specs)
	results (main-loop questions nil)]
    (with-open [w (writer filename)]
      (binding [*out* w]
	(doseq [result results] (prn (seq result)))))))

(main (first *command-line-args*))