「.gladeファイルのデータ→GUIの各ウィジェット読込」のコードをTHで自動生成する。

前記事（http://hshstter.hatenablog.com/entry/2012/04/15/121001）でTemplate Haskellを使ってみましたが、Mainモジュールにはもっと大きなboilerplateがあるので、それを何とか出来ないかと思ってやってみました。今まで気になっていたけどどうしても直せなかった箇所です。

現在、GUIのデータは次のようなmonolithicな型で管理しています。

-- GUIデータ型
data GUI = GUI {
 mainWin :: !Window,
 information :: !Label,
 tweetEntry :: !Entry,
 tweetButton :: !Button,
 timelineWin :: !ScrolledWindow,
 timeline :: !(IORef [Timeline]),
 accessTokenGetWin :: !Window,
 hint :: !Label,
 authorizationButton :: !Button,
 cancelButton :: !Button,
 pinEntry :: !Entry,
 authorizationURL :: !Entry
 }

で、これらデータの読み込みはtimelineを除いてGladeで出力したxmlデータから次のように読み込んでいます。

xmlNewIO :: FilePath -> IO GladeXML
xmlNewIO gladePath = do
  maybeXML <- xmlNew gladePath
  case maybeXML of
    Nothing -> fail "XML format error."
    Just xml -> return xml

-- .gladeファイル（XML形式）をロード・GUI型に変換
loadGlade :: FilePath -> IO GUI
loadGlade gladePath = do
  -- XMLをロード
  xml <- xmlNewIO gladePath

  mainWin <- xmlGetWidget xml castToWindow "mainWin"  -- メインウインドウをロード
  information <- xmlGetWidget xml castToLabel "information"  -- 情報
  tweetEntry <- xmlGetWidget xml castToEntry "tweetEntry"  -- ツイート入力部をロード
  tweetButton <- xmlGetWidget xml castToButton "tweetButton"  -- ツイートボタンをロード
  timelineWin <- xmlGetWidget xml castToScrolledWindow "timelineWin" -- タイムライン表示部をロード
  accessTokenGetWin <- xmlGetWidget xml castToWindow "accessTokenGetWin"  -- Access Token取得ウインドウをロード
  hint <- xmlGetWidget xml castToLabel "hint"  -- 認証用メッセージをロード
  authorizationButton <- xmlGetWidget xml castToButton "authorizationButton"  -- Authorizationボタンをロード
  cancelButton <- xmlGetWidget xml castToButton "cancelButton"  -- Cancelボタンをロード
  pinEntry <- xmlGetWidget xml castToEntry "pinEntry"  -- PIN入力部をロード
  authorizationURL <- xmlGetWidget xml castToEntry "authorizationURL"  -- 認証用URL表示

  timeline <- newIORef 
  return $ GUI mainWin information tweetEntry tweetButton timelineWin timeline
                      accessTokenGetWin hint authorizationButton cancelButton pinEntry authorizationURL

このロード→キャスト部は次のようなほとんど同じ構造をしています。

（guiField :: GuiTypeの読み込み）
guiField <- xmlGetWidget xml castToGuiType "guiField"

そこで、この部分を自動生成するマクロを書いてみました。

まず、GUI型からタイムラインのリストtimelineを分離し（考えてみたらGUIウィジェットでは無いのでこの型のフィールドになってるのはおかしいですね……）、GUI型をウィジェット名に対応したフィールドのみの型にします。

-- GUIデータ型
data GUI = GUI {
 mainWin :: !Window,
 information :: !Label,
 tweetEntry :: !Entry,
 tweetButton :: !Button,
 timelineWin :: !ScrolledWindow,
 accessTokenGetWin :: !Window,
 hint :: !Label,
 authorizationButton :: !Button,
 cancelButton :: !Button,
 pinEntry :: !Entry,
 authorizationURL :: !Entry
 }

で、次のような感じで、パーツを態々指定せずにxmlデータをGUI型に一発でキャストしたい。

-- .gladeファイル（XML形式）からGUIウィジェットロード・GUI型に変換
loadGUI :: FilePath -> IO GUI
loadGUI = $(castToGUI ''GUI) <=< xmlNewIO

これを実現するためには、

(1)データ名GUI( :: Name)から各フィールドの名前を取得(2)ロード→キャスト部テンプレの列を自動生成(3)GUI構成子に包んで返す

の手順を踏めばいいだけです。(2)(3)はただ前回記事でやったように構文木を構成すればいいだけの話で、(1)もreify関数を使えば出来ます。

reify :: Name -> Q Info

 この関数に先のGUI型を突っ込むと次のような情報が得られます。

TyConI (DataD  Main.GUI  [RecC Main.GUI [(Main.mainWin,IsStrict,ConT Graphics.UI.Gtk.Types.Window),(Main.information,IsStrict,ConT Graphics.UI.Gtk.Types.Label),(Main.tweetEntry,IsStrict,ConT Graphics.UI.Gtk.Types.Entry),(Main.tweetButton,IsStrict,ConT Graphics.UI.Gtk.Types.Button),(Main.timelineWin,IsStrict,ConT Graphics.UI.Gtk.Types.ScrolledWindow),(Main.accessTokenGetWin,IsStrict,ConT Graphics.UI.Gtk.Types.Window),(Main.hint,IsStrict,ConT Graphics.UI.Gtk.Types.Label),(Main.authorizationButton,IsStrict,ConT Graphics.UI.Gtk.Types.Button),(Main.cancelButton,IsStrict,ConT Graphics.UI.Gtk.Types.Button),(Main.pinEntry,IsStrict,ConT Graphics.UI.Gtk.Types.Entry),(Main.authorizationURL,IsStrict,ConT Graphics.UI.Gtk.Types.Entry)]] )

 データ名と構成子の名前が一致しているのでわかりづらいですが、青で示したほうがデータ構成子で、紫で示したほうがデータ名です。黄色で示した部分は各フィールドに関する情報のリストで、それぞれ

type VarStrictType = (Name, Strict, Type)
Name: フィールド名
Strict: 正格かどうかのフラグ
Type: フィールドの型

という 形式をしています。

次に、do式の構文木ですが、試しに

do
  x <- newIORef ""
  y <- newIORef 0
  z <- newIORef 1
  return ()

 の構文木を調べると

DoE [
     BindS (VarP x_0) (AppE (VarE GHC.IORef.newIORef) (LitE (StringL ""))),
     BindS (VarP y_1) (AppE (VarE GHC.IORef.newIORef) (LitE (IntegerL 0))),
     BindS (VarP z_2) (AppE (VarE GHC.IORef.newIORef) (LitE (IntegerL 1))),
     NoBindS (AppE (VarE GHC.Base.return) (ConE GHC.Tuple.()))
    ]

となっているようです。見た目にはわかりやすいですね。変数束縛している行がBindS、していない行がNoBindSで表されているようです。

これに沿ってGUI読込部の構文木を生成するマクロを書くとこうなります。

これを先ほど示したインタフェースで呼び出すと、GUI部品の読み込みに成功しました！

最近はMainモジュールがごちゃごちゃしていたのでリファクタリングにとりくんでいたのですが、やっぱりTHはboilerplate潰しが捗りますね。ちなみに今回のcommitでMainモジュールが200行切りました。

全体のコード

https://github.com/xenophobia/hshstter/tree/35b64dd2f9b860a8ce456deaa2996a4fecdc8dab