Template Haskell 入門した
mr_konn さんの できる!Template Haskell (完) を読んだので自分で書いてみたメモ。
動機
最近書いているコードで
data Hoge = Hoge1 | Hoge2 | Hoge3 deriving (Eq, Show) data Fuga = Fuga1 | Fuga2 deriving (Eq, Show)
みたいなデータに対し、
convertHoge :: String -> Hoge convertHoge t | t == "hoge1" = Hoge1 | t == "hoge2" = Hoge2 | t == "hoge3" = Hoge3 | otherwise = error "Hoge" convertFuga :: String -> Fuga convertFuga t | t == "fuga1" = Fuga1 | t == "fuga2" = Fuga2 | otherwise = error "Fuga"
のような変換関数を1つずつ書くのが嫌だったので、 このような関数を自動的に生成できるようなものを書こうとしてました。
これを生成する関数を mkConvertFunc
とすると
mkConvertFunc ''Hoge ["hoge1", "hoge2", "hoge3"]
で convertHoge
が生成される感じ。
単純な read
ではないことに注意 (capitalize しただけでない場合もある) 。
ただ、こういう関数書くことはちょくちょくあると思うので
どっかにライブラリとして転がっているような気もする。
実装
構文木と TH 版 convert 関数
まず runQ
を使って構文木の形を調べる
$ ghci -XTemplateHaskell > :m Language.Haskell.TH > runQ [| \t -> | t == "hoge1" = Hoge1; | t == "hoge2" = Hoge2; | t == "hoge3" = Hoge3; | otherwise = error "Hoge" |] <interactive>:65:15: parse error on input `|'
ふむ、ラムダ式ではパターンマッチのガード |
を使えないらしい。 case
を使って書きなおし。
> runQ [| \t -> case t of "hoge1" -> Hoge1; "hoge2" -> Hoge2; "hoge3" -> Hoge3; _ -> error "Hoge" |] LamE [VarP t_0] (CaseE (VarE t_0) [ Match (LitP (StringL "hoge1")) (NormalB (ConE Main.Hoge1)) [] , Match (LitP (StringL "hoge2")) (NormalB (ConE Main.Hoge2)) [] , Match (LitP (StringL "hoge3")) (NormalB (ConE Main.Hoge3)) [] , Match WildP (NormalB (AppE (VarE GHC.Err.error) (LitE (StringL "Hoge")))) [] ] )
できた。出力は読みやすいように整形してます。
これをほぼそのまま書き下して、 TH 版 convertHoge
を書ける。
convertHogeTH :: ExpQ convertHogeTH = do t_0 <- newName "t" return $ LamE [VarP t_0] (CaseE (VarE t_0) [ Match (LitP (StringL "hoge1")) (NormalB (ConE 'Hoge1)) [] , Match (LitP (StringL "hoge2")) (NormalB (ConE 'Hoge2)) [] , Match (LitP (StringL "hoge3")) (NormalB (ConE 'Hoge3)) [] , Match WildP (NormalB (AppE (VarE 'error) (LitE (StringL "Hoge")))) [] ] )
Hoge1
とか error
みたいな関数 (値) はクオートすることに注意。
試してみる
> :l Convert.hs > $(convertHogeTH) "hoge1" Hoge1 > $(convertHogeTH) "hoge2" Hoge2 > $(convertHogeTH) "hoge" *** Exception: Hoge
大丈夫そう。
簡易版 mkConvertFunc' の実装
ではこれに Hoge
や Fuga
を引数に渡してどちらにも使えるようにしてみる。いきなり目的の
mkConvertFunc ''Hoge ["hoge1", "hoge2", "hoge3"]
を作るのは難しそうだったので、 String -> Hoge
へのマッピング用のタプルのリストを引数に渡して
mkConvertFunc' ''Hoge [("hoge1", Hoge1), ("hoge2", Hoge2), ("hoge3", Hoge3)]
を作った。
mkConvertFunc' :: Name -> [(String, Name)] -> ExpQ mkConvertFunc' d lst = do t_0 <- newName "t" return $ LamE [VarP t_0] (CaseE (VarE t_0) $ (map (\(s, t) -> Match (LitP (StringL s)) (NormalB (ConE t)) []) lst) ++ [Match WildP (NormalB (AppE (VarE 'error) (LitE (StringL $ show d)))) []])
実際これは難しくないのだけど、型が
mkConvertFunc' :: Name -> [(String, Name)] -> ExpQ
になるのが最初わからなかった。
まあ考えればわかるんだけど、 ExpQ
とか ConE
ではなく Name
。
ドキュメントちゃんと読めってことですかね。
http://hackage.haskell.org/package/template-haskell
あと、6行目 $ (map ... )
が一見 $( ... )
に見えるが実は関数結合の $
です。
これを書いた後から見なおして早速混乱してしまった。要注意。
TH を書くときは関数結合の $
を使わないほうが良さそう (と、 mr_konn さんの記事にも書いてある) 。
> $(mkConvertFunc ''Hoge [("hoge1", 'Hoge1), ("hoge2", 'Hoge2), ("hoge3", 'Hoge3)]) "hoge1" Hoge1 > $(mkConvertFunc ''Hoge [("hoge1", 'Hoge1), ("hoge2", 'Hoge2), ("hoge3", 'Hoge3)]) "hoge" *** Exception: Hoge
mkConvertFunc の実装
さて、では最後に目的の
mkConvertFunc ''Hoge ["hoge1", "hoge2", "hoge3"]
を作る。これには data
の宣言
data Hoge = Hoge1 | Hoge2 | Hoge3 deriving (Show, Eq)
から Hoge1
Hoge2
Hoge3
という3つのコンストラクタを取ってくることが必要で、
reify
という関数を使う。
reify
はコンパイル時にしか使えないので ghci から叩けない。
ソースコード中に
$(do info <- reify ''Hoge runIO $ print info return [])
と書いてみて、 ghci からロードする。
> :l Convert.hs TyConI (DataD [] Convert.Hoge [] [NormalC Convert.Hoge1 [],NormalC Convert.Hoge2 [],NormalC Convert.Hoge3 []] [])
なるほど。こいつから Hoge1
Hoge2
Hoge3
を取る。
$(do ctrs <- (\(TyConI (DataD [] _ [] x [])) -> map (\(NormalC name []) -> name) x) <$> reify ''Hoge runIO $ print $ ctrs return [])
> :r [Convert.Hoge1,Convert.Hoge2,Convert.Hoge3]
ちょっと見にくいけどこれでよさそう。
最後にこれを使って mkConvertFunc
を定義して終わり。
mkConvertFunc :: Name -> [String] -> ExpQ mkConvertFunc d strs = do ctrs <- (\(TyConI (DataD [] _ [] x [])) -> map (\(NormalC name []) -> name) x) <$> reify d v <- newName "x" return $ LamE [VarP v] (CaseE (VarE v) $ (map (\(s,t) -> Match (LitP (StringL s)) (NormalB (ConE t)) []) $ zip strs ctrs) ++ [Match WildP (NormalB (AppE (VarE 'error) (LitE (StringL $ show d)))) []])
> :r > $(mkConvertFunc ''Hoge ["hoge1", "hoge2", "hoge3"]) "hoge1" Hoge1 > $(mkConvertFunc ''Hoge ["hoge1", "hoge2", "hoge3"]) "hoge2" Hoge2 > $(mkConvertFunc ''Hoge ["hoge1", "hoge2", "hoge3"]) "hoge3" Hoge3 > $(mkConvertFunc ''Hoge ["hoge1", "hoge2", "hoge3"]) "hoge4" *** Exception: Convert.Hoge > $(mkConvertFunc ''Fuga ["fuga1", "fuga2"]) "fuga1" Fuga1 > $(mkConvertFunc ''Fuga ["fuga1", "fuga2"]) "fuga2" Fuga2 > $(mkConvertFunc ''Fuga ["fuga1", "fuga2"]) "fuga3" *** Exception: Convert.Fuga
良さそう。
一応まとめたものを Gist
数式とソースコードのテスト
はてなブログで MathJax を埋め込んでみて、きちんと数式が出るかのテスト。
積分 $$ I = \int _{-\infty} ^ {\infty} e ^ {-x^2} dx $$ の値を求めよう。 $ xy $ 平面上で円形にそって全範囲を積分することを考えると $$ I^2 = \left( \int _{\infty} ^{\infty} e ^ {-x^2} dx \right) ^2 = \int _{\infty} ^{\infty} \int _{-\infty} ^{\infty} e ^ {-(x^2+y^2)} dx dy $$ である。曲座標変換 $ x = r \cos \theta, y = r \sin \theta $ とすると $$ I^2 = \int _0 ^{2\pi} \int _0 ^{\infty} e ^ {-r^2} r dr d\theta = 2 \pi \int _0 ^{\infty} r e ^ {-r^2} dr = 2 \pi \left[ - \frac{1}{2} e ^ {-r^2} \right] _0 ^{\infty} = \pi $$ となるので、 $ I > 0 $ より $$ I = \sqrt{\pi} $$ となる。
ソースコードがきちんとハイライトされるかのテスト。
import Control.Applicative ((<$>)) main = do n <- (read :: String -> Int) <$> getLine print $ n * n
#include <iostream> using namespace std; int main() { cout << "Hello from Hatena Blog" << endl; return 0; }
どちらも問題なさそう。 MathJax はエスケープめんどいけど、普通に使うのと変わらんからいいか。
submodule を含む Git リポジトリからファイルをエクスポート
この3点のメモ
Git には submodule という機能があり、あるリポジトリの下に別のリポジトリを置くことができる。
$ cd some-repository $ git submodule add git://example.com/hoge.git hoge
のようにすると、 some-repository/hoge に git://example.com/hoge.git をクローンすることができ、 some-repository は hoge 以下のファイルを直接管理はしない。
hoge リポジトリは some-repository とは別の独立したリポジトリのような感じになるので、そこ以下で編集したり commit/pull/push など通常のリポジトリと同様に扱える。
一度 submodule add してしまえば hoge リポジトリをいじった後 some-repository 側で特に操作の必要はない。嘘っぽい。 hoge リポジトリをいじった後 some-repository 側で add, commit が必要みたい。
ちなみに別のマシンからこのリポジトリを使うときは、
$ git clone git://example.com/some-repository.git $ cd some-repository $ git submodule init $ git submodule update
とすれば全ての submodule を同期できる。
で、今回 submodule 付きの Git リポジトリからファイルをエクスポートする必要が出てきた。
普通の Git リポジトリであれば、ファイルのエクスポートは
$ git checkout-index -a -f --prefix=/path/to/export-dir/
のようにすることでできる。このとき /path/to/export-dir/ の最後の / を忘れると悲惨なことになるので注意。
submodule 付きのリポジトリの場合、こうするだけでは submodule で管理されているリポジトリはエクスポートしてくれなかった。
なので、各 submodule ディレクトリ以下にコマンドを実行できる git-submodule foreach を使ってすべての submodule リポジトリに対して git-checkout-index を実行する。
$ cd some-repository $ git submodule foreach 'git checkout-index -a -f --prefix=`pwd | sed -e "s:/path/to/some-repository/:/path/to/export-dir/:g"`/'
これでok
zsh の menuselect 中に case-insensitive なインクリメンタルサーチをする
ちょっと zsh をカスタマイズしていたら止まらなくなってしまって、気に入らない挙動が出てきてしまったので自分でパッチを書いたという話。
zsh の機能で menuselect
zstyle ':completion:*:default' menu select=2
を設定している人も多いと多いと思うのだけれど、この場面で C-s または C-r を押すことでインクリメンタルサーチができる。
しかしこのとき case sensitive な検索しかできないのがどうにも我慢がならない。
C-s のときのコマンドが
history-incremental-search-forward
であることまでを突き止め、それで検索しまくったのだけど、
The search is case-insensitive if the search string does not have uppercase letters and no numeric argument was given.
http://zsh.sourceforge.net/Doc/Release/Zsh-Line-Editor.html
と書いてあるくせに menuselect の中ではそうでないらしい。
ぐぬぬ・・
で、仕方ないから自分でソースをいじることにした。
できたパッチが https://gist.github.com/1926791/e29ded0cb38ca88845649ef47579a2ce5d0a3fd7
Src/Zle/complist.c 内で strstr で一致を探していたのが悪く、大文字小文字を区別しない strstri を定義してこれを使うことにした。
(ちなみに本当の履歴のインクリメンタルサーチは Src/Zle/zle_hist.c 内の zlinecmp という関数を使っていて、今回もそれを使おうと思ったのだけどなんかうまくいかなかった。誰かいい実装できたら教えてください。)
このパッチを Homebrew なんかから使うときは
$ brew edit zsh
として、
def install
の上の行あたりに
def patches p = [] p << "https://raw.github.com/gist/1926791" return p end
と書いて
$ brew install zsh
すればよい。
ちなみに menuselect のとき、コマンド実行までに2回エンターを押さなければいけないことが我慢できない人も多いと思うのだけど、
bindkey -M menuselect '^M' .accept-line # (^M は quoted-insert)
のようにすることで1回でコマンドを実行できるようになる。これもっと早く知りたかったなあ。 (http://www.zsh.org/mla/users/2009/msg01018.html)
Samba で Windows とディレクトリ共有
VMware 内で Arch Linux を飼っているのだけれど、 Linux カーネルのバージョンが上がるたびに open-vm-tools のディレクトリ共有機能がうまく動かなくなるのにいつも悩んでいた。
のでいっそのこと Samba を使ってディレクトリ共有することにした、メモ。
まず必要なものをインストール
$ sudo pacman -S samba
これだけだっけ? もう覚えてない・・
次にマウントポイントを作る
$ sudo mkdir -p /mnt/windows
で、 /etc/fstab 編集
//Windows/Users/Name /mnt/windows cifs credentials=/etc/fstab.windows,codepage=cp932,iocharset=utf8,uid=Name,gid=wheel,defaults 0 0
こんな感じにするとうまくいった。Windows は Windows 側のマシン名、 Name は Windows 側のユーザー名。詳しいオプションなんかは http://ikdlab.k.hosei.ac.jp/~todoroki/todowiki/index.php?samba#lbb88b7d とか見た。
マウントオプションにユーザー名とパスワードを書かなきゃいけないんだけど、ここに書くのは嫌なので credentials というオプションで外部ファイルを指定できるらしい。
/etc/fstab.windows の内容は以下。
username=Name password=Pass
さらに
$ sudo chown root:root /etc/fstab.windows $ sudo chmod 400 /etc/fstab.windows
で root 以外から読めないようにします。
ここまでできたら再起動してきちんとマウントできていることを確認
で、あとはホームあたりにアクセスしやすいようにシンボリックリンクを張っておきます
$ ln -s /mnt/windows $HOME/windows
これで完了。