Haskell/Monad transformers
A Gentle Introduction to Monad Transformers
モナドトランスフォーマー・ステップ・バイ・ステップ

【Control.Monad.Trans】(1) Identityモナド - Qiita
【Control.Monad.Trans】(2) StateTモナド - Qiita
【Control.Monad.Trans】(3) ExceptTモナド - Qiita
【Control.Monad.Trans】(4) ReaderTモナド - Qiita
【Control.Monad.Trans】(5) IOモナド - Qiita

Monad transformersを中心に、モナドの基本的な事項をまとめてみました。(1)～(5)までの連載で、Monad transformersを試行していきます。実際にはそれぞれの回で、Identity, StateT, ExceptT, ReaderT, IO モナドを積み重ねていく例題を示しています。

Monad transformersについては、以下のサイトが表向きは最新といわれるものでしょうが、中身はControl.Monad.Transの方をimportしたりしているので、説明の都合上、Control.Monad.Transを使います。
mtl - Hackage - Haskell

今回はIOモナドです。

1. Monad transformersのbaseとしてのIO モナド

Control.Monad.Trans - Hackage - Haskell

Monad transformersにおいて入出力を扱いたい場合は、base モナドとしてIO モナドを利用すればいいだけです。今までのIdentityをIOに置き換えるだけです。liftIOを使えば、任意の高さまでIO aを引き上げることができます。Control.Monad.TransではliftIOとともに、liftも定義されていますので、今までのlift関数の独自定義は不要になります。

class MonadTrans t where
    lift :: Monad m => m a -> t m a

class (Monad m) => MonadIO m where
    liftIO :: IO a -> m a

2. 使用例 - 全部盛り on IO モナド

基本的にIdentityをIOに変えただけです。その上で、runState を runStateTに変え、pointBのprint分を追加しました。

import Data.Functor.Identity
import Control.Monad
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import Control.Monad.Trans

--  runStateT (runExceptT (runReaderT mainCalc '*') ) []
--  runStateT (runExceptT (runReaderT mainCalc '+') ) [8]
--  runStateT (runExceptT (runReaderT mainCalc '*') ) [8,7]
--  runStateT (runExceptT (runReaderT mainCalc '+') ) [8,7..0]


type Stack = [Int]

liftExceptT :: Monad m => m a -> ExceptT e m a
liftExceptT = ExceptT . liftM Right

liftReaderT :: m a -> ReaderT r m a
liftReaderT m = ReaderT (const m)

calc :: ReaderT Char (ExceptT String (StateT Stack IO)) Int
calc = do
  s <- liftReaderT $ liftExceptT $ get
  case s of
    []  -> liftReaderT $ throwE "Error: Stack is empty !"
    [_] -> liftReaderT $ throwE "Error: Stack has only one element !"
    _  -> do 
          liftIO $ print "Stack is good !!!"   -- pointB
          a <- liftReaderT $ liftExceptT $ state $ \(x:xs) -> (x, xs) -- a <- pop
          b <- liftReaderT $ liftExceptT $ state $ \(x:xs) -> (x, xs) -- b <- pop
          op <- ask
          case op of
            '*' -> return (a*b) 
            '+' -> return (a+b)
            _   -> return 0

mainCalc :: ReaderT Char (ExceptT String (StateT Stack IO)) Int
mainCalc = do
  a <- calc    -- pointA
  liftReaderT $ liftExceptT $ state $ \xs -> ((), a:xs)       -- push a
  return a

以下が実行例です。ReaderTによる環境変数の受け渡しも、ExceptTのエラー処理も、StateTの状態管理も思い通り動作しているのがわかります。それに加えて出力のprint文も動作しています。

*Main> runStateT (runExceptT (runReaderT mainCalc '*') ) []
(Left "Error: Stack is empty !",[])
*Main> runStateT (runExceptT (runReaderT mainCalc '+') ) [8]
(Left "Error: Stack has only one element !",[8])
*Main> runStateT (runExceptT (runReaderT mainCalc '*') ) [8,7]
"Stack is good !!!"
(Right 56,[56])
*Main> runStateT (runExceptT (runReaderT mainCalc '+') ) [8,7..0]
"Stack is good !!!"
(Right 15,[15,6,5,4,3,2,1,0])

それではliftExceptT とliftReaderTというlift関数の独自定義を削除して、Control.Monad.Transのlift関数で置き換えます。

import Data.Functor.Identity
import Control.Monad
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import Control.Monad.Trans

--  runStateT (runExceptT (runReaderT mainCalc '*') ) []
--  runStateT (runExceptT (runReaderT mainCalc '+') ) [8]
--  runStateT (runExceptT (runReaderT mainCalc '*') ) [8,7]
--  runStateT (runExceptT (runReaderT mainCalc '+') ) [8,7..0]

type Stack = [Int]

calc :: ReaderT Char (ExceptT String (StateT Stack IO)) Int
calc = do
  s <- lift $ lift $ get
  case s of
    []  -> lift $ throwE "Error: Stack is empty !"
    [_] -> lift $ throwE "Error: Stack has only one element !"
    _  -> do 
          liftIO $ print "Stack is good !!!"
          a <- lift $ lift $ state $ \(x:xs) -> (x, xs) -- a <- pop
          b <- lift $ lift $ state $ \(x:xs) -> (x, xs) -- b <- pop
          op <- ask
          case op of
            '*' -> return (a*b) 
            '+' -> return (a+b)
            _   -> return 0

mainCalc :: ReaderT Char (ExceptT String (StateT Stack IO)) Int
mainCalc = do
  a <- calc    -- pointA
  lift $ lift $ state $ \xs -> ((), a:xs)       -- push a
  return a

念のため実行結果を掲載します。問題ないですね。

*Main> runStateT (runExceptT (runReaderT mainCalc '*') ) []
(Left "Error: Stack is empty !",[])
*Main> runStateT (runExceptT (runReaderT mainCalc '+') ) [8]
(Left "Error: Stack has only one element !",[8])
*Main> runStateT (runExceptT (runReaderT mainCalc '*') ) [8,7]
"Stack is good !!!"
(Right 56,[56])
*Main> runStateT (runExceptT (runReaderT mainCalc '+') ) [8,7..0]
"Stack is good !!!"
(Right 15,[15,6,5,4,3,2,1,0])

今回は以上です。