EffのState上でLensのアクセサを利用する

はいはい、どーも、キルラキル面白いですね。
ちゅーんさんです。

前回、前々回とHaskell上で状態を扱う手段として、LensのClassy、Effを紹介した際に、 この２つが併用可能かどうかについて「よくわからん」と書きました。

ので、やってみました。

結論から言うと、とても簡単です。

EffをMonadStateの型にする

*Main> :i (.=)
(.=) ::
  Control.Monad.State.Class.MonadState s m =>
  ASetter s s a b -> b -> m ()
    -- Defined in `Control.Lens.Setter'
infix 4 .=
*Main> :i (+=)
(+=) ::
  (Control.Monad.State.Class.MonadState s m, Num a) =>
  ASetter' s a -> a -> m ()
    -- Defined in `Control.Lens.Setter'
infix 4 +=
*Main> :i (*=)
(*=) ::
  (Control.Monad.State.Class.MonadState s m, Num a) =>
  ASetter' s a -> a -> m ()
    -- Defined in `Control.Lens.Setter'
infix 4 *=

これらの演算子は状態を扱うモナドにMonadStateを要求しています。 つまり、EffがmtlのMonadStateのインスタンスになっていれば良いということです。

実際に定義してみましょう。

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
module Main where
import Data.Typeable
import Control.Eff
import Control.Eff.State.Lazy as EST
import Control.Monad.State.Class (MonadState(..))

instance (Typeable x, Member (State x) r) => MonadState x (Eff r) where
  get = EST.get 
  put = EST.put 

EffをMonadStateのインスタンスにするには、いくつかのGHC拡張が必要です。 また、get関数、put関数はEffの定義そのままで良いのですが、インスタンスにするための型定義はやや複雑です。

Member型クラスになっているのは、Effが型クラスのシグネチャによって関数内で許される作用を特定しているため、必要になります。 Effの内部実装上、作用を階層化する際に型の情報を削ぎ落としているため、元の型を復元するためにTypeable型クラスが要求されます。（それでも型安全にするために、Member型クラスがあります）

といっても、実際に使う分には内部実装の知識は必要ありません。
基本的に上記のように記述すれば、Eff State内でLensによるアクセサ操作が行えると思えば良いでしょう。

実際に使う

では、Eff State上でLensの演算子が実際に使えるかどうか試してみましょう。 Lensモジュールをインポートし、DeriveDataTypeable, TemplateHaskell, FlexibleContextsの言語拡張を有効にし、 次のコードを追加します。

data Foo = Foo
  { _hoge :: Int
  , _piyo :: String
  , _fuga :: Bool
  } deriving (Show, Typeable)

makeLenses ''Foo

proc :: (Member (State Foo) r) => Eff r ()
proc = do
  piyo .= "Hello, Lens with Extensible Effects!"
  fuga .= True

main = do
   let foo = Foo
               { _hoge = 100
               , _piyo = "Hello"
               , _fuga = False
               }
   print . run $ execState foo proc

実行結果:

Foo {_hoge = 100, _piyo = "Hello, Lens with Extensible Effects!", _fuga = True}

State + Lens + Choose

で、せっかくEffとLensを組み合わせて使ってみたのだから、他の作用とも合成してみたくなりますね。 mtlのListモナドに相当する、Chooseという作用がEffモナドにはあります。

Eff.Chooseモナドをimportし、ScopedTypeVariables言語拡張を有効にすれば、 次のようにLensを使って状態を扱う処理と、リストモナドのような組み合わせを走査する計算を同時に記述する事が可能です。

proc :: (Member Choose r, Member (State Foo) r) => Eff r Foo
proc = do
  x <- choose [1, 2, 3]
  s <- choose ["+++", "---", "***"]
  b <- choose [True, False]

  hoge *= x
  p <- use $ piyo
  piyo .= s ++ p ++ s
  fuga .= b

  (res :: Foo) <- EST.get
  return res

実際に実行してみましょう。

main = do
   let foo = Foo
               { _hoge = 100
               , _piyo = "Hello"
               , _fuga = False
               }
   print . run $ runChoice (execState foo proc)

実行結果:

[ Foo {_hoge = 100, _piyo = "+++Hello+++", _fuga = True}
, Foo {_hoge = 100, _piyo = "+++Hello+++", _fuga = False}
, Foo {_hoge = 100, _piyo = "---Hello---", _fuga = True}
, Foo {_hoge = 100, _piyo = "---Hello---", _fuga = False}
, Foo {_hoge = 100, _piyo = "***Hello***", _fuga = True}
, Foo {_hoge = 100, _piyo = "***Hello***", _fuga = False}
, Foo {_hoge = 200, _piyo = "+++Hello+++", _fuga = True}
, Foo {_hoge = 200, _piyo = "+++Hello+++", _fuga = False}
, Foo {_hoge = 200, _piyo = "---Hello---", _fuga = True}
, Foo {_hoge = 200, _piyo = "---Hello---", _fuga = False}
, Foo {_hoge = 200, _piyo = "***Hello***", _fuga = True}
, Foo {_hoge = 200, _piyo = "***Hello***", _fuga = False}
, Foo {_hoge = 300, _piyo = "+++Hello+++", _fuga = True}
, Foo {_hoge = 300, _piyo = "+++Hello+++", _fuga = False}
, Foo {_hoge = 300, _piyo = "---Hello---", _fuga = True}
, Foo {_hoge = 300, _piyo = "---Hello---", _fuga = False}
, Foo {_hoge = 300, _piyo = "***Hello***", _fuga = True}
, Foo {_hoge = 300, _piyo = "***Hello***", _fuga = False}]

まとめ

単純に状態を伴う計算を行うだけであれば、State+Lensで状態の拡張にはmakeClassyを使えば良いでしょう。
そこに状態以外の作用（非決定性計算等）を加える場合、その複雑性によってはモナド変換子ではなく、Effの導入を検討してみるのもありですね。 そのような拡張に耐えうるコードにするため、状態を扱う処理はStateモナドではなく、MonadState型クラスで記述するようにしておくと良いかもしれません。

最後に、最終的なコード全体を以下に記述しておわります。

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Data.Typeable
import Control.Eff
import Control.Eff.State.Lazy as EST
import Control.Eff.Choose
import Control.Monad.State.Class (MonadState(..))
import Control.Lens

instance (Typeable x, Member (State x) r) => MonadState x (Eff r) where
  get = EST.get 
  put = EST.put 

data Foo = Foo
  { _hoge :: Int
  , _piyo :: String
  , _fuga :: Bool
  } deriving (Show, Typeable)

makeLenses ''Foo

----

proc :: (Member Choose r, Member (State Foo) r) => Eff r Foo
proc = do
  x <- choose [1, 2, 3]
  s <- choose ["+++", "---", "***"]
  b <- choose [True, False]

  hoge *= x
  p <- use $ piyo
  piyo .= s ++ p ++ s
  fuga .= b

  (res :: Foo) <- EST.get
  return res

main = do
   let foo = Foo
               { _hoge = 100
               , _piyo = "Hello"
               , _fuga = False
               }
   print . run $ runChoice (execState foo proc)