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' の実装

ではこれに HogeFuga を引数に渡してどちらにも使えるようにしてみる。いきなり目的の

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 リポジトリからファイルをエクスポート

  1. git-submodule の使いかた
  2. Git リポジトリからファイルをエクスポートする
  3. 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

こんな感じにするとうまくいった。WindowsWindows 側のマシン名、 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

これで完了。