LoginSignup
5
0

More than 5 years have passed since last update.

@YoshikuniJujo

Freer Effectsが、だいたいわかった: 9. モナドを混ぜ合わせる(閉じた型で)

Last updated at Posted at 2017-10-10

Freer Effectsが、だいたいわかった: 9. モナドを混ぜ合わせる(閉じた型で)

目次

(0). 導入

  1. Freeモナドの概要
    • Freeモナドとは
    • FreeモナドでReaderモナド、Writerモナドを構成する
  2. 存在型(ExistentialQuantification拡張)の解説
  3. 型シノニム族(TypeFamilies拡張)の解説
  4. データ族(TypeFamilies拡張)の解説
  5. 一般化代数データ型(GADTs拡張)の解説
  6. ランクN多相(RankNTypes拡張)の解説
  7. FreeモナドとCoyoneda
    • Coyonedaを使ってみる
    • FreeモナドとCoyonedaを組み合わせる
      • いろいろなモナドを構成する
  8. Freerモナド(Operationalモナド)でいろいろなモナドを構成する
    • FreeモナドとCoyonedaをまとめて、Freerモナドとする
    • Readerモナド
    • Writerモナド
    • 状態モナド
    • エラーモナド
  9. モナドを混ぜ合わせる(閉じた型で)
    • Freerモナドで、状態モナドとエラーモナドを混ぜ合わせる
      • 両方のモナドを一度に処理する
      • それぞれのモナドを、それぞれに処理する
  10. 存在型による拡張可能なデータ構造(Open Union)
  11. 追加の言語拡張
    1. ScopedTypeVariables拡張
    2. TypeOperators拡張
    3. KindSignatures拡張
    4. ...
  12. モナドを混ぜ合わせる(開いた型で)
    • FreeモナドとOpen Unionを組み合わせる
    • 状態モナドにエラーモナドを追加する
  13. Open Unionを型によって安全にする
  14. Freer Effectsで、IOモナドなどの、既存のモナドを使用する
  15. 関数を保管しておくデータ構造による効率化
  16. いろいろなEffect
    • 関数handleRelayなどを作成する
    • NonDetについて、など

状態モナドとエラーモナドとを混ぜ合わせる

Freerモナドを使って、状態モナドとエラーモナドとを混ぜ合わせてみる。
ファイルstateError.hsを作成する。

