More than 3 years have passed since last update.

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

Last updated at 2020-01-09Posted at 2019-09-25

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

はじめに

「Freer Effectsが、だいたいわかった」シリーズのクライマックスだ。ようやく、ここまで来た。Freerモナドと開いた直和型とを組み合わせる。Freer EffectsはFreerモナドと開いた直和型の両方にとっての、よい使用例になっている。

Freeモナドの概要
- Freeモナドとは
- FreeモナドでReaderモナド、Writerモナドを構成する
存在型(ExistentialQuantification拡張)の解説
型シノニム族(TypeFamilies拡張)の解説
データ族(TypeFamilies拡張)の解説
一般化代数データ型(GADTs拡張)の解説
ランクN多相(RankNTypes拡張)の解説
FreeモナドとCoyoneda
- Coyonedaを使ってみる
- FreeモナドとCoyonedaを組み合わせる
  - いろいろなモナドを構成する
Freerモナド(Operationalモナド)でいろいろなモナドを構成する
- FreeモナドとCoyonedaをまとめて、Freerモナドとする
- Readerモナド
- Writerモナド
- 状態モナド
- エラーモナド
モナドを混ぜ合わせる(閉じた型で)
- Freerモナドで、状態モナドとエラーモナドを混ぜ合わせる
  - 両方のモナドを一度に処理する
  - それぞれのモナドを、それぞれに処理する
