Haskell ではじめるふわとろ Cocoa アプリ開発 konn-san.com

再コンパイルに御用心

生成される Obj-C ファイルで使われるラッパ関数名は、Template Haskell が走る度に異なる名前になります。ファイルの幾つかを変更して再コンパイルすると、「関数が見付からないよ！」と怒られる場合があります。その場合は、生成された .hi, .o, _objc.[hm] ファイルをすべて削除して、もういちど最初からやり直してみてください。

はじめの一歩：原始的な GUI

Hello, World! はうまくいきましたね。それではもう少しマトモなアプリケーションを書いてみましょう。OOPにおける Hello, World! とでもいうべき Currency Converter （通貨換算器）を作ってみましょう。

まず、Xcodeを開いて新しい “Cocoa Application” プロジェクトを作成します（そんなの面倒くさい！とか Xcode の使い方なんて知らん！という場合、こちらに既に用意してあります！）。MainMenu.xib を開いて、次のような感じでウインドウにコントロールを配置し、AppDelegate との間にアウトレット、アクションを設定してください：

ロジックなどはまだ実装していませんが、この段階でいちど Release をターゲットにしてアプリケーションをビルドします。ビルドが完了したら、出来上がった実行ファイルを適当な場所にコピーしておいてください。

続いて、Haskell でアプリケーションのロジックを記述します。

Main.hsファイルを作成して、必要なモジュールやObj-C側のフレームワークの読み込みをしておきます：

