scheme_baton.clj

;; 第1回 Scheme コードバトン
;;
;; ■ これは何か？
;;   Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びです。
;;   次回 Shibuya.lisp で成果を発表します。
;;   Scheme 初心者のコードを書くきっかけに、中級者には他人のコードを読む機会になればと思います。
;;
;; ■ 2 つのルール
;;
;;   (1)自分がこれだと思える変更をコードに加えて2日以内に次の人にまわしてください。
;;      「人に優しい」変更なら何でも良い。1文字の変更でも可。
;;      「人に優しい」とは例えば、次の人が読みやすいコードを書くなど。
;;       コードを削るのもあり。
;;
;;   (2)次の人にまわしコードが変更されるのを"見守る"。
;;       この説明書きを含めてバトンが伝わった事を必ず確認してください。
;;       止まっていたら助けてあげてください。
;;
;; ■ バトンの回し方
;;
;;    (1) 回ってきたバトンは http://gist.github.com/xxxx という URL のはずです。
;;    (2) fork をクリックしてください（アカウントを持っていない人はこのとき作成します）
;;    (3) edit で変更したファイルを貼り付けます。
;;    (4) 自分が fork した新しい URL を回してください
;;
;;
;; ■ 良くある質問
;;
;;   (a) 初心者です。参加したいけどちょっと不安です。
;;      higepon がフォローしますので大丈夫です。分からない事があれば遠慮無く聞いてください。
;;
;;   (b) 次にまわす人がいません
;;      higepon に知らせてください。twitter, 日記のコメントなどで。
;;
;;   (c) 次の人がコードを止めてしまいました
;;      残念ですが別の人にバトンを渡してください。
;;
;;   (d) Mosh で動かないとダメですか？
;;      いいえ。Scheme なら何でも良いです。Gauche, Ypsilon 用に書き換えるのも面白いですね。
;;      そのときは起動方法の説明も変えてください。
;;
;; ■ バトンの行方を記録
;;   名前(URL)：一言
;;   1. higepon (http://d.hatena.ne.jp/higepon/): 最初はコマンドライン英単語暗記ツールでした。これが何に化けるのか楽しみ。全く別物になるかな？
;;   2. athos (http://d.hatena.ne.jp/athos/): Clojureに移植。
;;   3. 深町英太郎 (http://e-arrows.sakura.ne.jp/): prompt-read, y-or-n-pを追加。コードを簡単に。
;;   4. 穂苅実紀夫 (http://ctrkode-clojure.blogspot.com/): main-loop、sort-word-specs、file->sexp-listを簡単に。
;;   5. manjilab (http://manjilab.com/): Mac OS X でのみ、出題される英単語を音声でも出力するようにした。
;;   6. deltam (http://deltam.blogspot.com): Smart.fmの学習アイテムから辞書ファイルを生成できるようにした。(smartfm-dict)
;; =================================================================================================================================================
;;                            これより下がコードとその説明 - 変更・削除歓迎
;; =================================================================================================================================================

;; ■英単語暗記補助ツールです
;;   起動すると辞書ファイルから単語が表示されるので意味を頭で考えます。Ctrl-D を押すと答えが表示されます。 (y/n) を聞かれるので正解なら y を押してください。
;;   間違った単語は辞書ファイルに記録され次回出題されます。
;;
;; ■動作方法
;;   Clojure (1.1.0) で動作します。(http://code.google.com/p/clojure/downloads/list)
;;   % clj scheme_button.clj 辞書ファイル
;;
;;   Smart.fmのユーザ名を指定して辞書ファイルを作れます。（Smart.fmユーザでない人はdeltamでお試しください）
;;   % clj scheme_button.clj -s Smart.fmのユーザ名 > 辞書ファイル
;;
;;   実行には、別途 clojure.contrib ライブラリ(http://richhickey.github.com/clojure-contrib/) が必要です。
;;
;; ■辞書ファイルの例
;;   http://gist.github.com/273424
;;
;; ■Smart.fmのユーザ別英単語アイテム取得APIのドキュメント
;;   http://developer.smart.fm/docs/user_calls/items_studied

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

(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-by #(- (% 2) (% 3)) word-specs))

(defn file->sexp-list [f]
  (let [r (java.io.PushbackReader. (reader f))]
    (take-while identity
      (repeatedly #(or (read r false false) (.close r))))))

(defn prompt-read [prompt]
  (print (format "%s: " prompt))
  (flush)
  (read-line))

(defn y-or-n-p [prompt]
  (= "y"
     (loop []
       (or
         (re-matches #"[yn]" (.toLowerCase (prompt-read (str prompt "[yn]"))))
         (recur)))))

(defn speak-osx [word]
  (.. Runtime (getRuntime) (exec (str "/usr/bin/say " word))))

(defn osx? []
  (= (.. System (getProperties) (get "os.name"))
     "Mac OS X"))

(defn get-content-by-tag [tag xml]
  (first
   (some #(if (= tag (:tag %)) (:content %))
          (:content xml))))

(defn smartfm-dict [username]
  (let [api_url (str "http://api.smart.fm/users/" username "/items.xml")]
    (doseq [s (for [x (xml-seq (parse api_url)) :when (= :quiz (:tag x))]
                (let [q (get-content-by-tag :question x)
                      a (get-content-by-tag :answer x)]
                  (map #(str "\"" % "\"")
                    (list
                      (.. a (replaceAll "</*spell>" "") trim)
                      q))))]
      (println s))))

(defn main-loop [questions]
  (for [[word meaning ok ng :as question] questions]
    (do
      (if (osx?) (speak-osx word))
      (prompt-read word)
      (apply list word meaning 
        (if (y-or-n-p meaning) [(inc ok) ng] [ok (inc ng)])))))

(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)]
    (with-open [w (writer filename)]
      (doseq [result results]
        (binding [*out* w] (prn (seq result)))))))

(let [args (take 2 *command-line-args*)]
	 (if (= (first args) "-s")
		 (smartfm-dict (last args))
	   (main (first args))))