存在型による拡張可能なデータ構造(Open Union)
追加の言語拡張
1. ScopedTypeVariables拡張
2. TypeOperators拡張
3. KindSignatures拡張
4. DataKinds拡張
5. MultiParamTypeClasses拡張
6. [FlexibleInstances拡張] (
  https://qiita.com/YoshikuniJujo/items/eb70e7978f333ef3b514 )
7. OVERLAPSプラグマ
8. FlexibleContexts拡張
9. LambdaCase拡張
Open Unionを型によって安全にする
モナドを混ぜ合わせる(開いた型で)
- FreeモナドとOpen Unionを組み合わせる
- 状態モナドにエラーモナドを追加する
Freer Effectsで、IOモナドなどの、既存のモナドを使用する
関数を保管しておくデータ構造による効率化
いろいろなEffect
- 関数send, handleRelayなどを作成する
- NonDetについてなど
- Trace
- Fresh, Cut
- Coroutine

本質

ここまで、長々と説明してきたが、Freer Effectsの本質は、つぎの型シノニムにある。

type Eff effs = Freer (Union effs)

開いた直和型による拡張可能な「文脈」を、Freerモナドにくるんでいる。

Readerモナドの例

データ型Readerを、つぎのように定義する。

data Reader e a where Reader :: Reader e e

Readerモナドにおける「値を読み出す関数ask」は、つぎのようになる。

ask :: Member (Reader e) effs => Eff effs e
ask = inj Reader `Bind` Pure

型クラス制約のMember (Reader e) effsは、「型のリストeffsが型Reader eを含む」という意味である。なのでMember (Reader e) effs => Eff effs eとした場合には、つぎのような型を意味する。

Eff '[Reader e] e
Eff '[Writer w, Reader e, State s] e
Eff '[Foo, Bar, Reader e, Baz] e
...

inj Readerで、関数injは適切なインデックスを指定しつつ、値Readerを開かれた直和型に変換している。たとえば、ask :: Eff '[Writer w, Reader e, State s] eだったとすると、インデックスは1になるはずだ。Bind (inj Reader) Pureとすることで、Freerモナドにつつみこんでいる。

関数runReaderを定義する。

runReader :: Eff (Reader e ': effs) a -> e -> Eff effs a
m `runReader` e = case m of
        Pure x -> Pure x
        u `Bind` k -> case decomp u of
                Right Reader -> k e `runReader` e
                Left u' -> u' `Bind` ((`runReader` e) . k)

Pure xならば、そのままPure xになる。Bind u kであった場合、decomp uによってuのなかみがReaderモナドなのか、それ以外のモナドなのかを場合分けする。Readerモナドであれば、モナドの計算の続きであるkに引数としてeをあたえ、さらに関数runReaderを適用していく。uのなかみがReaderモナドでなかったときには、そのままモナドの計算の続きであるkにたいしてrunReaderを適用していく。関数runReaderは、Readerモナドだけを処理して、ほかのモナドについては「そのまま」にしておく処理だ。

Readerモナドのサンプルを定義する。

readerSample :: Eff '[Reader Integer] Integer
readerSample = do
        e <- ask
        return $ 3 * e

これに関数runReaderを適用すると結果の型はEff '[] Integerとなる。Effの型引数が空リストであるということは、モナドの文脈を含んでいないということになるので、かならずPure xのかたちになっているはずだ。このような、文脈が空になったデータ型から値を取り出す関数を定義する。

run :: Eff '[] a -> a
run (Pure x) = x
run _ = error "Eff.run: This function can run only PUre"

定義の2行目のエラーは開かれた直和型を正しく関数injのみで構成して、正しく関数prjやdecompなどで展開していれば、起こり得ないエラーだ。なぜなら、値構築子BindはEffの型引数である「型のリスト」に型が含まれていなければ、導入することができず、「型のリスト」から型を取り除くには対応する値構築子Bindを展開しなくてはならないからだ。

ここまでのコードの全体

ここまでのコードの全体を、ここに再掲する。

src/Freer.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Freer (Freer(..)) where

import Control.Monad ((>=>))

data Freer t a = Pure a | forall x . t x `Bind` (x -> Freer t a)

instance Functor (Freer f) where
        f `fmap` Pure x = Pure $ f x
        f `fmap` Bind tx k = tx `Bind` (k >=> Pure . f)

instance Applicative (Freer f) where
        pure = Pure
        Pure f <*> m = f <$> m
        tx `Bind` q <*> m = tx `Bind` (q >=> (<$> m))

instance Monad (Freer f) where
        Pure x >>= f = f x
        tx `Bind` k >>= f = tx `Bind` (k >=> f)

src/OpenUnion.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DataKinds, KindSignatures, TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module OpenUnion (Union, Member, inj, prj, decomp) where

import Unsafe.Coerce (unsafeCoerce)

data Union (ts :: [* -> *]) a = forall t . Union Word (t a)

newtype P (t :: * -> *) (ts :: [* -> *]) = P { unP :: Word }

class Member (t :: * -> *) (ts :: [* -> *]) where elemNo :: P t ts
instance Member t (t ': ts) where
        elemNo = P 0
instance {-# OVERLAPPABLE #-} Member t ts => Member t (_t' ': ts) where
        elemNo = P $ 1 + unP (elemNo :: P t ts)

inj :: forall t ts a . Member t ts => t a -> Union ts a
inj = Union $ unP (elemNo :: P t ts)

prj :: forall t ts a . Member t ts => Union ts a -> Maybe (t a)
prj (Union i x)
        | i == unP (elemNo :: P t ts) = Just $ unsafeCoerce x
        | otehrwise = Nothing

decomp :: Union (t ': ts) a -> Either (Union ts a) (t a)
decomp (Union 0 tx) = Right $ unsafeCoerce tx
decomp (Union i tx) = Left $ Union (i - 1) tx

src/Eff.hs

{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Eff (Eff, Freer(..), Member, run, inj, prj, decomp) where

import Freer (Freer(..))
import OpenUnion (Union, Member, inj, prj, decomp)

type Eff effs = Freer (Union effs)

run :: Eff '[] a -> a
run (Pure x) = x
run _ = error "Eff.run: This function can run only Pure"

Freer Effectsの本質は上記の3つのモジュールだ。あとは、それぞれのモナドと、それらについて「そのモナドだけを処理する関数」を定義すればいい。Readerモナドでは、うえでみたように、つぎのようになる。

src/Reader.hs

{-# LANGUAGE GADTs, DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Reader (Reader, ask, runReader) where

import Eff (Eff, Freer(..), Member, inj, decomp)

data Reader e a where Reader :: Reader e e

ask :: Member (Reader e) effs => Eff effs e
ask = inj Reader `Bind` Pure

runReader :: Eff (Reader e ': effs) a -> e -> Eff effs a
m `runReader` e = case m of
        Pure x -> Pure x
        u `bind` k -> case decomp u of
                Right Reader -> k e `runReader` e
                Left u' -> u' `bind` ((`runReader` e) . k)

サンプルをモジュールSamplesに定義する。

src/Samples.hs

{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Sample where

import Eff
import Reader

readerSample :: Eff '[Reader Integer] Integer
readerSample = do
        e <- ask
        return $ 3 * e

対話環境で試してみる。

*Samples> run $ readerSample `runReader` 123
369

Writerモナド

おなじように、Writeモナドを定義する。

src/Writer.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs, DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Writer (Writer, tell, runWriter) where

import Control.Arrow (second)
import Data.Monoid (mempty, (<>))

import Eff (Eff, Freer(..), Member, inj, decomp)

data Writer w a where Writer :: w -> Writer w ()

tell :: Member (Writer w) effs => w -> Eff effs ()
tell = (`Bind` Pure) . inj . Writer

runWriter :: Monoid w => Eff (Writer w ': effs) a -> Eff effs (a, w)
runWriter = \case
        Pure x -> Pure (x, mempty)
        u `Bind` k -> case decomp u of
                Right (Writer w) -> second (w <>) <$> runWriter (k ())
                Left u' -> u' `Bind` (runWriter . k)

とくに新しい話はない。いままでの話を組み合わせれば、わかるはずだ。tell 123のようにすることで、Writer 123が開かれた直和型に変換されたうえで、Freerモナドでつつみこまれる。関数runWriterはWriter wをみつけるたびに、タプルの第2要素にwを追加していく。

Stateモナド

Stateモナドについても、だいたいおなじだ。

src/State.hs

{-# LANGUAGE GADTs, DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module State (State, runState, get, put, modify) where

import Eff (Eff, Freer(..), Member, inj, decomp)

data State s a where Get :: State s s; Put :: s -> State s ()

get :: Member (State s) effs => Eff effs s
get = inj Get `Bind` Pure

put :: Member (State s) effs => s -> Eff effs ()
put = (`Bind` Pure) . inj . Put

modify :: Member (State s) effs => (s -> s) -> Eff effs ()
modify f = put . f =<< get

runState :: Eff (State s ': effs) a -> s -> Eff effs (a, s)
m `runState` s0 = case m of
        Pure x -> Pure (x, s0)
        u `Bind` k -> case decomp u of
                Right Get -> k s0 `runState` s0
                Right (Put s) -> k () `runState` s
                Left u' -> u' `Bind` ((`runState` s0) . k)

Stateモナドについても、新しい話はないかと思う。関数getやputは、それぞれReaderモナドやWriterモナドの関数askやtellとだいたいおなじだ。関数runStateでは、Getをみつけるたびに「続く計算に状態s0を引数としてあたえて」いる。またPut sをみつけるたびに、状態をsに更新している。Bind u kでuがGetでもPut sでもない場合には、そのまま残しておき続く計算に対してrunStateを再帰的に適用している。

Exceptionモナド

src/Exception.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Exception (Exc, runError, throwError, catchError) where

import Eff (Eff, Freer(..), Member, inj, prj, decomp)

newtype Exc e a = Exc e

throwError :: Member (Exc e) effs => e -> Eff effs a
throwError = (`Bind` Pure) . inj . Exc

runError :: Eff (Exc e ': effs) a -> Eff effs (Either e a)
runError = \case
        Pure x -> Pure $ Right x
        u `Bind` k -> case decomp u of
                Right (Exc e) -> Pure $ Left e
                Left u' -> u' `Bind` (runError . k)

catchError ::
        Member (Exc e) effs => Eff effs a -> (e -> Eff effs a) -> Eff effs a
m `catchError` h = case m of
        Pure x -> Pure x
        u `Bind` k -> case prj u of
                Just (Exc e) -> h e
                Nothing -> u `Bind` ((`catchError` h) . k)

関数throwErrorはWriterモナドの関数tellと、だいたいおなじだ。throwError "Oops!"とするとExc "Oops!"を開かれた直和型に変換したものがFreerモナドでつつまれる。関数runErrorも、いままでみてきた内容で理解できるはずだ。Bind u kでuがExc eだったときには「残りの計算」を捨ててLeft eをかえす。

関数catchErrorは新しい内容を含んでいる。まず、Exc eを取り出すのに関数decompではなく関数prjを使っている。関数decompは型リストの先頭に、その型があることを想定していて、結果の型からは、その型が取り除かれる。関数prjでは型リストにその型が含まれていればよく、結果の型からその型を取り除かない。

関数catchErrorはBind u kにおいてuがExc eだったときに、残りの計算は捨ててh eに置き換える。h e :: Eff effs aの型リストeffsにはExc eも含まれているので、関数catchErrorは、「エラー処理をしたあとに、おなじエラーを投げ直す」などの処理をすることができる。

StateモナドとExceptionモナドとを組み合わせる

適当な計算の例でStateモナドとExceptionモナドとを組み合わせてみよう。

Sample.hs

{-# LANGUAGE ScopedTypeVariables, DataKinds, FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Samples where

import Eff
import State
import Exception

safeDiv :: Member (Exc String) effs => Integer -> Integer -> Eff effs Integer
n `safeDiv` 0 = throwError $ show n ++ " is devided by 0"
n `safeDiv` m = return $ n `div` m

safeDivSample :: (Member (State Integer) effs, Member (Exc String) effs) =>
        Eff effs Integer
safeDivSample = do
        (a :: Integer) <- get
        modify (subtract (5 :: Integer))
        modify (* (2 :: Integer))
        b <- get
        c <- 60 `safeDiv` b
        put a
        modify (subtract (3 :: Integer))
        d <- get
        e <- 250 `safeDiv` d
        return $ c + e

runSafeDivSample1 :: Integer -> Either String (Integer, Integer)
runSafeDivSample1 n = run $ runError (safeDivSample `runState` n)

runSafeDivSample2 :: Integer -> (Either String Integer, Integer)
runSafeDivSample2 n = run $ runError safeDivSample `runState` n

計算safeDivSampleの型はEff effs Integerで、型リストeffsは要素としてState IntegerとExc Stringを含んでいる。状態であるInteger型の値に対して、いろいろな計算をしたり、それを取り出したりしている。また、関数safeDivによって、わる数が0のときにはエラーを投げるようになっている。

関数runSafeDivSample1は計算を実行するやりかたのひとつであり、「初期状態をあたえる処理のうえで、エラーを処理し」ている。関数runSafeDivSample2は計算を実行する、もうひとつのやりかたであり、「エラーの処理のうえで、初期状態をあたえる処理をし」ている。

対話環境で試してみる。

*Samples> runSafeDivSample1 8
Right (60,5)
*Samples> runSafeDivSample1 5
Left "60 is devided by 0"
*Samples> runSafeDivSample1 3
Left "250 is devided by 0"
*Samples> runSafeDivSample2 8
(Right 60,5)
*Samples> runSafeDivSample2 5
(Left "60 is devided by 0",0)
*Samples> runSafeDivSample2 3
(Left "250 is devided by 0",0)

モナドの階層構造を意識する必要がない

それぞれのモナドの機能を組み合わせるときには、モナドの階層構造を意識する必要がない。組み立てた構造を「単純な値」に展開する段階で「階層構造」を決めてやればいい。

まとめ

ここまで、ながながと説明してきた、ふたつの道具を組み合わせて、「モナドを混ぜ合わせる」仕組みを作った。その道具は、つぎのふたつだ。

Freerモナド
開かれた直和型

モナドトランスファーマーだと、モナドを組み合わせるときに「モナドの階層構造」を意識する必要がある。Freer Effectsでは、その必要がない。これは、それぞれのモナドについて「部品として使いやすくなる」性質だ。

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up

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

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

はじめに

目次

本質

Readerモナドの例

ここまでのコードの全体

Writerモナド

Stateモナド

Exceptionモナド

StateモナドとExceptionモナドとを組み合わせる

モナドの階層構造を意識する必要がない

まとめ