stateError.hs
{-# LANGUAGE LambdaCase, TupleSections #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

import Freer

data SE s e a where
        Get :: SE s e s
        Put :: s -> SE s e ()
        Exc :: e -> SE s e a

状態モナドでのデータ型の値構築子と、エラーモナドでのデータ型の値構築子との両方をもつデータ型を定義した。それぞれに対して、モナドを構成する基本的な要素を定義する。

stateError.hs
get :: Freer (SE s e) s
get = freer Get

put :: s -> Freer (SE s e) ()
put = freer . Put

modify :: (s -> s) -> Freer (SE s e) ()
modify f = put . f =<< get

throwError :: e -> Freer (SE s e) a
throwError = freer . Exc

状態モナドとエラーモナドを、一度に処理する

状態+エラーモナドを処理する関数を書く。状態モナドとエラーモナドを混ぜ合わせるとき、エラーのときに状態を捨てるかどうかで、2通りの関数が考えられる。

エラーのとき状態を捨てる

エラーのとき状態を捨てる処理をする、関数を書く。

stateError.hs
runSE :: Freer (SE s e) a -> s -> Either e (a, s)
runSE m s = case m of
        Pure x -> Right (x, s)
        Get `Bind` k -> runSE (k s) s
        Put s' `Bind` k -> runSE (k ()) s'
        Exc e `Bind` _k -> Left e

まえにみた関数runState、runErrorとを混ぜ合わせたような関数となっている。

サンプル

とくに意味はないが、計算の例を示す。まずは安全な除算を定義する。

stateError.hs
safeDiv :: Integer -> Integer -> Freer (SE s String) Integer
n `safeDiv` 0 = throwError $ show n ++ " is divided by 0"
n `safeDiv` m = return $ n `div` m

これを使って計算の流れを定義する。

stateError.hs
sample1 :: Freer (SE Integer String) Integer
sample1 = do
        a <- get
        modify (subtract 5)
        modify (* 2)
        b <- get
        c <- 60 `safeDiv` b
        put a
        modify (subtract 3)
        d <- get
        e <- 250 `safeDiv` d
        return $ c + e

とくに意味はないが、つぎのような計算をしている。状態として受け渡されていく値を「メモリの値」と呼ぶことにする。

  • はじめのメモリの値を変数aに読み込む
  • メモリの値から5をひく
  • メモリの値に2をかける
  • メモリの値を変数bに読み込む
  • 60を値bでわり(値bが0ならばエラーとなる)、結果を変数cに代入する
  • 値aをメモリの値に代入する
  • メモリの値から3をひく
  • メモリの値を変数dに読み込む
  • 250を値dでわり(値dが0ならばエラーとなる)、結果を変数eに代入する
  • 値cと値eの和をかえす

対話環境で試してみよう。

> :load stateError.hs
> sample1 `runSE` 8
Right (60,5)
> sample1 `runSE` 5
Left "60 is divided by 0"
> sample1 `runSE` 3
Left "250 is divided by 0"

エラーでも状態を保持する

状態モナドとエラーモナドを混ぜ合わせたものを処理する、もうひとつのやりかたがある。こちらのやりかただと、エラーであっても状態が保持できる。ファイルstateError.hsに関数runSE'を定義する。

stateError.hs
runSE' :: Freer (SE s e) a -> s -> (Either e a, s)
runSE' m s = case m of
        Pure x -> (Right x, s)
        Get s' `Bind` k -> runSE' (k ()) s'
        Exc e `Bind` _k -> (Left e, s)

試してみよう。

> :load stateError.hs
> sample1 `runSE'` 8
(Right 60,5)
> sample1 `runSE'` 5
(Left "60 is divided by 0",0)
> sample1 `runSE'` 3
(Left "250 is divided by 0",0)

エラーからの復帰

エラーから復帰するための仕組みも作る。

stateError.hs
catchError :: Freer (SE s e) a -> (e -> Freer (SE s e) a) -> Freer (SE s e) a
m `catchError` h = case m of
        Pure x -> return x
        Exc e `Bind` _k -> h e
        mx `Bind` k -> mx `Bind` ((`catchError` h) . k)

単純な値である(Pure x)では、その値をそのままかえす。エラーが発生した(Exc e)ときには、エラーハンドラーhにエラーをわたす。それ以外のとき(Get, Put)には、それぞれの処理をおこなったあとに、再帰的にエラーからの復帰をするために、(`catchError` h)とkを関数合成しておく。

エラーからの復帰を含むサンプル

エラーからの復帰を含むサンプルを定義する。

stateError.hs
divMemory :: Integer -> Freer (SE Integer String) ()
divMemory n = do
        a <- get
        b <- a `safeDiv` n
        put b

sample2 :: Integer -> Freer (SE Integer String) Integer
sample2 n = do
        divMemory n
        a <- get
        return $ a * 10

メモリーの値を引数nでわり、その結果を取り出して、10倍してかえす。nが0ならばエラーになる。エラーからの復帰を試してみよう。

> :reload
> sample2 2 `runSE` 8
Right (40,4)
> sample2 0 `runSE` 8
Left "8 is divided by 0"
> sample2 0 `catchError` const (return 100) `runSE` 8
Right (100,8)

状態モナドとエラーモナドとを、それぞれに処理する

状態モナドとエラーモナドとの、それぞれの処理をわけることを考える。うえで定義した関数catchErrorをみてほしい。この処理は、見かたをかえれば、エラーモナドだけを処理していると考えることができる。これとおなじように考えれば、状態モナドだけ、エラーモナドだけを処理する関数を書くことができる。まずは、状態モナドの部分だけを処理する関数を書く。ファイルstateError.hsに関数runStateを定義する。

stateError.hs
runState :: Freer (SE s e) a -> a -> Freer (SE s e) (a, s)
runState m s = case m of
        Pure x -> return (x, s)
        Get `Bind` k -> runState (k s) s
        Put s' `Bind` k -> runState (k ()) s'
        mx `Bind` k -> mx `Bind` ((`runState` s) . k)

状態モナドの機能(Get, Put)に対しては、その機能を展開する。それ以外の機能(Exc)に対しては、関数catchErrorのときとおなじように、その機能を展開したあとに状態モナドの機能が展開されるように、(`runState` s)を再帰的に適用する。つぎに、関数runErrorを定義する。

stateError.hs
runError :: Freer (SE s e) a -> Freer (SE s e) (Either e a)
runError = \case
        Pure x -> return $ Right x
        Exc e `Bind` _k -> return $ Left e
    mx `Bind` k -> mx `Bind` (runError . k)

おなじく、エラーモナドの機能(Exc)に対しては、その機能を展開する。それ以外の機能(Get, Put)に対しては、その機能を展開したあとにエラーモナドの機能が展開されるように、runErrorを再帰的に適用する。関数runStateとrunErrorとを適用したあと、型としてはFreer ...となるが、Get、Put、Excはすべて処理されてなくなるのでPureだけが残る。
そのPureから値を取り出す関数を作っておこう。

stateError.hs
runPure :: Freer (SE s e) a -> a
runPure = \case
        Pure x -> x
        _ -> error "remain State or Error"

対話環境で試してみよう。

> :reload
> runPure . runError $ sample1 `runState` 8
Right (60,5)
> runPure . runError $ sample1 `runState` 3
Left "250 is divided by 0"
> runPure $ runError sample1 `runState` 8
(Right 60,5)
> runPure $ runError sample1 `runState` 3
(Left "250 is divided by 0",0)

Writerモナドを追加する

状態モナドとエラーモナド

状態モナドとエラーモナドの混ぜ合わせのコードを、もういちど、みてみよう。復習という意味もあるが、それだけでなく、Writerモナドを追加するための下準備として、うえで紹介した内容をくりかえす。つぎの内容のファイルstateErrorWriter.hsを作成する。

stateErrorWriter.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

import Freer

data SE s e a where
        Get :: SE s e s
        Put :: s -> SE s e ()
        Exc :: e -> SE s e a

get :: Freer (SE s e) s
get = freer Get

put :: s -> Freer (SE s e) ()
put = freer . Put

modify :: (s -> s) -> Freer (SE s e) ()
modify f = put . f =<< get

throwError :: e -> Freer (SE s e) a
throwError = freer . Exc

catchError :: Freer (SE s e) a -> (e -> Freer (SE s e) a) -> Freer (SE s e) a
m `catchError` h = case m of
        Pure x -> return x
        Exc e `Bind` _k -> h e

runState :: Freer (SE s e) a -> s -> Freer (SE s e) (a, s)
runState m s = case m of
        Pure x -> Pure (x, s)
        Get `Bind` k -> runState (k s) s
        Put s' `Bind` k -> runState (k ()) s'
        mx `Bind` k -> mx `Bind` ((`runState` s) . k)

runError :: Freer (SE s e) a -> Freer (SE s e) (Either e a)
runError = \case
        Pure x -> Pure $ Right x
        Exc e `Bind` _k -> return $ Left e
        mx `Bind` k -> mx `Bind` (runError . k)

runPure :: Freer (SE s e) a -> a
runPure = `case
        Pure x -> x
        _ -> error "remain State or Error"

サンプルも定義しておく。

stateErrorWriter.hs
safeDiv :: Integer -> Integer -> Freer (SE s String) Integer
safeDiv n 0 = throwError $ show n ++ " is divided by 0"
safeDiv n m = return $ n `div` m

sample :: Freer (SE Integer String) Integer
sample = do
        a <- get
        modify (subtract 5)
        b <- get
        c <- 60 `safeDiv` b
        put a
        modify (subtract 3)
        d <- get
        e <- 250 `safeDiv` d
        return $ c + e

対話環境で試しておく。

> :load stateErrorWriter.hs
> runPure . runError $ sample `runState` 8
Right (70,5)
> runPure . runError $ sample `runState` 3
Left "250 is divided by 0"

Writerモナドを追加する

さて、状態モナドとエラーモナドにWriterモナドをつけ加える。まずは、データ型に値構築子Writerを追加で定義する。

stateErrorWriter.hs
data SE s e w a where
        Get :: SE s e w s
        Put :: s -> SE s e w ()
        Exc :: e -> SE s e w a
        Writer :: w -> SE s e w ()

対話環境に再読み込みしてみる。

> :reload
(型エラーが発生する)

型エラーがなくなるまで型構築子SEの引数にwを追加していく。以下の10ヶ所を変更することになる。

stateErrorWriter.hs
.
.
.
get :: Freer (SE s e w) s
.
.
.
put :: s -> Freer (SE s e w) ()
.
.
.
modify :: (s -> s) -> Freer (SE s e w) ()
.
.
.
throwError :: e -> Freer (SE s e w) a
.
.
.
catchError :: Freer (SE s e w) a -> (e -> Freer (SE s e w) a -> Freer (SE s e w) a
.
.
.
runState :: Free (SE s e w) a -> s -> Freer (SE s e w) (a, s)
.
.
.
runError :: Free (SE s e w) a -> Freer (SE s e w) (Either e a)
.
.
.
runPure :: Freer (SE s e w) a -> a
.
.
.
safeDif :: Integer -> Integer -> Freer (SE s String String) Integer
.
.
.
sample :: Freer (SE Integer String String) Integer
.
.
.

Writerモナドの機能として関数tellを定義する。

stateErrorWriter.hs
tell :: w -> Freer (SE s e w) ()
tell = freer . Writer

関数runWriterを定義する。まずは、導入するモジュールを指定する。ファイルstateErrorWriter.hsの言語拡張のつぎの行に、つぎのように追加する。

stateErrorWriter.hs
import Control.Arrow
import Data.Monoid

関数runWriterを定義する。

stateErrorWriter.hs
runWriter :: Monoid w => Freer (SE s e w) a -> Freer (SE s e w) (a, w)
runWriter = \case
        Pure x -> return (x, mempty)
        Writer w `Bind` k -> second (w <>) <$> runWriter (k ())
        mx `Bind` k -> mx `Bind` (runWriter . k)

関数safeDivが、わり算のログを保存するようにする。

stateErrorWriter.hs
safeDiv :: Integer -> Integer -> Freer (SE s String String) Integer
safeDiv n 0 = throwError $ show n ++ " is divided by 0"
safeDiv n m = do
        tell $ show n ++ " `div` " ++ show m ++ "\n"
        return $ n `div` m

対話環境で試してみる。

> :reload
> runPure . runError . runWriter $ sample `runState` 8
Right ((70,5),"60 `div` 3\n250 `div` 5\n")

Writerモナドを追加するのに必要だったこと

Writerモナドを追加するのに必要だったことは、

  • 値構築子Writerの追加
  • 型宣言の修正
  • 関数tellの定義
  • 関数runWriterの定義

だった。

拡張性がない

データ型に新しい値構築子を追加して、それに対するrun...を定義すれば、新しい機能が追加できる。run...は別モジュールで追加することもできるけれど、Haskellのデータ型は閉じているので、別モジュールで値構築子を追加することはできない。はじめに定義したデータ型に含まれた機能以上のことはできない。それなら、値構築子を追加できるデータ型を作ればいいのでは。

まとめ

まずは、状態モナドとエラーモナドを混ぜ合わせたモナドを作り、さらにそれにWriterモナドも追加した。いまの実装では、モナドの機能の追加のためには、データ型に値構築子を追加する必要があり、たとえば、別モジュールで機能を追加することはできない。

5
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
5
0