Creatable a => a -> IO b

Haskellと数学とちょびっと音楽

lensのmakeClassyで型を合成する

はいはい、とんとご無沙汰しとります。ちゅーんさんです。

HaskellではStateモナド等を使って、状態を扱う事ができます。 また、モナドの合成にはモナド変換子がよく使われますが、 モナド変換子は階層構造になっているため、複数の状態系モナドを、 組み合わせて使うような、よくある場合に適さないという問題があります。

で、

この解決方法には、例えばOleg先生のextensible-effects 等、いろいろと考えだされています。

個人的にEffは超絶技巧のわりにはあまり分かりやすいイメージもなく、 既存のモナドをすべて置き換えなくてはいけないため、あまり好きではないのです。 そこで、単純に複数のレコードを一つに纏めあげたいだけの場合は、 lensライブラリmakeClassy というTHを使って型を作成するのをおすすめします。

導入

まず、以下のような2つの型を考えましょう。

data Foo = Foo
  { foostr :: String
  , fooint :: Int
  }

data Bar = Bar
  { barstr :: String
  , barint :: Int
  }

単純に、これらの型をまとめ上げた、FooBar型を考えます。

data FooBar
  { foobarFoo :: Foo
  , foobarBar :: Bar
  }

そしてこれを単純にStateモナドで扱う事を考えます。

proc :: State FooBar ()
proc = do
  base <- get
  let foo = foobarFoo base
  put $ base { foobarFoo = foo { fooint = 100 }  } 

main = do
  foobar <- return $ FooBar 
    { foobarFoo = Foo { foostr = "hoge", fooint = 1 }
    , foobarBar = Bar { barstr = "piyo", barint = 2 }
    }
  print $ runState proc foobar

proc関数を読んでみましょう。

なんというかこう

とてもつらい

lensとState

MonadStateのインスタンスになっているモナドで状態の一部を変更したりという事を頻繁に行うのであれば、 状態に用いる方をlensにしてしまうのが良いです。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''Foo
makeLenses ''Bar
makeLenses ''FooBar

lensのアクセサによって値の操作がぐっと楽になります。

proc :: State FooBar ()
proc = do
  foobarFoo.foostr .= "HOGE"
  foobarBar.barint *= 100

さて、予めFooに対し、次のような関数が用意されていた場合を考えてみましょう。

changeFoo :: State Foo ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

この関数をFooBar型のStateに使うためには、execStateしなくてはいけません。 あんまり格好良くないですね。

proc :: State FooBar ()
proc = do
  tmp <- use foobarFoo
  foobarFoo .= execState changeFoo tmp

型クラスの作成と型の合成

先ほど上げたような問題は、Foo型、Bar型それぞれの型クラスを作成する事によって解決できる気がします。 しかしlensの型はややこしいため、それらを自力で実装するのはあまり良い考えではなさそうです。

素晴らしい事に、任意の型をlensで扱えるようにすると同時に、 そのアクセサが定義された型クラスを自動的に生成するTHの実装が用意されています。 それが、makeClassyです。

試しに、Foo型をmakeClassyで扱ってみましょう。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

makeClassy ''Foo

このFoo型は普通にlensで扱える(※多相な型の場合等、makeLensesと違って制限があるようです)他、 ある型がXを内包している事を表すHasXという型クラスが実装されます。

ghci> :i HasFoo
class HasFoo c_a1YO where
  foo :: Functor f => (Foo -> f Foo) -> c0 -> f c0
  fooint :: Functor f => (Int -> f Int) -> c0 -> f c0
  foostr :: Functor f => (String -> f String) -> c0 -> f c0
    -- Defined at Main.hs:54:1
instance HasFoo Foo -- Defined at Main.hs:54:1

このうち、実装が必要なのはfoo関数のみで、これはある型が内包するfoo関数へのアクセサを設定すればOKです。 実際に、FooとBarをmakeClassyを使って合成してみましょう。

まず、FooとBarに対しmakeClassy、FooBarに対しmakeLensesを実行します。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

makeClassy ''Foo
makeClassy ''Bar

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''FooBar

さらに、FooBarをHasFoo、HasBarそれぞれの型クラスにします。

instance HasFoo FooBar where
  foo = foobarFoo
instance HasBar FooBar where
  bar = foobarBar

最後に、changeFoo関数の型定義を次のように変更すれば、FooBar型に対しても、changeFoo関数による操作が出来るようになります。

changeFoo :: HasFoo a => State a ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

コード全体

{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Lens
import Control.Monad.State

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

makeClassy ''Foo
makeClassy ''Bar

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''FooBar

instance HasFoo FooBar where
  foo = foobarFoo
instance HasBar FooBar where
  bar = foobarBar

----

changeFoo :: HasFoo a => State a ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

proc :: State FooBar ()
--proc :: (HasFoo a, HasBar a) => State a () --型定義はこのほうが良いかも
proc = do
  --FooBarはFoo, Barそれぞれのインスタンスなので
  --次のような書き方も出来る
  foostr .= "FOO!"
  fooint .= 123
  barstr .= "BAR!"
  barint .= 321

main = do
  foobar <- return $ FooBar 
    { _foobarFoo = Foo { _foostr = "hoge", _fooint = 1 }
    , _foobarBar = Bar { _barstr = "piyo", _barint = 2 }
    }
  print foobar
  print $ runState changeFoo foobar
  print $ runState proc foobar