オートマトンで遊ぶやつを作った
この記事はHaskell Advent Calendar 2015 18日目の記事です.
Automatoy(オートマトン)で遊ぶやつを作ったので紹介します.
ブラウザで遊べる.
以下それっぽい解説.
Automatoyについて
http://myuon.github.io/automatoy/
"Def"タブでオートマトンを定義.
"Check"タブで与えられた文字列のacceptance checkができる.
"Conversion"タブでいくつかのサンプルオートマトンを読み込んだり, NFAをDFAに変換(いわゆるpowerset construction)できる.
また, 右上のImport/Exportでjsonに変換したり, jsonを読み込んだりできる.
もう少し扱えるオートマトンのバリエーションを増やしたり, acceptance checkにアニメーションを取り入れたり, アルゴリズムを増やしたり(complementとかそういうやつ)したら面白そう.
ものすごく気が向いたら頑張って開発する. (たぶんしない)
オートマトンの絵を書くのには, Cytoscapeを使った.
Haskellでコードを書いて, HasteでJavascriptにコンパイルしている.
HasteとTemplateHaskell(以下TH)
Hasteでは現在THがサポートされていないのでlensを含む, THが使われているライブラリをインストールして使うことができない.
lensの場合は, THを含まないより簡単なパッケージとしてlens-familyがあるのでこれを使った.
さて, lensには便利なmakeLensesという機能(TH)があるのでこれを使いたいのだが, lens-familyでこれをやるためには以下のコードを書く必要がある.
data Hoge = Hoge { _f1 :: k1, _f2 :: k2, .. , _fn :: kn } f1 :: Lens' Hoge k1; f1 = lens _f1 (\p x -> p { _f1 = x }) .. -- フィールドの個数だけ繰り返す fn :: Lens' Hoge kn; fn = lens _fn (\p x -> p { _fn = x })
これが最高に面倒くさい(特に, 各fiの型をそれぞれ宣言しなければならないことと, _fiとfiのいずれもexportしないといけないところ)のでどうにかしたかった.
これを解決する1つの方法として, Extensible Recordsを提供するextensibleというパッケージを使うというのがある.
extensibleはTHを使っているのでこれをそのままHaste環境にインストールはできないけれど, 少しアイデアを借りてそれらしいもの(もっと簡単なやつでよい)を実装することにした*1.
Union Type
結局以下のようなことができれば良い:
k1 .. kn
型をまとめて管理するコンテナ(リストのようなもの)を用意する- コンテナへのアクセサとしてlensを提供する.
getter "fi"
のようにして値にアクセスできるようにする - アクセサはコンパイル時にvalidかどうかをチェックする. 存在しない名前などはコンパイルエラーにする. (コンパイル時にやる必要があるかどうかは趣味の問題だけれど, タイプミスなどはコンパイルエラーにしてくれた方が明らかに便利なので今回はコンパイル時にやる)
1番目はヘテロリスト(1-kind list)でよい.
2番目は型クラスを使って上手くやろう.
3番目は文字列の代わりにSymbolを使えば良い.
実装
data HList (xs :: [*]) where HNil :: HList '[] HCons :: x -> HList xs -> HList (x ': xs) data Union (xs :: [*]) = Union (HList xs) data (:<) (s :: Symbol) a = Tag a data Name (s :: Symbol) = Name
実際にUnionを使うときは, Union <("intValue", 20), ("charValue", 'a')>
のように, Symbolと値をペアにして使う.
これを(s :: Symbol) :< (a :: *)
でペアを表すことにしている.
Nameは単にSymbolのみを型としてつかえるようにするもの.
class MakeLense (xs :: [*]) (s :: Symbol) out | xs s -> out where getter' :: Name (s :: Symbol) -> HList xs -> out setter' :: Name (s :: Symbol) -> (out -> out) -> HList xs -> HList xs instance MakeLense ((k :< v) ': xs) k v where getter' _ (HCons (Tag v) _) = v setter' _ f (HCons (Tag v) xs) = HCons (Tag $ f v) xs instance {-# OVERLAPPABLE #-} MakeLense xs syb out => MakeLense ((k :< v) ': xs) syb out where getter' k (HCons _ xs) = getter' k xs setter' k f (HCons x xs) = HCons x $ setter' k f xs getter :: (MakeLense xs s out) => Name (s :: Symbol) -> Getter' (Union xs) out getter syb = to $ \(Union hl) -> getter' syb hl setter :: (MakeLense xs s out) => Name (s :: Symbol) -> Setter' (Union xs) out setter syb = setting $ \f (Union hl) -> Union $ setter' syb f hl lenses :: (MakeLense xs s out) => Name (s :: Symbol) -> Lens' (Union xs) out lenses syb = lens (^. getter syb) (\u x -> set (setter syb) x u)
以下のような感じで使う.
data Flag = A | B | C deriving (Show) data Gender = F | M deriving (Show) type Ext = Union ["flag" :< Flag, "money" :< Int, "gender" :< Gender] runExt :: StateT Ext IO () runExt = do lenses (Name :: Name "flag") .= B lenses (Name :: Name "money") += 30 g <- use (getter (Name :: Name "gender")) case g of F -> lenses (Name :: Name "gender") .= M M -> lenses (Name :: Name "gender") .= F main = do print "hoge" let iniExt = Union $ HCons (Tag A) (HCons (Tag 0) (HCons (Tag F) HNil)) :: Ext print $ iniExt ^. getter (Name :: Name "flag") print $ iniExt ^. getter (Name :: Name "money") ext' <- execStateT runExt iniExt print $ ext' ^. getter (Name :: Name "flag") print $ ext' ^. getter (Name :: Name "money")
Name :: Name "hoge"
などと書かなければいけないのは面倒だけれど, 最初に書いたような面倒は多少軽減されたはず.
課題とか
このままだとUnion型の値を定義するのが面倒とか, 存在しないキーがあるときのエラーメッセージがあまりユーザーフレンドリーでないなどの問題がある.
ので, そのへんはextensibleの中では結構上手く解決されているので興味がある人はData.Extensible.Fieldなどを読むとよいでしょう.
自分は下のコードで大体満足しているけれど.
全体
MakeLense.hs(ちょっとだけ改良版)のコードは以下.