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などを読むとよいでしょう.
自分は下のコードで大体満足しているけれど.