ReaderとWriterの組み合わせにフィードバック機能が付いたら面白そうだな、と考えた結果。計算の間の相互作用を記述するのに使えそう
Mirror.hs
{-# LANGUAGE FlexibleContexts #-}
module Control.Monad.Mirror (MirrorT, MirrorF, look, pose, reflect, runMirrorT) where
import Control.Monad.Trans.Free
import Control.Monad.Trans
import Data.Monoid
data MirrorF i a = Look (i -> a) | Pose i a | Reflect a
instance Functor (MirrorF i) where
fmap f (Look g) = Look (f . g)
fmap f (Pose i x) = Pose i (f x)
fmap f (Reflect x) = Reflect (f x)
type MirrorT i = FreeT (MirrorF i)
-- | 鏡を見る。
look :: MonadFree (MirrorF i) m => m i
look = wrap $ Look return
-- | 鏡にモノを映す。
pose :: MonadFree (MirrorF i) m => i -> m ()
pose i = wrap $ Pose i (return ())
-- | モノを反射させる。今までにposeしたものがlookで見えるようになる。
reflect :: MonadFree (MirrorF i) m => m ()
reflect = wrap $ Reflect (return ())
-- | Mirrorモナドを実行し、結果を取り出す。
runMirrorT :: (Monad m, Monoid i) => i -> MirrorT i m a -> m a
runMirrorT initial = run initial mempty where
run image current m = runFreeT m >>= \r -> case r of
Pure a -> return a
Free (Look f) -> run image current (f image)
Free (Pose img cont) -> run image (mappend current img) cont
Free (Reflect cont) -> run current mempty cont
main = runMirrorT [0..9] $ do
i <- look
lift $ print i -- [0,1,2,3,4,5,6,7,8,9]が表示される
pose (filter odd i)
pose (filter even i)
look >>= lift . print -- [0,1,2,3,4,5,6,7,8,9]が表示される
reflect
look >>= lift . print -- [1,3,5,7,9,0,2,4,6,8]が表示される
reflect
look >>= lift . print -- []が表示される