読者です 読者をやめる 読者になる 読者になる

Heroku で Haskell (Scotty + Persistent)

Heroku がすごいことを知ったので少しずつ使おうとしています。 で、 Haskell で書いたアプリケーションを動かそうとしているのですが、 ちょいちょい触りつつわかったことを書いてみます。

巷では Heroku で Haskell を動かすにはビルド済みのバイナリを push するのが よく知られた方法のようです。

しかしこの方法は Heroku の Celadon Cedar stack が Ubuntu 10.04 64bit であることを前提としていて、少し考えるとわかるように次のような問題があります。

  1. ローカルで Ubuntu 10.04 64bit を用意しなければならない
  2. Cedar stack が別のディストリビューションを使うようになったら 追従しなければならない

で、そうでなくて Heroku 上でビルドする方法はないのかと探したら少し前に xuwei さんが Haskell 用の buildpack を使う方法を書いていました。 ここで紹介されているリポジトリに書いてある通りにやってみると すごく簡単にアプリケーションを動かすことができます。

というわけで、この buildpack を使って 遊んでみた感じのまとめとして、 Scotty + Persistent で簡単なアプリケーションを作ってみました。

ページにアクセスするとフォームが現れて、そこから post された文字列を DB に格納して、 DB にある内容を表示するというまあごくシンプルなやつです。 使い方とかは README に書いてあるので読んでください。

テンプレートエンジンは少し探してみたのですがなんか定番っぽいのがなさそうで、 fujimura さんの書いている Mustache (hastache) を使ってみました。

Heroku の無料アカウントで標準の PostgreSQL を使うことになります。 Mac の Homebrew で何も考えずに PostgreSQL をインストールすると 32bit 版がインストールされますが、 これを使うと persistent-postgresql のビルドでこけます。 まあその辺直すのめんどくさそうだったので、ローカルでは SQLite を使い、 Heroku 上では PostgreSQL を使うということができるように してみました。 PostgreSQL をインストールしていない環境で動かすには src/DBUtil.hs#define SQLite の行をアンコメントし、 scotty-on-heroku.cabalpersistent-postgresql の行をコメントアウトしてください。

ちなみに Yesod アプリケーションも同じ方法で作ってみようとしたのですが、 どうやら Heroku では push 時に走るビルドが 15 分かかると殺されてしまう仕様のようです。 (公式ドキュメントに見当たらない・・) 15 分では Yesod を最初からビルドすることはできないのでこの方法では無理です。 Yesod に限らずとも大きなアプリケーションを動かすときは ビルド済みのバイナリを push という方法しかなさそうです。

Advent Calendar Advent Calendar 9日目

Advent Calendar Advent Calendar の9日目です。 前の人は @sa__i さんでした。

今日は SKK Advent Calendar を紹介します。

SKK とは日本語入力ソフトウェア (IME) の一つです。 元々は Emacs 上で動く IME として開発され、 UNIX 環境では XIM 用に移植された skkimput、 また Windows 向けの skkimeMac OS X 用の AquaSKK など 多くのクローンが存在します。 その独特かつ慣れると快適な入力方法ゆえ根強い人気を誇り、 一見さんお断りの上級者向け IME として有名となっています。

SKK が他の一般的な入力方法と異なっているのは、 IME形態素解析を行わなずユーザーが漢字変換したい単位を自分で指定することです。 形態素解析を行って単語や文節の区切りを認識して変換するソフトウェアでは 頻繁に解析ミスが生じて意図した変換にならないことがあります。 SKK が快適なのは自分で変換単位を指定することで形態素解析のミスによる変換ミスが 起こらないことが保証されるからです。 また SKK を使うと「変換できる単位」で漢字変換を行う癖がつくため、 たまに通常の IME を使う場合でも解析ミスによる変換ミスを防ぐことにつながります。 通常の IME形態素解析が信用ならない人にはおすすめです。 (自然言語処理界隈の人たちに SKK ユーザが多いという噂があります。)

その他、よく挙げられる SKK の長所

  • シームレスかつ高度な辞書登録
  • シームレスな入力モードの変更 (かな、カナ、半角英数、全角英数)
  • 高度な補完機能
  • zh zj zk zl z- z[ z] z, z. z/ といった省略記法
  • /today などの英単語による変換

などがあります。

さて、そのような独特の IME である SKK の Advent Calendar (2010年) が存在しました。

ぱっと見ただけでも単位の換算、拡張ローマ字入力である AZIK の話題、 などなかなか濃い話題が多そうです。

