Qiita
You are not logged in to any team
Log in to Qiita:Team...
Community
List of all usersList of all organizatioinsAdvent Calendar
Qiitadon (β)
Community GuidelineHow to write good articles
Sign upLog in
1514441201 @HirotoShioi
Edited at

モナド変換子(その１: 基本）

Haskellモナド

はじめに

haskellを利用する上で必修ともいえるライブラリがあります。
今回はその1つ、モナド変換子ライブラリmtlを4回に分けて紹介したいと思います。

なぜモナドをスタックする必要があるのか

例えば環境変数EnvをIOの中で利用したいとするでしょう。すると環境変数を利用する全ての関数はEnvを引数にとらなければなりません。

someFun :: Env -> IO ()
...

someHandling :: Env -> Int -> IO Int
...

あきらかに面倒です。
またあるデータを変更する際にエラー処理もしたいと思ったのでEitherモナドを使ったとしましょう。

-- Somedataを処理する関数
someFun :: SomeData -> Either String SomeData
....

-- SomeDataからIntを算出する関数
someEither :: SomeData -> Either String Int

モナドの基本として、あるモナドを利用する際に他のモナドに途中で変更することはできません。
ここでStateモナドが使えたらなー。でも既にEitherモナド使ってるし、、トホホ

これがHaskellの限界なのでしょうか。
そんなわけありません。

モナドスタックの自作を試みる

他の記事ではfmapを駆使して強引にモナドを組み合わせるという力技に近いことをしている人もみかけました。
しかしもっとエレガントにする方法があります。モナドのインスタンスを自ら定義するのです。例えばEitherとStateを組み合わせてErrorStateモナドなるものを作りたいとしましょう。

newtype ErrorState a = ErrorState { runErrorState :: s -> Either String (a, s) }

すると必要となるのはモナドのインスタンスです。

instance Monad (ErrorState e) where
  return a   = ErrorState $ \s -> Right (a, s)

  m >>= cont = ErrorState $ \s -> case runErrorState m s of
      (Left e)        -> Left e
      (Right (a, s')) -> runErrorState (cont a) s'

次にアプリカティブ、とファンクターのインスタンスも必要です。これはliftMとapを利用することによって定義できます。

instance Functor (ErrorState e) where
  fmap = liftM

instance Applicative (ErrorState e) where
  pure = return
  (<*>) = ap

次にStateモナドを利用する上で必須となる関数get, put, modifyを定義します。

get :: ErrorState s s
get = ErrorState $ \s -> Right (s, s)

put :: s -> ErrorState s ()
put = ErrorState $ \_ -> Right ((), s)

modify :: (s -> s) -> ErrorState s ()
modify f = get >>= \s -> put (f s)

ついでにEitherモナドではおなじみのthrowErrorも定義しましょう。

throwError :: String -> ErrorState s a
throwError str = ErrorState $ \_ -> Left e

いい感じです。
それでは、実際にこのモナドをつかってみましょう。

addEven :: Int -> ErrorState Int ()
addEven num = if odd num
    then throwError $ "Invalid number: " ++ show num
    else modify (+ num)

これは与えられた整数が偶数であれば状態を変更し、奇数であればエラー処理を行う関数です。
実際に試してみましょう。

λ: runErrorState (addEven 10) 10
Right ((),20)
λ: runErrorState (addEven 11) 10
Left "Invalid number: 11"

与えた状態10に対してaddEven 10の場合には10を足して20に、addEven 11の場合にはエラー文が出力されています。
つまりErrorStateモナドはStateモナドとEitherモナド両方の性質を組み合わせたモナドとなったのです。
素晴らしい

面倒やろこれ、、

そうですよね。上記の実装では以下の問題があります。

モナドの作成がボイラープレート化する

まずこのモナドを自作するのに慣れが必要となります。また、慣れたとしてもひたすら同じことを繰り返すことになるでしょう。コピペでできるようなことを何度もするのはかっこよくありません。

拡張性に乏しい

2つのモナドを組み合わせたものならまだ問題ありませんが、４つ５つと積み上げていくとモナドインスタンスの実装は指数関数的に難しくなります。また、別のモナドにliftする方法も考慮しなければなりません。

保守性が低い

また保守性の観点からも上記の実装はよくありません。
例えばStateモナドからReaderモナドに変えようという提案があったとしましょう。するとモナドのインスタンスを再度定義しなおさなけばなりません。またReaderモナドならask,asks,local関数もほしいところです。
となると既存のコードもほぼ全て書き換えなければなりません。

苦行です(実際やらされました)

モナド変換子

これらの問題を解決するのがモナド変換子ライブラリmtlです。mtlでは基本的なモナド（Maybe, Eitehr, Reader, State, 等）のモナド変換子を提供しています。

今回は簡単な数式インタプリタから次第に機能を追加してゆき、その上でモナド変換子がいかに有用なのかを紹介したいと思います。

実装

まずは基本的なところから始めます。インタプリタは数字、足し算を評価できるようにします。

数式は以下のように表現します。

data Expr =
    Lit Int
  | Add Expr Expr

次に式を評価するeval関数を実装しましょう。これも特に問題ありません。

eval :: Expr -> Int
eval (Lit n)     = n
eval (Add e1 e2) = eval e1 + eval e2

実際に動かしてみましょう

λ: eval (Add (Add (Lit 3) (Lit 4)) (Lit 10))
17

いい感じです。
次に割り算を実装しましょう。

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr

Divを評価するためには、評価関数も変更する必要があります。

eval :: Expr -> Int
eval (Lit n)     = n
eval (Add e1 e2) = eval e1 + eval e2
eval (Div e1 e2) = eval e1 `div` eval e2

しかし、ここで0で割る数式を評価しようとするとランタイムエラーとなります。

λ:eval (Div (Lit 10) (Lit 0))
*** Exception: divide by zero

ここではEitherモナドを使ってエラー処理を行いましょう。

eval :: Expr -> Either String Int
eval (Lit n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (Div e1 e2) = do
  v1 <- eval e1
  v2 <- eval e2
  if v2 == 0
    then Left "division by 0"
    else return (v1 `div` v2)

なんと全てのコードを書き換える結果となってしまいました。
ここで「やっぱり割り算は使わない」と言われたらリライトとなります。辛い。

そもそも全てを書き換える必要になった原因は評価関数がいきなりモナドを使うようになったためです。

この解決策の１つとして最初からモナドを使うという考え方があります。
例えば以下のように実装していたとしましょう。

eval :: Expr -> ??? Int
eval :: (Lit n)     = pure n
eval :: (Add e1 e2) = (+) <$> eval e1 <*> eval e2

これなら割り算を実装したとしても既存の実装に影響を与えません。でもこの???ってどんなモナドなのでしょうか。
これってなにもしないモナドですよね。つまり、Identityモナドです。

eval :: Expr -> Identity Int
eval (Lit n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2

評価された関数はIdentityモナドにくるまれています。中身を取り出すにはrunIdentity関数を実行する必要があります。

λ: runIdentity $ eval (Add (Lit 10) (Lit 7))
17

うーん、なるほど。まぁ良しとしましょう。

次にDivの実装ですが、ここで問題が発生します。評価関数は既にIdentityモナドを使っています。でもDivを評価するにはEitherモナドが必要です。うーん困った。

ExceptT

ここモナド変換子の１つであるExceptTが利用できます。ExceptTは既存のモナドにEitherモナドをスタックできるモナドです。

eval :: Expr -> ExceptT String Identity Int
eval (Lit n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (Div e1 e2) = do
  v1 <- eval e1
  v2 <- eval e2
  if v2 == 0
    then throwError "division by 0"
    else return (v1 `div` v2)

希望通り、既存のコードを一切書き換えずにDivを評価できるようになりました。

しかし、これによって評価された式はExceptTそしてIdentityにくるまれてしまいました。
よって中身を取り出すにはrunExceptT、 runIdentityの順に関数を適用する必要があります。

run :: Expr -> Either String Int
run expr = runIdentity (runExceptT (eval expr))

一応できますね。でもなにか嫌な予感がします。

ReaderT

次に予め変数をどこかに格納しておき、必要になればその変数を利用できるような機能を追加しましょう。

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr
  | Var String

つまりVarが評価されるとどこかに変数名を問い合わせ、それに対応した値を返してもらいたいわけです。
まず変数とその値が1対1で対応しているテーブルが必要となります。これはMapで表現できます。

type Env = Map String Int

次に「問い合わせる」ということをいかに実装するかです。これにはReaderモナドがうってつけでしょう。もちろんmtlにはReaderモナドの変換子であるReaderTモナドがあります。

次に評価関数の型シグネチャを書き換えなければなりませんね。

eval :: Expr -> ReaderT Env (ExceptT String Identity) Int

長い

今回モナド変換子を利用しているのがeval関数のみですが、現実では同じモナドスタックを共有している関数がいくつもあるのが当たり前でしょう。その関数１つずつにこのようなシグネチャを記述するのは冗長的ですし、保守性の観点からもよろしくありません。

このスタックを抽象化できないでしょうか。

スタックの抽象化

型シノニムなのか、newtypeなのか

ここでモナドスタックを抽象化する方法は２つあります。型シノニムもしくはnewtypeです。

type Eval = ReaderT Env (ExceptT String Identity) Int
-- or
newtype Eval a = Eval (ReaderT Env (ExceptT String Identity) a)

実は、ここではnewtypeが正解です。これはモナドスタックうんぬんよりも、型シノニムとnewtypeをどう使い分ければいいかという話になります。型シノニムは単に任意の型のエイリアスであるため、利用するユーザーにあらゆる利用方法を（もちろん意図しないものも）許してしまいます。

例えばあるライブラリを開発した際にMessage型を定義したとしましょう。

type Message = String

newtype Message = Message String

そしてMessage型には付随する関数があり、開発者はそれ以外の関数を利用できないようにしたいとします。

someFun :: Message -> Maybe Char

型シノニムで定義した場合、ライブラリ利用者にこの制限を強要することはできません。Message型は単にStringのエイリアスなので、リストに関するあらゆる関数をMessage型に適用することができます。

-- Why?
evilFun :: Message -> Char
evilFun = head

このように型シノニムを使用すると、全く意図しない操作を許してしまいます。newtypeであればこれを防ぐことができます。

またnewtypeの場合、より抽象的なモナドスタックを構築することができます。これによってエラーメッセージがよりわかりやすくなるだけではなく、型クラスのインスタンスの実装、変更も自由に行えるため、より汎用性の高いモナドスタックが実現できます。

newtype Message = Message String

-- Stringとは全く別の型クラスインスタンスが実装可能
instance Show Message where
   show msg = "New typeclass instance for show" <> show msg

newtypeの問題点

しかしnewtypeの場合、問題となるのは型クラスの導出です。

newtype Eval a = Eval (ExceptT String Identity) a
    deriving (???)

型クラスが導出できなければ、それぞれのモナドが提供する型クラスの関数を利用することができません。これを解決するのが言語拡張GeneralizedNewtypeDerivingです。

言語拡張GeneralizedNewtypeDerivingはnewtypeで作った型の型クラスのインスタンス導出を簡略化するための拡張です。

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

newtype Quantity = Quantity Int
  deriving (Eq, Ord, Num, Show)

a = Quantity 2
b = Quantity 6

totalQuantity :: Quantity
totalQuantity = a + b
-- Quantity 8

ここでは言語拡張を利用することによってNumの型クラスを容易に導出し、それによってQuantity同士の四則演算が可能となりました。

実はmtlが提供しているモナド変換子ExceptTやReaderTはそれぞれの型クラスインスタンスを実装したものなのです。例えばReaderTは型クラスMonadReaderのインスタンスを実装しています。

class (Monad m) => MonadReader r m | m -> r where
  ask   :: m r
  local :: (r -> r) -> m a -> m a

instance (Monad m) => MonadReader r (ReaderT r m) where
  ask       = ReaderT return
  local f m = ReaderT $ \r -> runReaderT m (f r)

もちろんこれらの型クラスを以下のように導出することも可能です。1

newtype App a = App (ReaderT [Int] (Either String) a)
  deriving (Functor
          , Applicative
          , Monad
          , MonadReader [Int])

またモナドスタックを利用する際に問題となるのがlift地獄です。2 これはスタックを利用する際にどこで、何度liftするのかを明示的に記述する必要があるということです。これは保守性の観点からすれば非常にまずいです。

これに関してもGeneralizedNewtypeDeriving、そしてmtlが提供する型クラス及びそのインスタンスを利用すれば、liftを明示的に記述する必要がなくなります。3

再度実装に取り組む

それではモナドスタックの抽象化を行いましょう。

newtype Eval a = Eval (ReaderT Env (ExceptT String Identity) a)
  deriving (Functor
          , Applicative
          , Monad
          , MonadReader Env
          , MonadError String)

これで評価関数の型シグネチャもすっきりします。

eval :: Expr -> Eval Int

またnewtypeを定義したので、それを引数にとり、与えられた式を走査する関数も必要となります。

runEval :: Eval a -> Env -> Either String a
runEval (Eval m) env = runIdentity (runExceptT (runReaderT m env))

つぎにVarを評価できるようにしましょう

eval (Var x) = do
  env <- ask
  case M.lookup x env of
    Nothing -> throwError $ "Variable not found: " <> show x
    Just num -> pure num

いい感じです。さっそく試してみましょう。

λ: runEval (eval (Add (Var "x") (Lit 10))) (singleton "x" 10)
Right 20

素晴らしい！
既存のコードに一切手を加えずにVarを評価できるようになりました。

StateT

また機能を追加しましょう。今回は評価の連結(Sequence)そして変数の宣言及び代入(Assign)です。

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr
  | Var String
  | Seq Expr Expr
  | Assign String Expr

Varを実装した際にはあらかじめ環境を提供できたのでReaderモナドでも問題ありませんでしたが、変数の宣言、代入となるとStateモナドがうってつけです。ということはReaderTをStateTに取り替えなけれなりません。

まずはモナドスタックであるEvalを変更します。

-- Before (ReaderT)
newtype Eval a = Eval (ReaderT Env (ExceptT String Identity) a)
  deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)

-- After (StateT)
newtype Eval a = Eval (StateT Env (ExceptT String Identity) a)
  deriving (Functor, Applicative, Monad, MonadState Env, MonadError String)

次に走査関数も変更が必要です。

-- Before (ReaderT)
runEval :: Eval a -> Env -> Either String a
runEval (Eval m) env = runIdentity (runExceptT (runReaderT m env))

-- After (StateT)
runEval :: Eval a -> Env -> Either String a
runEval (Eval m) env = runIdentity (runExceptT (evalStateT m env))

あとはVarを評価する際にReaderモナドのask関数を使っていたので、それをStateモナドのgetに取り替えましょう。

eval (Var x) = do
  env <- get -- ask
  case M.lookup x env of
    Nothing -> throwError $ "Variable not found: " <> show x
    Just num -> pure num

大したことありませんでした。あまりにも変更箇所が少なすぎて、その違いを見分けるのに苦労したかもしれません。
既存のコードに関する変更はこれで完了です。他の部分を変更する必要は一切ありません。

これで新たな機能を追加することができます。

まずSeqからです。これは最初のものを評価した後に次のものを評価するだけなので簡単です。

eval (Seq e1 e2) = e1 >> e2

次はAssignです。これもとくに問題ありません。

eval (Assign x e) = do
  v <- eval e
  modify (M.insert x v)
  return v

最後にこれを試すためにプログラムを用意してみました。

program :: Expr
program = Assign "x" (Lit 10)
          `Seq` Assign "x" (Div (Var "x") (Lit 2))
          `Seq` Add (Var "x") (Lit 1)

これをJavascriptで大まかに翻訳すると以下のようになります

let x = 10;
x = x / 2;
console.log (x + 1);

では実際にやってみましょう

λ: runEval (eval program) empty
Right 6

完璧です。

リファクタリング

ここでこの記事を追って評価関数を実装してきた人はコードがかなり煩雑としてきたことに気づくでしょう。ここでコードのリファクタリングを行います。

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Interpreter where

import Control.Monad.Identity
import Control.Monad.Except
import Control.Monad.State

import Data.Map
import qualified Data.Map as M

import Data.Monoid ((<>))

type Env = Map String Int

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr
  | Var String
  | Assign String Expr
  | Seq Expr Expr

newtype Eval a = Eval (StateT Env (ExceptT String Identity) a)
  deriving (Functor, Applicative, Monad, MonadState Env, MonadError String)

eval :: Expr -> Eval Int
eval (Lit n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (Div e1 e2) = doDiv e1 e2
eval (Var x) = varLookup x
eval (Seq e1 e2)  = eval e1 >> eval e2
eval (Assign x e) = varSet x e

doDiv :: Expr -> Expr -> Eval Int
doDiv e1 e2 = do
  v1 <- eval e1
  v2 <- eval e2
  if v2 == 0
    then divByZeroError
    else return (v1 `div` v2)

divByZeroError :: Eval ()
divByZeroError = throwError "Division by 0"

varLookup :: String -> Eval Int
varLookup x = do
  env <- get
  case M.lookup x env of
    Nothing -> unknownVar x
    Just num -> return num

varSet :: String -> Expr -> Eval Int
varSet x e = do
  v <- eval e
  modify (M.insert x v)
  return v

unknownVar :: String -> Eval ()
unknownVar x = throwError $ "Variable not found: " <> show x

runEval :: Eval a -> Env -> Either String a
runEval (Eval m) env = runIdentity (runExceptT (evalStateT m env))

program :: Expr
program = Assign "x" (Lit 10)
          `Seq` Assign "x" (Div (Var "x") (Lit 2))
          `Seq` Add (Var "x") (Lit 1)

ここで注目してほしいがそれぞれの関数の型シグネチャです。
まずモナドスタックを抽象化したことによって簡潔かつ可読性の高いものになりました。

またコード自体は非常にシンプルですがこれでもモナド変換子StateT,ExceptTをスタックさせたので、エラー処理かつ状態の参照および変更が可能という非常に強力なインタプリタが実装できました。

あとは非常に些細なことなのですがエラーメッセージの型シグネチャがEval ()であることも非常に嬉しいです。これによってこの関数が何も返さない、作用のみ期待されているものであることがひと目でわかります。

練習問題

標準入力を受け取り、それが数字であれば評価し、それ以外であればエラーを出力するGetを実装してください。(ヒント：IOが必要となります。)

λ: runEval (eval (Add (Lit 10) (Get)) empty
Please enter a number
10
Right 20

　まとめ

以上でモナド変換子ライブラリmtlの基本的な使い方を紹介させて頂きました。
mtlを使用する主な利点としては以下の点が挙げられます:

  • モナド変換子はモナド同士を組み合わせることでそれぞれの作用を組み合わせることができる。
  • 基本的なモナド 4 に関しては、自身でモナドスタックを定義する必要がなくなる
  • モナドスタックが容易に構築可能
  • 既存のコードにほとんど手を加えずにスタックを変更することができる。これによって保守性の高いコードが実現される

次回は実際にmtlに触れてもらうために、UTXOを利用したトランザクション処理の実装を課題として出します。

  1. モナドスタックも結局はモナドなので型クラスFunctor, Applicative, Monadも導出可能です。 ↩

  2. liftに関してはHaskell モナド変換子 超入門という大変わかりやすい記事があるので、それを参照してください。 ↩

  3. これに関してはTypeclassopediaを参照してください。 ↩

  4. 自身で作ったモナドをモナドスタックとして扱えるようにする方法もあるようですが、それに関しては現在勉強中です。 ↩

Sign up for free and join this conversation.
Sign Up
If you already have a Qiita account log in.

Report article

Help us understand the problem. What is going on with this item?


Feedback

We don't reply to any feedback.
If you need help with Qiita, please send a support request from here.