{-# LANGUAGE DeriveDataTypeable, QuasiQuotes, TemplateHaskell #-}
module Main where
import Data.Typeable          (Typeable)
import Language.C.Inline.ObjC
import Language.C.Quote.ObjC

objc_import ["<Cocoa/Cocoa.h>"]

では、メインロジックである変換関数convertを実装してみましょう。 通貨換算器という大仰な名前でも、結局やることは

1. 換算前の価格（dollarsField）と為替レート（rateField）の値を取得し、
2. 両者を掛け算して、
3. その結果を表示（resultField）する。

ということだけで、実質掛け算するだけです。Cocoa のリファレンスマニュアルなどと首っぴきになれば、テキストフィールドの値の取得・設定は-(int) intValueや-(double) doubleValue、-(void) setIntValue:(double) valなどを使えばよさそうなので、メインロジックであるconvertの実装は次のように書けば良さそうです：

convert :: AppDelegate -> IO ()
convert app = do
  input <- intValue    =<< dollarsField app
  rate  <- doubleValue =<< rateField app
  setIntValue (floor $ fromIntegral input * rate) =<< resultField app

このあとすべき事が幾つかあります：

1. AppDelegateやNSTextFieldなどに対応する型をHaskell側で定義する
2. intValue, doubleValue, setIntValue の実装
3. Obj-C 側のAppDelegateクラスのconvert: アクションと上で実装したconvert関数との紐付けとmain関数の実装
4. アプリケーションバンドルの作成

それぞれ順に見ていきましょう。

Obj-C のオブジェクトを Haskell で扱うには？

language-c-inlineでは、基本型（int, BOOL, charなど）以外のObj-Cの値は、ForeignPtrをnewtypeで包んだ型で表現されます。たとえば、AppDelegate に対応するHaskellの型は、

newtype AppDelegate = AppDelegate (ForeignPtr AppDelegate)
                      deriving (Typeable)

のように宣言されます。型コンストラクタの名前が、そのままObj-Cでの型名として扱われます。現時点におけるlanguage-c-inlineライブラリの内部実装では動的キャストを使っているため、Typeable のインスタンスを導出させておく必要があります。また、これも内部実装の制約から、newtype宣言はレコード型ではなく、このようなコンストラクタのみの形で宣言される必要があることに注意してください。

実際には、AppDelegateの値をやりとりするには、次のような行を追加しておく必要があります：

marshalAppDel :: AppDelegate -> IO AppDelegate
marshalAppDel = return

objc_marshaller 'marshalAppDel 'marshalAppDel

字面からなんとなくわかるかもしれませんが、ここではAppDelegate型の値をHaskellとObj-Cの間でやりとりする際のマーシャリング関数を定義しています。objc_marshallerマクロは、それぞれA -> IO B と B -> IO Aという形の型を持つ関数の名前をとって、A, B型の値を相互変換するための情報を保存します。このマーシャリングの情報はモジュールごとに保存されるので、モジュールを変えるたびにobjc_marshallerを呼び出して関数を登録してやる必要があることに注意してください。

今回の場合は、単にポインタに包まれた値をやりとりするだけなので、A = B = AppDelegateとして何もせずにreturnするだけの関数を登録しています。

同様にして、NSTextFieldを表す型も定義できます：

newtype NSTextField = NSTextField (ForeignPtr NSTextField)
                      deriving (Typeable)

marshalNSTextField :: NSTextField -> IO NSTextField
marshalNSTextField = return

objc_marshaller 'marshalNSTextField 'marshalNSTextField

ラッパ関数の定義

intValueやsetIntValue、あるいはdollarsFieldアウトレットなどを取得するためのHaskell関数は、Hello, World!の例でNSLogのラッパ関数を定義した時と同様にして、objc マクロを使って定義してやれば十分です。ためしにintValue, rateField, setIntValueの定義を見てみましょう：

intValue :: NSTextField -> IO Int
intValue txt = $(objc ['txt :> ''NSTextField] $
                 ''Int <: [cexp| [txt intValue] |])

rateField :: AppDelegate -> IO NSTextField
rateField app = $(objc ['app :> ''AppDelegate] $
                     Class ''NSTextField <: [cexp| app.rateField |])

setIntValue :: Int -> NSTextField -> IO ()
setIntValue i txt =
  $(objc ['i :> ''Int, 'txt :> ''NSTextField] $
    void [cexp| [txt setIntValue: i] |])

ここで、Classという見慣れないコンストラクタが出現しています。そもそも、(:>)や(<:)の引数として異なる型の値が渡されているように見えます。これはどういうことなのでしょう？

というところで、(:>)やClassの定義を見てみましょう：

data Annotated e where
  (:>)  :: Hint hint => e    -> hint -> Annotated e
  Typed ::              Name         -> Annotated Name

(<:) :: Hint hint => hint -> e -> Annotated e
(<:) = flip (:>)

data Class where
  Class :: IsType t => t -> Class

まず、(:>)はどうやらAnnotated型のコンストラクタだったようです。Annotated 型は、その名の通り値を型の相互変換に関するヒントで注釈したものです。そのヒントとなりうる型はライブラリで定義されていて変更出来ませんが、TypeQ, Name, Class 型などがあります。Class型は、ForeignPtrで包まれたObj-Cのオブジェクトである、という意味のヒントのようですね。

こうしたことを踏まえて上の定義を見てみれば、あとはそんなに驚くようなことはやっていないと思います。 これらに習って、doubleValueやdollarField, resultFieldなど必要な関数のラッパを定義してみてください。

アクションと Haskell 関数の紐付け、およびmain関数

以上で、Haskell側のconvert関数の実装は完了しました。これを Obj-C 側から呼び出すにはどうすればいいでしょうか？

まず、Obj-Cのヘッダファイルの情報を生成してやる必要があります。 そこで、次のコードを、AppDelegateのマーシャリング関数を定義する行より前に追加してください：

objc_interface [cunit|
@interface AppDelegate : NSObject <NSApplicationDelegate>
@property (weak) typename NSTextField *dollarsField;
@property (weak) typename NSTextField *rateField;
@property (weak) typename NSTextField *resultField;

- (void)convert:(id)sender;
@end
 |]

幾つか説明が必要でしょう。まず、これをobjc_marshalより前に持ってくる必要があるのは、生成する対象のObj-C（というかC言語）が関数・型の定義順にうるさい言語だからで、objc_marshallが生成するマーシャル関数のプロトタイプ宣言にAppDelegateという型名があるため、それより前でAppDelegateクラスを定義しておく必要があるからです。

また、Obj-Cではこんな変な市にtypenameなどというキーワードが来ることはなかった筈です。このキーワードは、languace-c-quote独自のもので、Cのコードをパーズするのにあらかじめ型の情報が必要となるため用意されています。intやdouble, charなどの基本型はlanguage-c-quoteも知っているので大丈夫ですが、NSTextFieldは知りせん。なので、「この後に型名がくるよ！」という事を明示するために、typenameキーワードでそれを明示している訳です。typenameキーワードが必要になるのは、今回のような変数・プロパティの宣言の他に、関数の引数や返値の型宣言などの部分でも必要になります。

さて、これでヘッダファイルの情報は十分です。実際にconvert:アクションからHaskellのconvert関数を呼び出すようにするには、次のコードを書く必要があります：

objc_implementation [Typed 'convert] [cunit|
@implementation AppDelegate
- (void) convert: (id)sender
{
  convert(self);
}
@end
 |]

このコードは、convert関数が定義されている行よりも下に書いてください。これも、TemplateHaskellの制限によるものです。

objc_implementationマクロは、その名の通り実際のObj-Cの実装ファイル（.m）のトップレベル宣言を定義するマクロです。 objc_interfaceマクロはObj-Cの式だけを取りましたが、objc_implementationマクロは、実装内部で使われるHaskell関数のヒント付き名前の一覧も引数に取ります。ここでは[Typed 'convert]がそれに当ります。Typedは、上でも出て来たAnnotated型のコンストラクタで、「この名前の関数は定義済みだから適当に型推論しといて」という意味です。同じ名前のconvertが出て来て混乱するかもしれませんが、-(void) convert:(id)senderの定義部で呼ばれているconvertは、Haskellにおけるconvert関数を指しています。実際には、この裏で一意な名前を持つラッパ関数の呼び出しに置き換えられますが、ナイーヴにはconvert Haskell関数を呼び出していると思えばよいです。

最後に main 関数を実装しましょう。以下の行をファイルの最後に追加してください：

nsApplicationMain :: IO ()
nsApplicationMain = $(objc [] $ void [cexp| NSApplicationMain(0, NULL) |])

objc_emit

main :: IO ()
main = do
  objc_initialise
  nsApplicationMain

まず、objc_initialiseを呼び出してObj-Cラッパーを初期化した後、おもむろに NSApplicationMain関数を呼び出して、.xibファイルからオブジェクトを初期化したりといったCocoaの側の初期化をよしなにやってもらっています。

これでMain.hsの内容は完成です（完全なソースコードはこちら）。

アプリケーションバンドルの作成

では、アプリケーションバンドルを作成しましょう。まず、Main.hsを今まで通りコンパイルします：

$ ghc -c Main.hs
$ cc -fobjc-arc -I/Library/Frameworks/GHC.framework/Versions/7.8.3-x86_64/usr/lib/ghc-7.8.3/include -I/Library/Frameworks/GHC.framework/Versions/7.8.3-x86_64/usr/lib/ghc-7.8.3/../../includes   -c -o Main_objc.o Main_objc.m
$ ghc -o CurrencyConverter Main.o Main_objc.o -package language-c-quote -package language-c-inline -framework Cocoa

問題なくコンパイルできていれば、CurrencyConverterバイナリが出来ている筈です。そこで、これを一番最初にXcodeで作成しておいた CurrencyConverter.app のしかるべき場所にコピーします（CurrencyConverter.appは同じディレクトリに配置されていると仮定します）：

$ cp CurrencyConverter CurrencyConverter.app/Contents/MacOS/CurrencyConverter

これで完了です！早速起動してみましょう：

値を入力して、Convertボタンを押せば、ちゃんと期待通りの動作をすることが確認できました。やったね！

継承関係とインスタンスの表現

まずクラス間の継承関係ですが、これは次のように型クラスで表現するのが自然でしょう：

{-# LANGUAGE PolyKinds, TypeOperators, MultiParamTypeClasses #-}
class (super :: k) :> (sub :: k2)
instance a :> a

要は、型レベルの不等号(:>)によってそのまま継承関係を定義してやる訳です。Obj-Cには通常の継承関係の他にも多重継承にあたるようなプロトコルの機能がありますが、それについても適当に (:>) でコードしてやれば呼び出す分には問題ないでしょう。

では、Obj-Cでのオブジェクトの継承関係をこれを使って実際に表現していくことにしましょう。取り敢えず、klass クラスのインスタンスを表す型として、Object型を定義しましょう：

newtype Object (klass :: k) = Object (ForeignPtr ())
                              deriving (Typeable, Show, Eq, Ord)

ForeignPtrを包む newtype は、Haskellにおける型名と同じ名前のクラスと同一視されるのでした。そこで、たとえば NSString を表すためには

type NSString = Object "NSString"

のように Object の型パラメータを埋めた型シノニムを定義して、それを用いることにします。これで巧くいくためには、GitHub上の最新のlanguage-c-inlineが必要です。これは、型シノニムの名前を使ってObj-C側のクラス名を解決しつつ、ForeignPtrに行き着くまで型を展開する、という挙動が、Hackageに上がっている版にはまだ実装されていないからです。

また型の文脈に文字列リテラルのようなものが出て来てびっくりするかもしれませんが、これはSymbolカインドという型レベルの文字列のようなものです。Symbolを使うようにすると、一々クラス名を表すダミーの型を定義せずに済むので楽です。

このようにすると、アップキャストは単にコンストラクタを付け替えるだけで出来るようになります：

cast :: (a :> b) => Object b -> Object a
cast (Object ptr) = Object ptr

ダウンキャストも同様に実装出来ますが、まあ安全ではないので unsafeDownCast とかいう名前にしておきましょう。

メッセージの表現

Obj-Cはオブジェクト指向言語の中でも、Smalltalkに大きな影響を受けたメッセージベースのオブジェクトシステムを採用しています。 そこで、次はオブジェクトに対するメッセージを扱えるようにしましょう。Obj-C ではメッセージの名前をセレクタと呼ぶので、セレクタを表す型クラスを定義してみましょう：

class Selector cls msg | msg -> cls where
  data Message (msg :: k') :: *
  type Returns msg :: *
  send' :: Object cls -> Message msg -> Returns msg

いまいち意味が見えづらいかもしれません。たとえば、NSControlクラスの-(void) setObjectValue:(id) objに当るセレクタは次のように定義します：

instance Selector "NSControl" "setObjectValue" where
  data Message "setObjectValue" = SetIntValue NSObject
  type Returns "setObjectValue" = IO ()
  send' ctrl (SetObjectValue num) = $(objc ['ctrl :> Class ''NSControl, 'obj :> Class ''NSObject] $
                                      void [cexp| [ctrl setObjectValue: obj] |])

つまり、Selectorの関連データ型である Message はメッセージを送るのに必要な引数を保持するデータ型であり、Return関連型はその操作の結果のHaskellにおける返値の型に対応している訳です。書きやすいように、中置演算子版も用意しましょう：

infixl 4 #
(#) :: (a :> b, Selector a msg, Returns msg ~ IO c, MonadIO m) => Object b -> Message msg -> m c
obj # f = liftIO $ send' obj f

infixl 4 #.
(#.) :: (a :> b, Selector a msg, Returns msg ~ IO c, MonadIO m) => IO (Object b) -> Message msg -> m c
recv #. sel = liftIO $ recv >>= flip send' sel

(#)が中置演算子版で、のものは、メソッドチェーンにして呼び出していくときに、便利なように定義されたものです。

継承ツリーをちゃんと機能させるために

ところで、今までに定義してきた継承関係の推論規則には、反射律（A は A 自身のサブクラス）しか入っていません。このままだと、サブクラスのサブクラスが元のスーパークラスのサブになりません³。では、推移律を条件に入れてはどうでしょうか？

instance (a :> b, b :> c) => a :> c

残念ながら、これはうまくいきません。a :> cのインスタンスを得るのに、間に出て来る b をどう扱えば良いかわからないからです。 これには、たとえば、単純な継承関係をやめて、例えば継承関係を一段ずつ型レベルリストにして型パラメータで持たせるといった方法が考えられます。しかし、なんだかそれは余りにもオーバーキルです。他にも型機能を駆使して実現する方法もあるかもしれませんが、ここでは違う方針を取ります。

どうするのかというと、直接 (:>) のインスタンスを宣言するのではなく、それまでの型情報を使って、スーパークラスのスーパークラス、更にそのスーパークラス……と辿っていって、推移律を満たすのに必要なインスタンスを宣言するような Template Haskell マクロを実装してしまうことにします。

という訳でそのように実装されているのが、defineClassおよびdefinePhantomClassマクロです（それぞれMessaging.Macroで定義されています）。たとえば、NSObject, NSString, NSMutableStringなどの継承関係を定義するには、次のようにすれば、万事面倒を見てくれます：

defineClass "NSObject" Nothing
defineClass "NSString" $ Just ''NSObject
defineClass "NSMutableString" $ Just ''NSString

つまり、NSObject :> NSString, NSString :> NSMutableString, NSObject :> NSMutableStringといった、必要な(:>)のインスタンスがこれにより全て生成され、type NSObject = Object "NSObject"などの型シノニムも定義されます。

definePhantomClass は、更に幽霊型を引数にもつように定義してくれます。たとえば、

definePhantomClass 1 "NSArray" $ Just ''NSObject

のようにすると、type NSArray a = Object "NSArray" といったような、型シノニムが宣言されるのです。ただ、これは今のところ共変性や反変性とかを全く考慮していないので、あんまり嬉しくないかもしれません。

これで必要な継承関係は面倒を見てくれるようになりましたが、このままだと折角継承関係を定義したのに、手動でアップキャストしたりしながらメッセージを送らないといけません。そこで、まずは受け手を自動でアップキャストしてくれるような send を実装しましょう：

send :: (a :> b, Selector a msg) => Object b -> Message msg -> Returns msg
send = send' . cast

単にcastを前に合成してやればいいだけですね。問題は、メッセージの引数のアップキャストですが、各メッセージに対してたとえば以下のようにしてObject型の引数を取る引数にcastを被せた便利関数を定義すればよさそうです：

setObjectValue :: ("NSObject" :> a) => a -> Message "setObjectValue"
setObjectValue obj = SetObjectValue (cast obj)

こうしたものを一々定義するのは面倒なので、これもマクロで解決してしまいましょう。ということで、造られたのが defineSelector関数です。これを使うと、たとえばsetObjectValue の定義は次のようになります：

defineSelector newSelector { selector = "setObjectValue"
                           , reciever = (''NSControl, "ctrl")
                           , arguments = ["obj" :>>: Class ''NSObject]
                           , definition = [cexp| [ctrl setObject: obj] |]
                           }

:>>:は、language-c-inlineの:>:を模倣して定義した型です。模倣したのは、language-c-inlineのHint回りのインスタンス等を後付けで増やせなかったからです。多分。また、NameではなくString型の値を取るようになっていることに注意してください。

ここまでやれば、だいたい Haskell から呼び出す分の Obj-C のオブジェクトシステムは模倣出来ることになるでしょう。

準備とディレクトリ構成の変更

ところで、いちいちghcとかccを適切な順番で呼ぶのって面倒ですよね。フレームワークや必要なパッケージの情報は Cabal ファイルにまとめておいて、あとは適宜必要なモジュールや生成されたObj-Cファイルなどを再帰的にコンパイルしてるえたら便利です。

という訳で、コーディングに入る前にここをまず自動化してしまうことにします。まず、以下のようなディレクトリ構成にします：

  +- src
  |   |
  |   +- Main.hs
  |   |
  |   +- AppDelegate.hs
  |   |
  |   +- Messaging.hs
  |   |
  |   +- Messaging/Core.hs, Messaging/Macros.hs
  |
  +- xcodeproj
  |   |
  |   +- CurrencyConverter
  |       |
  |       +- CurrencyConverter.xcodeproj
  |       |
  |       +- CurrencyConverter
  |       |
  |       +- build
  |       |
  |       ⋮
  |
  +- CurrencyConverter.cabal
  |
  +- Builder.hs

CurrencyConverter.cabalとBuilder.hsはそれぞれ左のリンクから取得しておいてください。また、Messaging関連はobjc-messagingのレポジトリからダウンロードして、srcに放り込んでおいてください。

Builder.hsを動かすには、shakeビルドシステムが必要なので、cabal install shakeとしておいてください。この記事はShakeの入門記事ではないので、Builder.hsの内容についてはとくに立ち入らないことにします。

はじめの一歩

ツールの整備を強引に終わらせたので、まずは次のように.xibファイルを変更しましょう：

今回は main 関数の部分と、AppDelegateの実装を分離することにします。上のディレクトリ構成図通りsrcディレクトリにMain.hsとAppDelegate.hsを作成して、Main.hsの内容を以下のように簡略化しておきます：

{-# LANGUAGE DeriveDataTypeable, QuasiQuotes, TemplateHaskell #-}
module Main where
import Data.Typeable          (Typeable)
import Language.C.Inline.ObjC
import Language.C.Quote.ObjC

import qualified AppDelegate as Delegate

objc_import ["<Cocoa/Cocoa.h>"]

nsApplicationMain :: IO ()
nsApplicationMain = $(objc [] $ void [cexp| NSApplicationMain(0, NULL) |])

objc_emit

main :: IO ()
main = do
  objc_initialise
  Delegate.objc_initialise
  nsApplicationMain

Haskell側の初期化はモジュール毎におこなう必要があるため、main関数内でAppDelegateモジュールのobjc_initialiseを呼んでやる必要のあることに注意してください。

さて、これからAppDelegate.hsにメインのロジックを記述していく訳ですが、取り敢えず今はダミーのコードを書いておきましょう：

{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies                   #-}
module AppDelegate where
import Data.Typeable          (Typeable)
import Language.C.Inline.ObjC
import Language.C.Quote.ObjC

objc_import ["<Cocoa/Cocoa.h>"]

newtype AppDelegate = AppDelegate (ForeignPtr AppDelegate)
                      deriving (Typeable)

marshalAppDel :: AppDelegate -> IO AppDelegate
marshalAppDel = return

objc_marshaller 'marshalAppDel 'marshalAppDel

nsLog :: String -> IO ()
nsLog str = $(objc ['str :> ''String] $ void [cexp| NSLog(@"%@", str) |] )

changed :: AppDelegate -> IO ()
changed app = nsLog "dummy!"

objc_interface [cunit|
@interface AppDelegate : NSResponder <NSApplicationDelegate, NSControlTextEditingDelegate>
@property (weak) typename NSTextField *dollarsField;
@property (weak) typename NSTextField *rateField;
@property (weak) typename NSTextField *resultField;

- (void)controlTextDidChange:(typename NSNotification *)obj;
@end
 |]


objc_implementation [Typed 'changed] [cunit|
@implementation AppDelegate
- (void) controlTextDidChange:(typename NSNotification*) aNotification
{
  changed(self);
}

@end
 |]

objc_emit

コンパイルしてみます。

$ runhaskell ./Builder.hs

簡単！起動してみると、まあ単に何も起きないウィンドウ一枚だけのアプリになってます。それでもConsole.appでログを見てみると、入力するたびに controlTextDidChange: のログが残っていることがわかるでしょう。

初期化・更新ロジックの実装

宣言通り、FRPを使ってメインロジックを実装します。特に、今回はsodiumを使うので、適宜インストールしておいてください。

まずは、初期化処理を書きましょう。現在の状態を保存するためのSession型を定義し、それを誂える為の関数 newSession を定義します：

type Dollars = Int
type Rate    = Double
data Session = Session { pushDollars :: Dollars -> IO ()
                       , pushRate    :: Rate    -> IO ()
                       , application :: AppDelegate
                       } deriving (Typeable)

newSession :: AppDelegate -> IO Session
newSession app = sync $ do
  (dolBh, dolL) <- newBehaviour 0
  (ratBh, ratL) <- newBehaviour 0
  _ <- listen (value $ (*) <$> dolBh <*> ratBh) $ \val ->
    app # resultField #. setIntValue (floor val)
  return $ Session (sync . dolL . fromIntegral) (sync . ratL) app

まず、内部状態を表すSession型はドル欄とレート欄の変化を通知する関数pushDollarsおよびpushRate、そして現在走っているAppDelegateの三つ組として定義しています。フィールド内容の変更が通知されたら、これらの関数を通してFRPエンジン側に変更を伝達する訳です。

そうした通知関数を作成しているのが newSession 関数です。FRPにおいてはBehaviorというのは連続的に変化する値を表します。newSessionの二、三行目で、それぞれドル値とレート値を表現するBehaivourと変更通知関数を生成しています。

それらの変更があった時に実際に結果を更新する設定をしているのが、listenを呼んでいる続く二行です。(#)や(#.)は先程定義したメッセージ送信用の中置演算子です。ここで使われているメッセージやクラスは次のように定義されています：

defineClass "NSObject" Nothing

objc_interface [cunit|
@interface AppDelegate : NSResponder <NSApplicationDelegate, NSControlTextEditingDelegate>
@property (weak) typename NSTextField *dollarsField;
@property (weak) typename NSTextField *rateField;
@property (weak) typename NSTextField *resultField;

- (void)controlTextDidChange:(typename NSNotification *)obj;
@end
 |]

defineClass "AppDelegate" (Just ''NSObject)
idMarshaller ''AppDelegate

defineClass "NSTextField" (Just ''NSObject)
idMarshaller ''NSTextField

defineSelector newSelector { selector = "setIntValue"
                           , reciever = (''NSTextField, "field")
                           , arguments = ["num" :>>: ''Int]
                           , definition = [cexp| [field setIntValue: num] |]
                           }
defineSelector newSelector { selector = "resultField"
                           , reciever = (''AppDelegate, "app")
                           , definition = [cexp| [app resultField] |]
                           , returnType = Just [t| NSTextField |]
                           }

ここで idMarshaller という関数が呼びだされています。これは先程説明したオブジェクトシステム生成用のマクロについてくるオマケみたいなもので、一々returnの型を詳しくしただけのマーシャリング関数を定義しなくても、勝手に良い感じにしてくれるようにしたものです。 厳密には、defineClassの段階でreturnの型を特価させただけのマーシャリング関数が生成され、idMarshallerが呼ばれるることで、それを実際にマーシャリング用の辞書に登録しています。どうせならdeinfeClass呼んだだけで登録するまでやってくれれば良い気がしますが、これはlanguage-c-inlineの現在の内部実装の都合上分けざるを得ないのです。

さて、これで初期化ロジックは出来たので、これを Obj-C から呼び出すようにします。objc_implemenatationの部分を次のように書き換えてください：

objc_implementation [Typed 'changed, Typed 'newSession] [cunit|
@interface AppDelegate ()
@property (assign) typename HsStablePtr session;

@end

@implementation AppDelegate

- (void)applicationDidFinishLaunching:(typename NSNotification *)aNotification
{
  self.session = newSession(self);
}

- (void) controlTextDidChange:(typename NSNotification*) aNotification
{
  changed(self);
}

@end
 |]

AppDelegateに内部状態を保持するsession変数を追加して、アプリケーションの起動が完了した時点で先程のnewSession関数を呼び、初期化された内部状態をそこに代入するようにしています。そんなに真新しいことはやっていませんね。

通知ロジックの実装

それでは、通知ロジックを実装しましょう。

controlTextDidChange:に渡されたNSNotificationの情報を元に、どのフィールドが変更されたのかを判定して、適切な通知関数を呼んでやれば良さそうです。Haskellでは、ポインタの番地を比較することが簡単にできるので、changedを次の様にかきかえれば良さそうです：

changed :: Session -> NSNotification -> IO ()
changed session notif = do
  sendF <- notif # sender
  rateF <- application session # rateField
  dollF <- application session # dollarsField
  if sendF == rateF
    then pushRate    session =<< rateF # doubleValue
    else pushDollars session =<< dollF # intValue

上で述べたロジックをそのまま書いているだけですね。 必要なNSNotificationおよびsenderの定義は以下の通りです（AppDelegate.hsの適切な位置に挿入しておいてください）：

defineClass "NSNotification" (Just ''NSObject)
idMarshaller ''NSNotification

defineSelector newSelector { selector = "sender"
                           , reciever = (''NSNotification, "notif")
                           , returnType = Just [t| NSTextField |]
                           , definition = [cexp| [notif object] |]
                           }

他のhogeField系やhogeValue系の定義はだいたい他の関数から類推出来ると思うので割愛します。

最後に、objc_implemenatation中のcontrolTextDidChange:の実装を以下のように変更すれば、万事OKです：

- (void) controlTextDidChange:(typename NSNotification*) aNotification
{
  changed(self.session, aNotification);
}

以上で完成です（完成したコード）。

あとはさっき作っておいたBuilder.hsを使ってコンパイルすれば良いだけですね：

$ runhaskell Builer.hs clean && runhaskell Builder.hs

起動すれば、望む通りの挙動をするようになっています！やりました！