この中でも特に注目したいのは Android SKK雑感 という記事です。 Android SKK とはその名の通り AndroidSKK を動かそうというプロジェクトです。 IS01 (Android 1.6) のようにハードウェアキーボード付きの端末に便利じゃね? といって開発されているようです。

それにしてもあの SKKAndroid で動くとは。これは試さないわけにはいきません。 もちろん自分の持っている端末 (EMOBILE GS02, Android 2.3.6) にインストールしてみました。 IME の設定を SKK に変更し、いざ Twitter クライアントを開き、そこで目にしたものは・・





いやー、予想してはいたけどね。

と言っていたところで、続編のプロジェクトを見つけました。 SKK for Android with hard-key というプロジェクトです。

こちらは同じ端末で試したところ、ハードウェアキーボードがないので 全く入力ができませんでした。誰かハードウェアキーボードのある Android 端末を持っている人は試してみてください。

という感じで SKK Advent Calendar の紹介でした。

ちなみに僕は今は SKK は使っていません。

Arch Linux on Raspberry Pi

Raspberry Pi を買って Arch Linux をインストールして自宅サーバ (NAS) にしてみたのでメモ。

準備

Arch Linux のインストール

Arch Linux を ARM アーキテクチャの上で動かすプロジェクトがあるので、 そのイメージをインストールします。

ここの Installation の通りにやれば大丈夫なはず。

起動

Raspberry Pi は MicroUSB の電源を接続するとすぐに起動します。 このとき電源の供給が不安定だとすぐに電源が落ちてしまいます。 うまく長時間起動しない場合はまず電源を疑います。 安っぽい USB AC アダプタなどの場合はうまくいかないことが多いみたい。

安定して起動した場合でも少しでも消費電力を抑えるために HDMI ケーブルなどは 繋がないほうがいい。電源と Ethernet ケーブルだけつないで最初から SSH で ログインして扱うことにします。

ログイン、パッケージのアップデート

SSH でログインしますが DHCP でどの IP アドレスが割り当てられたかはわからない。 DHCP サーバの情報を見に行ってもいいのだけど、 次のコマンドを打って怪しいところを調べていくと手っ取り早い。

$ for i in `seq 1 255`; do
ping -t 1 -n -c 1 192.168.0.$i 2> /dev/null &
done | grep 'bytes from'
64 bytes from 192.168.0.1: icmp_seq=0 ttl=64 time=7.468 ms
64 bytes from 192.168.0.3: icmp_seq=0 ttl=64 time=7.328 ms
64 bytes from 192.168.0.8: icmp_seq=0 ttl=64 time=3.365 ms
64 bytes from 192.168.0.29: icmp_seq=0 ttl=64 time=0.059 ms
64 bytes from 192.168.0.29: icmp_seq=0 ttl=64 time=0.046 ms

僕の環境では 192.168.0.8 が割り当てられていたのでそいつにログインします。

$ ssh root@192.168.0.8
# パスワードは root

ログインしたらまずパッケージを最新にして再起動。

[root@alarmpi ~]# pacman -Syu
[root@alarmpi ~]# reboot

再び DHCP で割り当てられた IP アドレスを調べてログインします。

$ ssh root@192.168.0.8

IP アドレスの固定

DHCP は不便なので IP アドレスを固定します。 netcfg というパッケージを使います。

[root@alarmpi ~]# pacman -S netcfg
[root@alarmpi ~]# cd /etc/network.d
[root@alarmpi ~]# cp examples/ethernet-static static
[root@alarmpi ~]# vi static

自分の環境に合うように設定を変えて netcfg サービスを登録します。 ここでは 192.168.0.200 に固定したとします。 再起動します。

[root@alarmpi ~]# systemctl enable netcfg@static
[root@alarmpi ~]# reboot

設定した IP アドレスに SSH ログインできれば OK

SD カードの全容量を使うようにする

初期では合計 2GB 程度しか使えないようになっているので、パーティションを広げます。

[root@alarmpi ~]# fdisk /dev/mmcblk0
Welcome to fdisk (util-linux 2.22.1).

Changes will remain in memory only, until you decide to write them.
Be careful before using the write command.


Command (m for help): p

