Scrap Your Boilerplate ことはじめ

折角ですから、Haskellで新年の挨拶をしてみましょう。以下のコードをMain.hsといったファイル名で保存し、ghciから読み込んでみてください。

{-# LANGUAGE DeriveDataTypeable, RankNTypes#-}
{-# OPTIONS -Wall #-}
import Data.Data
import Data.Maybe(maybeToList)
import Data.Generics.Schemes

data ABC 
    = ABC Int Double String
    deriving (Eq, Show, Data, Typeable)

data A
    = A String
    | Abc B C deriving (Eq, Show, Data, Typeable)

data B
    = B Double
    | Bca C A deriving (Eq, Show, Data, Typeable)

data C      
    = C Int
    | Cab A B deriving (Eq, Show, Data, Typeable)

abc1 :: ABC
abc1 = ABC 2012 1.1 "Tatsu"

a1 :: A
a1 = Abc 
     (Bca (Cab (A "Happy") (B 4.2)) (Abc (B 5.6) (C 512))) 
     (Cab (Abc (B 8.4) (C 208)) (Bca (C 2012) (A "New Year!")))

上記のようなa1やabc1のようなデータ構造を作ってしまってから、中の文字列とかをいじりたくなったらどうすればいいのでしょう？私はこういう操作をするにはHaskellのソースを操ることが必要と思っていましたが、そんなことはなかったぜ！

Scrap Your Boilerplate

Data.Dataモジュールにあるgmapなんちゃらという名前の関数が使えるそうです。まずは、これに注目：

gmapQ :: (forall d. Data d => d -> u) -> a -> [u]

どうにかして、任意の型をとってu型を返す関数(forall d. Data d => d -> u)なんつう難しいものを作る必要があるそうです。と、とりあえず、const？

ghci> gmapQ (const "homu") abc1
["homu","homu","homu"]
ghci> gmapQ (const "homu") a1
["homu","homu"]

オブジェクトの子要素がいくつあるか、みたいな情報が取れたようです。ドキュメントにしつこくimmediate subtermsとあるように、gmapなんちゃらたちは引数に与えられた値の直下の要素を処理します。いっぽう、a1やabc1にはもっと沢山の要素が詰まっています。

ghci> (gdepth abc1, gsize abc1)
(7,14)
ghci> (gdepth a1, gsize a1)
(14,51)
ghci> (gdepth "", gsize "")
(1,1)
ghci> (gdepth "a", gsize "a")
(2,3)
ghci> (gdepth "ab", gsize "ab")
(3,5)

おもにStringがかさばってるようです。

さて、要素に対して有用な操作を施そうと思ったら、型が(forall d. Data d => d)のままでは困ります。これはcastの出番です！

cast :: (Typeable a, Typeable b) => a -> Maybe b

こいつはぶっちゃけ、aが特定の型bだった時にJust xとして取りだせる関数です。こいつを使えば

ghci> gmapQ (fmap (+(1::Int)) . cast) abc1
[Just 2013,Nothing,Nothing]
ghci> gmapQ (fmap (+1.1) . cast) abc1
[Nothing,Just 2.2,Nothing]
ghci> gmapQ (fmap (++"onotoshigo") . cast) abc1
[Nothing,Nothing,Just "Tatsuonotoshigo"]

いっぽう、取りだす代わりに、データ構造の中をいじりたかったら、こうです。

gmapT :: (forall b. Data b => b -> b) -> a -> a

gmapTに、俺はすべてのデータを操れる能力がある(forall b. Data b => b -> b)とかいう厨二的関数を与えると、(a -> a)というより厨二的関数が返ってきます。ここで、普通の関数(f :: a -> a)を取って、fが処理できる型についてはf、それ以外の型についてはidとして振る舞う関数を返す補助関数casterを作りましょう。

caster :: (Typeable a) => (a -> a) -> (forall b. Typeable b => b -> b)
caster f x =
  case (cast =<<) $ fmap f $ cast x of
    Just y  -> y
    Nothing -> x

もちろん使うのはモナド。なぜならMaybeもまた、文脈の一種だからです。

ghci> gmapT (caster (+(1::Int))) abc1
ABC 2013 1.1 "Tatsu"
ghci> gmapT (caster (+1.1)) abc1
ABC 2012 2.2 "Tatsu"
ghci> gmapT (caster (++"onotoshigo")) abc1
ABC 2012 1.1 "Tatsuonotoshigo"

なんと、ABCの中に入っているIntやStringといった型を、パターンマッチで取りだしたりすることなく、外からいじることができました。しかし、この方法では、a1のようにimmediateじゃないsubtermのところに入っている文字列は操作できません。

ghci> gmapT (caster (++"onotoshigo")) a1
Abc (Bca (Cab (A "Happy") (B 4.2)) (Abc (B 5.6) (C 512 ... 

こういう物体を操作するにはデータ構造の中に再帰的に踏み入る必要があります。

再帰的にScrap Your Boilerplate

関数 f::(a1->a) と値xを受けとって、xの中のあらゆるa1にfを適用したものをリストとして回収する関数を作りましょう。それは、xそのものにfを適用してみる部分と、xの子要素に再帰していく部分から書けるはずです：

recMapQ' :: forall a a1 a2. (Data a1, Data a2) => (a1 -> a) -> a2 -> [a]
recMapQ' f x = (maybeToList $ fmap f (cast x))
  ++ concat (gmapQ (recMapQ' f) x)

使ってみましょう：

ghci> recMapQ' ("Very "++) a1
["Very Happy","Very appy","Very ppy","Very py", ...

ってあれ？文字列はCharのリスト構造であることから、目当ての文字列だけでなく全てのサフィックスが検出されてしまいました。最初にマッチした所で止めるには、こうします：

recMapQ :: forall a a1 a2. (Data a1, Data a2) => (a1 -> a) -> a2 -> [a]
recMapQ f x = case fmap f (cast x) of
  Just y  -> [y]
  Nothing -> concat (gmapQ (recMapQ f) x)

これで無事、めあての文字列だけを取りだせます：

ghci> recMapQ ("Very "++) a1
["Very Happy","Very New Year!"]

おめでとう！さらに、元のデータ構造を保ったまま、文字列だけをいじるには、こんな関数をつくるとよいです：

recMapT :: forall a b. (Data a, Data b) => (b -> b) -> a -> a
recMapT f x = 
  let y = gmapT (recMapT f) x in
  case (>>= cast) $ fmap f $ cast x of
    Just z  -> z
    Nothing -> y

これで、こうなります。

ghci> recMapT ("Very "++) a1
Abc (Bca (Cab (A "Very Happy") (B 4.2)) (Abc (B 5.6) (C 512))) 
  (Cab (Abc (B 8.4) (C 208)) (Bca (C 2012) (A "Very New Year!")))

それ、Data.Generics.Schemesにアルヨー

-- | Apply a transformation everywhere in bottom-up manner
everywhere :: (forall a. Data a => a -> a)
           -> (forall a. Data a => a -> a)

-- Use gmapT to recurse into immediate subterms;
-- recall: gmapT preserves the outermost constructor;
-- post-process recursively transformed result via f
-- 
everywhere f = f . gmapT (everywhere f)


-- | Apply a transformation everywhere in top-down manner
everywhere' :: (forall a. Data a => a -> a)
            -> (forall a. Data a => a -> a)

-- Arguments of (.) are flipped compared to everywhere
everywhere' f = gmapT (everywhere' f) . f

それっぽいのがアッタヨー

しかし、この二つは思ったように動いてくれません。まずeverywhereは

ghci> print $ everywhere (caster $ ("Very " ++)) a1
Abc (Bca (Cab (A "Very HVery aVery pVery pVery yVery ") (B 4.2)) ...

そしてeverywhere'は

ghci> print $ everywhere' (caster $ ("Very " ++)) a1
Abc (Bca (Cab (A "VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV^CVInterrupted.

というわけで、Scrap Your Boilerplate (Data.DataのgmapQとかgmapT)で文字列やリストを処理する場合には、無限ループに陥らないよう若干の手心を加えてやる必要がありますが、それにしても「任意のデータ構造をなめて、既知の型の部分だけ変更を加える」関数がこんなに簡単に書けてしまうとは驚きです。

今回使ったコードです： http://ideone.com/O9K2l http://codepad.org/9teQkUu4 どちらのサービスもData.Dataすらないのでコンパイルできてませんが…

皆様ことしもよろしくお願いします。