bimap であそぶ

transformers パッケージの WriterT の定義を考えることにします。

newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }

Functor のインスタンス

Functor のインスタンスは簡単にポイントフリーで書けます。

import Data.Bifunctor (first)

instance Functor m => Functor (WriterT w m) where
  fmap :: (a -> b) -> WriterT w m a -> WriterT w m b
  fmap f = WriterT . fmap (first f) . runWriterT

Applicative Functor のインスタンス

次に Applicative Functor のインスタンスを書いてみます。

instance (Applicative m, Monoid w) => Applicative (WriterT w m) where
  pure :: a -> WriterT w m a
  pure a = WriterT $ pure (a, mempty)

この定義をポイントフリーにするのは、さっきよりも大変そうですが、まだまだ簡単。

import Data.Bifunctor (second)
import Control.Monad (join)

instance (Applicative m, Monoid w) => Applicative (WriterT w m) where
  pure :: a -> WriterT w m a
  pure = WriterT . pure . second (const mempty) . join (,)

<*> も定義してみましょう。

instance (Applicative m, Monoid w) => Applicative (WriterT w m) where
  (<*>) :: WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
  mf <*> ma = WriterT $ h <$> runWriterT mf <*> runWriterT ma
    where
      h (f, w1) (a, w2) = (f a, w1 <> w2)

だいたいこんな感じです。ここで、局所定義した h をポイントフリーで書くにはどうしたら良いでしょうか？

そのためには、まず一般化した h を考えることにします。

bimap

h を一般化すると次のようになるでしょう。

h :: (a1 -> a2 -> a3) -> (b1 -> b2 -> b3) -> (a1, b1) -> (a2, b2) -> (a3, b3)
h f g (a1, b1) (a2, b2) = (f a1 a2, g b1 b2)

タプルの各要素に異なる関数を適用しているため、bimap が使えそうです。

h' :: (a1 -> a2) -> (b1 -> b2) -> (a1, b1) -> (a2, b2)
h' f g = bimap f g

しかしこれは期待した通りに動きません。なぜなら、(a2->a3, b2->b3) のように、結果の型のタプルの内側に関数が入っているためです。

-- a2 = a2 -> a3, b2 = b2 -> b3 として型を変形
h' :: (a1 -> a2 -> a3) -> (b1 -> b2 -> b3) -> (a1, b1) -> (a2 -> a3, b2 -> b3)
h' f g = bimap f g

つまり、 (a2 -> a3, b2 -> b3) -> (a2, b2) -> (a3, b3) の関数を見つければ、関数 h をポイントフリーで書けるようになります。

h'' :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
h'' = undefined

こたえは自分で考えてね (僕は1時間ぐらいかかりました)