Disk /dev/mmcblk0: 31.5 GB, 31486640128 bytes, 61497344 sectors
Units = sectors of 1 * 512 = 512 bytes
Sector size (logical/physical): 512 bytes / 512 bytes
I/O size (minimum/optimal): 512 bytes / 512 bytes
Disk identifier: 0x000c21e5

        Device Boot      Start         End      Blocks   Id  System
        /dev/mmcblk0p1   *        2048      194559       96256    c  W95 FAT32 (LBA)
        /dev/mmcblk0p2          194560     3862527     1833984   83  Linux

Command (m for help): d
Partition number (1-4): 2
Partition 2 is deleted

Command (m for help): n
Partition type:
   p   primary (1 primary, 0 extended, 3 free)
      e   extended
      Select (default p):
      Using default response p
      Partition number (1-4, default 2):
      Using default value 2
      First sector (194560-61497343, default 194560):
      Using default value 194560
      Last sector, +sectors or +size{K,M,G} (194560-61497343, default 61497343):
      Using default value 61497343
      Partition 2 of type Linux and of size 29.2 GiB is set

Command (m for help): w
The partition table has been altered!

Calling ioctl() to re-read partition table.

WARNING: Re-reading the partition table failed with error 16: Device or resource busy.
The kernel still uses the old table. The new table will be used at
the next reboot or after you run partprobe(8) or kpartx(8)
Syncing disks.
[root@alarmpi ~]# reboot

再びログインして

[root@alarmpi ~]# resize2fs /dev/mmcblk0p2

しばらく待ちます。戻ってきたらディスク容量を確認。

[root@alarmpi ~]# df -h

増えていれば OK

その他初期設定

root パスワード変更
[root@alarmpi ~]# passwd
SSH 設定変更

ポート変更、 root ログイン拒否くらいは。

[root@alarmpi ~]# vi /etc/ssh/sshd_config
[root@alarmpi ~]# systemctl restart sshd
ホスト名変更
[root@alarmpi ~]# vi /etc/hostname
一般ユーザの追加
[root@alarmpi ~]# adduser
sudo
[root@alarmpi ~]# pacman -S sudo
[root@alarmpi ~]# visudo
ロケールの設定
[root@alarmpi ~]# vi /etc/locale.gen

次の行を加えて

ja_JP.utf8 UTF-8

locale-gen します

[root@alarmpi ~]# locale-gen
時刻を JST に設定

ntpd が勝手に動いてくれているけど、デフォルトでは GMT 時刻になっているはず。

[root@alarmpi ~]# ln -sf /usr/share/zoneinfo/Japan /etc/localtime
以上で

基本的な設定は終わり。最後に一応再起動。

[root@alarmpi ~]# reboot

これから必要に応じてアプリケーションをインストールしていきます。

Samba のインストール

外付け HDD をつないで NAS にします。まず普通にマウントできるか確認。

$ sudo mkdir /mnt/data
$ sudo mount -t ext3 /dev/sda1 /mnt/data

問題なければ /etc/fstab に書く。

$ sudo vi /etc/fstab
/dev/sda1 /mnt/data ext3 defaults 0 0

再起動して自動でマウントされていれば OK

$ sudo reboot

次に Samba のインストール。

$ sudo pacman -S samba

Samba 関連はこれだけで全部入ります。

$ sudo vi /etc/samba/smb.conf

デフォルト設定をコピーせずに全部自分で書くほうが早いのでそうします。

[global]
workgroup = WORKGROUP
security = share
log file = /var/log/samba/log.%m
max log size = 50

dos charset = CP932
unix charset = UTF8
display charset = UTF8

[data]
comment = data
path = /mnt/data
public = Yes
guest ok = Yes
read only = No
writable = Yes
force user = dai
create mask = 0777
force create mask = 0777
directory mask = 0777
hosts allow = 192.168.

こんな感じに最低限。 ザルセキュリティだけどどうせ自分しか使わないのでいいことにする。

(2013-04-14 追記) サービスを起動する前に Samba ユーザの追加が必要かもしれない。

$ sudo pdbedit -a dai

Samba サービスを起動

$ sudo systemctl start smbd.service
  • Windows の場合はエクスプローラから \\192.168.0.200 と入力
  • Mac の場合は Finder で Cmd+k を押して 192.168.0.200 と入力

で、見えることを確認します。大丈夫ならサービスを登録

$ sudo systemctl enable smbd.service
$ sudo reboot

再起動しても大丈夫なことを確認。

Windows のエクスプローラとか Mac の Finder から自動で見えるようにしたいのだけど、 その設定はよくわかりませんでした。 Windows の場合はとりあえずショートカットを作成することができます。 Mac は AFP? の仕様が変わったらしくて (http://www.dejavuz.com/root-jobs/9423.html)、 この URL のとおりにやってみたのだけど無理そうだったので諦めました。

Subsonic のインストール

Subsonic は音楽のストリーミングをするためのサーバ。 こいつを立てておけば出先からでも自宅から音楽をストリーミングできるので、 持ち歩く手間もなければ外部のサービスにアップロードする手間もなく、 音楽の管理がとても楽になります。 もちろんインターネットからアクセスできるようにする設定は必要です。

Debian とかの場合はパッケージが用意されているのだけど、 Arch にはないので Download ページから Stand-alone 版を使います。

まず Java, lame, ffmpeg が必要なのでこれらをインストール。

$ sudo pacman -S openjdk6 lame ffmpeg

Stand-alone 版をダウンロードして SCP などでサーバに持っていきます。

次に

$ mkdir subsonic
$ mv subsonic-4.7-standalone.tar.gz subsonic
$ tar xvf subsonic-4.7-standalone.tar.gz
$ cd ..
$ sudo mv subsonic /var

Subsonic 用のユーザを作ってやるのが行儀良いですが、 ここではログインしている一般ユーザのままとして進めます。

subsonic.sh を実行するとサーバが起動します。

$ /var/subsonic/subsonic.sh

Raspberry Pi では HTTP でアクセスできるまでにかなり時間がかかるので、 この後

$ tail -f /var/subsonic/subsonic_sh.log

としてログでも眺めていると良いでしょう。

しばらくすると http://192.168.0.200:4040/ にアクセスできるようになります。 ユーザー名 admin 、パスワード admin でログイン。

初回は相当重いです。

  1. admin のパスワードを変えます
  2. 音楽ファイルを置いてある場所を指定します
    • /mnt/data/music など
    • Fast access mode にチェックを入れておきましょう。 スペック的にこれがないと遅くてやってられないです
    • Scan media folders now を押すとライブラリをスキャンします
      • 僕の場合は約 7500 ファイル中音楽ファイルは 5000 くらいで、 所要時間が 1 時間半くらいでした
  3. Transcoding のメニューから m4a, mp4 を削除します

3G 回線でストリーミングしたい場合など適当にダウンサンプリングしますが、 このとき transcoder を /var/subsonic/transcode に置いてやる必要があります。

$ cd /var/subsonic/transcode
$ sudo ln -s `which ffmpeg` .
$ sudo ln -s `which lame` .

さらにダウンサンプリングするプレイヤーで Max bitrate を設定してやる必要がある? このへんの設定はいじってもうまく動いてないっぽくてわからない・・

最後に、起動時に自動で立ち上がるように .service ファイルを書いて登録します。

$ sudo vi /etc/systemd/system/subsonic.service
[Unit]
Description=Subsonic

[Service]
Type=forking
User=dai
Group=users
ExecStart=/var/subsonic/subsonic.sh

[Install]
WantedBy=multi-user.target

正直 .service ファイルの書き方はよくわかってないのだけどこんな感じ。 man systemd.service が詳しいので読むほうがいいと思います。

日本語ファイルがうまく再生できなかったので、

export LANG=ja_JP.UTF-8

subsonic.sh の先頭に書きました。正しくなさそうなやり方な気がするけど。

で、サービスを登録

$ sudo systemctl enable subsonic.service

再起動して自動的に起動されることを確認。

$ sudo reboot

あとはルータの設定をいじってポート解放しておきます。

DDNS 自動設定

ValueDomain でドメインをとっているので、自動で DDNS を設定するスクリプトを使います。

説明は省略。

Markdown メモツール mamemose を作りました

mamemose: Markdown memo server

Markdown で快適にメモを取るためのツールを作ったので公開しました。 mamemose といいます。 Ruby でできています。 UNIX ライクな環境で動きます。

コレは何

軽量マークアップ言語である Markdown でメモを取るためのツールです。 この手のツールはすでにいくつか存在しますが、 mamemose は次の特徴を持っています。

  • Ruby
  • ローカルで HTTP サーバとして動く
  • テキストエディタ等で書かれた Markdown 形式のファイルを、コマンド操作無しで HTML に変換して表示する
  • ローカルに余計な HTML ファイルなどを生成せず、ディレクトリを汚さない
  • 複数マシンで内容を共有できる (要 Dropbox 等)
    • 出先でモバイル端末からも Dropbox 等にアクセスして手軽に見ることができる
  • 使い慣れたエディタでメモを取ることができる
  • 検索できる
  • ディレクトリを掘ることで構造化する。タグなどで管理する機能はない

公開までの流れ

半年ほど前のある日、僕はある勉強会に参加していました。 それまでにも何かするたびにメモをどうにかして残そうとは思っていたものの、 馴染むツールが見つからず結果としてあまり見返したいと思えないようなメモになってしまうことが常でした。

その日試しに Markdown というもので一度メモを取ってみて、その手軽さを知りました。 Markdown はそれまで聞いたことはあったものの、「所詮 HTML に変換するだけだろー」と いう感じであまり良い物には思えなかったのです。 しかし実際に触れてみてその考えは180度変わりました。 むしろ自分の書くメモをすべて Markdown で書きたいと思うまでになったのです。

世の Markdown メモツールを探しましたが、いまいちコレというものが見つかりませんでした。 プログラムを書くのと同じ感覚でメモを取りたい。 ふと気づいたときにさっとエディタからメモを取りたい。 そして見るときは HTML + CSS で綺麗にマークアップされたものを見たい。 でも変換のためにコマンドを打つのは嫌だし、同じ内容の Markdown ファイルと HTML ファイルが別々に存在するのも嫌だな。 複数マシン間での同期は必須 (これは Dropbox 様の力を借りてもいい)。 もちろんマルチプラットフォーム、少なくとも Mac と Linux は必須。 プログラムのシンタックスハイライトもしてほしいかな。できれば数式も打ちたい。

このような自分の要求に答えるメモツールは探した限りでは見つかりませんでした。 そこで自分で作ることにしたのです。

ある程度使える状態まで作ったものを初めは gist で公開していました。 その後機能が増えてきたので GitHub の普通のリポジトリに変更しました。 そして今日、 RubyGems に公開し、簡単にインストールできるようになりました。

名前は mamemose といいます。発音は「マメモス」でしょうか。 Markdown memo server で mamemose です。 ネーミングセンスないって言うなよ。

インストール

RubyGems に公開されています。インストールはコマンド一発

$ gem install mamemose

でできます。

使い方

詳しくは GitHub のページ を読んでください。 流れとしては、

  1. 設定ファイル ~/.mamemose.rb に設定を書く。
  2. $ mamemose コマンドで mamemose サーバが起動
    • ~/.gem/*/bin あたりにパスを通す必要あるかも
    • ログイン時に自動的に起動するように設定するとよいでしょう
  3. http://localhost:PORT/ にアクセスすると、設定ファイルの DOCUMENT_ROOT で指定したディレクトリ以下のファイルが綺麗にマークアップされて見ることができます。
  4. もちろん、メモを編集したらブラウザの更新ボタンを押すだけで反映されます。 煩わしいコマンド入力などは必要ありません。

という感じです。

シンタックスハイライトは、広く使われている GitHub Flavored Markdown の構文を使うことができます。 ただしハイライトエンジンは JavaScript 製の SyntaxHighlighter を使います。シンタックスハイライトの機能については、一時期 Pygments を使うなど悩んだのですが、 あまりサーバの役割を増やしたくないということでこの形に落ち着きました。

また、 MathJax の力を借りて数式も書くことができます。 構文はほぼ LaTeX そのままなので、新しい数式マークアップの構文を覚える必要もありません。

その他

なぜ Ruby で作ったのか

普段使う言語は Haskell, C++, Ruby です。 そのうちなぜ Ruby を選んだかということですが

  • RubyWEBrick という標準ライブラリでとても手軽に HTTP サーバを立てることができること。 また Ruby 言語自体の表現力の豊かさから、そのサーバを拡張して アクセスされたファイルに変換をかまして返すような機能を実装するのに最適だったこと。
  • Ruby は広く使われているし、いくつかのプラットフォームでは標準で入っている。 Haskell に比べれば導入障壁ははるかに低いということ。

ということが挙げられます。

ちなみに僕はエセ Rubyist で、書き捨てのスクリプトを Ruby で書くことはよくありましたが、 真面目なプロジェクトで Ruby を使ったことはありません。 bundler とかも存在は知っていたもののほぼ初めて使った感じ。 もちろん RubyGems への登録も初めて。

注意

あくまで「ローカルで使う個人用のメモツール」の前提なので、公開用の Web サイトとかで使わないように。 たぶん重すぎて使いものにならないです。

テスト

書いてない。 5ヶ月ほど使ってきて致命的に困ったことはないので大丈夫だと思うのだけど。 もちろん書くべきとは思っている。

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