Coproduct で型の直和型をつくる - 僕でもわかるCoproduct -

はじめに

先日 Tagless Final を合成したときのテストを考えていたとき、@goldarn_ring さんの『Freeモナドの合成』という記事で Coproductという概念を知りました。
記事のコードを参考にしたところ、自分のやりたかったことは実現できたのですが、そもそもCoproductが何なのか、どういう理屈で期待通り動いているのか最初よくわかりませんでした。

これで「ヨシ！」とするのはまずいので、写経したりテストを書きながらCoproductと（一方的に）親睦を深めたので、自分みたいなPureScript初学者が見てもわかるようにじっくりと書いてみようと思います。

話の流れ

話の流れとしては、まずCoproductで何ができるかや、どのように使うのかを説明します。
その後、どういう仕組になっているのかの詳しい解説に入っていきます。

Coproductで何ができるか

タイトルにあるように『型の直和型』を作って、それを利用することができます。
例えば2つの代数的データ型の直和型を作ることで、どちらの代数的データ型の値でも動く関数を作れます。
例えば型X,Yがあったとき、次のような関数を定義できるようになります（擬似コード）。

exec :: XかYどちらか -> String
exec = ...

exec X -- Xで呼び出すことができる
exec Y -- Yでも呼び出すことができる

上記のXかYどちらかを示す型を実現することができるのがCoproductです。

-- X Y Unit の Unit の部分の説明はあとで！
type XかYどちらか = Coproduct X Y Unit

何がうれしいか

たとえば冒頭で紹介した@goldarn_ringさんの記事で書かれているように、Freeモナドを組み合わせるときに使うとうれしいのではないでしょうか。
私の場合は冒頭に書いた通りTagless Finalを合成したときのテストを書くアプローチを模索していて必要になり使いました。

使ってみよう

Coproductの定義をみてみよう

Coproductを使うにあたって、まずは定義を見てみましょうか。

-- | `Coproduct f g` is the coproduct of two functors `f` and `g`
newtype Coproduct :: forall k. (k -> Type) -> (k -> Type) -> k -> Type
newtype Coproduct f g a = Coproduct (Either (f a) (g a))

型構築子Coproduct f g aを見ると型引数に制約がありますね。
型引数のfやgは(k -> Type) となっており、また型引数の3つ目がkとなっているので、fやgは任意の型kを包むような型になっていないといけないのです。
例えば、次のような型XやYですね。既存の型でいえばMaybeやArrayなどもそうでしょう。

newtype X a = X a
newtype Y a = Y a

このXとYのCoproduct型を構築する場合、定義によると、X型Y型それぞれを構築する際の型引数は一致している必要があるので、例えば型引数をStringにしたCoproductは次のようになります。

type XYString = Coproduct X Y String

またデータコンストラクタの方はこうなっています。

Coproduct (Either (f a) (g a))

おなじみのEitherです。Either自体が直和型なので、CoproductはEitherを利用して直和型を実現しているということですね。

余談ですが、Coproduct(余積)はProduct(積)の双対なのでProductも存在して、このような定義になっています。型構築子の部分はCoproductと同じですが、データコンストラクタの部分がTupleになっています。

newtype Product :: forall k. (k -> Type) -> (k -> Type) -> k -> Type
newtype Product f g a = Product (Tuple (f a) (g a))

ちなみにコメントには`Coproduct f g` is the coproduct of two functors `f` and `g`と書かれていますが、別にFunctorである必要はないです。

さーてこれでCoproductの構築の仕方がわかったぞ！

ということで、例として単純な型X・YおよびこれらのCoproductを使う次のような関数を作ってみました。

newtype X a = X a
newtype Y a = Y a

echoXorY :: Coproduct X Y String -> String
echoXorY = case _ of
  (Coproduct (Left  (X a))) -> "X: " <> a
  (Coproduct (Right (Y a))) -> "Y: " <> a

Coproductを用いた関数を作るのは簡単で、Coproductの実体はEitherなので、上記のようにパターンマッチで書くだけです。

おーし、じゃあいっちょやって（呼び出して）みっか！

・・・・・・というのは残念ながらまだ早いです。
準備が足りないのです。

おめえの出番だぞ inj！！

Coproductを使用した関数を呼び出すにはinj関数を使う必要があるのです。
ということでinjの出番です。

満を持して登場したinjですが、使うのはカンタンです。
XやYなどの型の値を生成してinjに与えてやるだけです。

さきほど例に挙げた型と関数を再度登場させます。

newtype X a = X a
newtype Y a = Y a

echoXorY :: Coproduct X Y String -> String
echoXorY = case _ of
  (Coproduct (Left  (X a))) -> "X: " <> a
  (Coproduct (Right (Y a))) -> "Y: " <> a

この関数を呼び出すのには、このようにinjを呼び出してやればOKです。

echoXorY (inj (X "value")) 

嬉しいことに、injの結果は、XやYをとる関数でも使うことができます。

echoX :: X String -> String
echoX (X v) = v

-- コンパイルエラーにならない
echoX (inj (X "value X"))

毎度injを呼び出すのは面倒くさいので、何度も使用する場合は関数を作ってしまった方がよいでしょう。

x :: forall g a. Inject X g => a -> g a
x a = inj (X a)

おーっと、ここでInjectなる型が出てきました。
実はこのInject型こそ、上記のようなことを実現する上での立役者なのです。

一体どういうことか、Injectのことを説明していきたいと思います。

が、その前に一旦ここまでをまとめたコードを載せておきます。

import Prelude

import Data.Either (Either(..))
import Data.Functor.Coproduct (Coproduct(..))
import Data.Functor.Coproduct.Inject (class Inject, inj)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)

newtype X a = X a
newtype Y a = Y a

x :: forall g a. Inject X g => a -> g a
x a = inj (X a)

y :: forall g a. Inject Y g => a -> g a
y a = inj (Y a)

echoX :: X String -> String
echoX (X v) = v

echoY :: Y String -> String
echoY (Y v) = v

echoXorY :: Coproduct X Y String -> String
echoXorY = case _ of
  (Coproduct (Left  (X a))) -> "X: " <> a
  (Coproduct (Right (Y a))) -> "Y: " <> a

spec :: Spec Unit
spec = do
  describe "Coproduct Spec" do
    it "X型を受け取る関数を呼び出すことができる" do
      echoX (x "value X") `shouldEqual` "value X"

    it "Y型を受け取る関数を呼び出すことができる" do
      echoY (y "value Y") `shouldEqual` "value Y"

    it "X型かY型のCoproductを受け取る関数を呼び出すことができる(X)" do
      echoXorY (x "value") `shouldEqual` "X: value"
    
    it "X型かY型のCoproductを受け取る関数を呼び出すことができる(Y)" do
      echoXorY (y "value") `shouldEqual` "Y: value"

全部 Inject さんのおかげじゃないか

元の型のまま扱えるのも・・・
Coproduct型として扱えるのも・・・

全部 Inject さんが居たからじゃないか・・・！

ということで、本格的にInjectを説明していきたいと思います。
理解するには、やはりまず定義を見ないとですね。
ということで定義です。

定義を見よう

class Inject :: forall k. (k -> Type) -> (k -> Type) -> Constraint
class Inject f g where
  inj :: forall a. f a -> g a
  prj :: forall a. g a -> Maybe (f a)

instance injectReflexive :: Inject f f where
  inj = identity
  prj = Just

else instance injectLeft :: Inject f (Coproduct f g) where
  inj = Coproduct <<< Left
  prj = coproduct Just (const Nothing)

else instance injectRight :: Inject f g => Inject f (Coproduct h g) where
  inj = Coproduct <<< Right <<< inj
  prj = coproduct (const Nothing) prj

型クラスInjectにはinjとprjという2つの関数が定義されていますが、今回はinjに着目したいので、prjの説明は端折ります。

Instance Chain

instanceの定義が次のようになっていますが、これはInstance Chainと呼ばれるものです。

instance xxx 
else instance yyy 
else instance zzz

どのようなケースで必要になるのか、ちょっと説明しておきましょう。
例えばこのような型クラスがあるとします。

class Echo a where
  echo :: a -> Effect Unit

この型クラスのinstanceを定義する場合、次のように具体的な型を用いるのならば特に問題はおきません。

instance echoString :: Echo String where
  echo a = log a

instance echoInt :: Echo Int where
  echo a = logShow a

しかし次のように任意の型aを指定した場合コンパイルエラーになります。

instance echoString :: Echo String where
  echo a = log a

-- これは駄目
instance echoA :: Show a => Echo a where
  echo a = logShow a

このようなときに使えるのがInstance Chainで、次のようにinstance宣言をelseで繋げます。

instance echoString :: Echo String where
  echo a = log a
else
instance echoInt :: Show a => Echo a where
  echo a = logShow a

この場合String型の値に対しては上のinstanceが選択され、それ以外のShow型に属する型の値に対しては下のinstanceが選択されます。

chainの中のinstanceの関係は上の例で説明した通り、より前に宣言されたinstanceから、そのinstanceが選択されか判断されていくという意味でフラットではありません（が、今回の例だとあまり関係ないですね）。

以上を踏まえてあらためてInjectのinstanceを見てみましょう。

injectReflexiveが選択されなかったら、injectLeft。injectLeftが選択されなかったらinjectRightというようになっています。

では続いて、それぞれのinsntanceの意味・役割を調べていきます。

それぞれのinstanceの意味

まず定義を再掲します(prj関数は省略しています)。

class Inject :: forall k. (k -> Type) -> (k -> Type) -> Constraint
class Inject f g where
  inj :: forall a. f a -> g a

instance injectReflexive :: Inject f f where
  inj = identity

else instance injectLeft :: Inject f (Coproduct f g) where
  inj = Coproduct <<< Left

else instance injectRight :: Inject f g => Inject f (Coproduct h g) where
  inj = Coproduct <<< Right <<< inj

この3つのinstanceは何を意味しており、何を実現するためのものなのでしょうか？

これを理解するために、各instanceに対して次のような関数を書いてみます。

1. prefixにinstanceの名前をつける（例: injectReflexiveInj)
2. injを適用した結果を返す
3. injを適用する型は、すべてのinstanceの例で同じものを使う
4. 関数が返す型はそれぞれのinstanceごとに変える
   （これは同じ値を返しているのに別の型として返せるということを示すためです）

ちなみにそれぞれの関数は、例とするinsntaceの定義なしではコンパイルエラーとなるような関数になっています（つまりそのinsntanceのおかげで実現できている）。

---

これらの関数を書く前に、何もinsntaceが定義されていない状態で、injが何を返すのかを簡単な例で確認してみます(型シグニチャはIDEの機能使って補完させると手っ取り早いです)。

example :: forall g. Inject Maybe g => g String
example = inj (Just "hoge")

この例では、Maybe String型の値をinjに与えています。
injの定義はinj :: forall a. f a -> g aなので、fがMaybe、aがStringとなり、
結果型シグニチャはforall g. Inject Maybe g => g Stringとなりました。

上記の関数は、instanceが存在しない状態では、何の意味もない関数です。
が、injectReflexiveやinjectLeftなどのinstanceが定義されることによって、マジカルな関数になるのです。

---

前置きはここまでにして、そろそろ各insntanceごとの関数を書いていきます。
最初はinjectReflexiveです。一番上に宣言されているinstanceですね。

instance injectReflexive :: Inject f f where
  inj = identity

型クラスにおけるinjの定義はinj :: forall a. f a -> g aでした。
この場合は、gとfは同じなので、injはf aを返すわけです。型を変えないわけですね。実際このinsntanceのinjはidentityで値をそのまま返しています。
それでは、確認の関数を書いてみましょう。

injectReflexiveInj :: Maybe String
injectReflexiveInj = inj (Just "hoge")

この関数の場合、injはforall g. Inject Maybe g => g Stringという関数になりますね。
そして関数の型アノテーションではMaybe String型を返すと宣言しています。
つまりgはMaybeになります。ということはInject Maybe Maybeつまり、Inject f fのパターンすなわちinjectReflexiveにマッチします。マッチするinsntanceが存在するため、コンパイルエラーにはなりません。
これにより、ある型Xの値をinjに与えたとしても、その結果を元の型Xを使う関数にそのまま渡すことができるようになったということです。

---

次にinjectLeftです。

else instance injectLeft :: Inject f (Coproduct f g) where
  inj = Coproduct <<< Left
  prj = coproduct Just (const Nothing)

しつこいですが、injの定義はinj :: forall a. f a -> g aなので、この場合のinjはforall a. f a -> (Coproduct f g) aとなります。
確認の関数を書いてみます。

injectLeftInj :: Coproduct Maybe Identity String
injectLeftInj = inj (Just "hoge")

この関数の場合injはforall g. Maybe String -> (Coproduct Maybe g) Stringという関数になりますね。この例ではgをIdentityとしていますが、gは任意の型なので何でも大丈夫です。
instance chainのパターンとしては、injectReflexiveにはマッチせずinjectLeftにマッチしていますね。
injに対し最初の例と同じようにMaybeを与えましたが、今度はCoprodct Maybe gという解釈もできるようになりました。

---

最後にinjectRightです。

else instance injectRight :: Inject f g => Inject f (Coproduct h g) where
  inj = Coproduct <<< Right <<< inj

これで最後です。injの定義はinj :: forall a. f a -> g aなので、この場合のinjはforall a h. f a -> (Coproduct h g) aとなります。
injの実装はCoproduct <<< Right <<< injとなっていますが、injはf a -> g aという定義なので、injの結果のg aをCoproduct <<< Rightに与えればCoproduct h gのgに型が合致します(hは任意の型)。
確認の関数も書いてみます。

injectRightInj :: Coproduct (Const Void) Maybe String
injectRightInj = inj (Just "hoge")

この関数の場合injはforall h. Maybe String -> (Coproduct h Maybe) Stringという関数になりますね。instance chainのパターンとしては、最後のinjectRightにマッチします。
injに対しこれまでと同じようにMaybeを与えましたが、今度はCoprodct h Maybeという解釈もできるようになりました。

さぁーーー、これで、Injectの「おかげ」で型Xの値を与えたinjの結果は、X型のままとしてもCoproduct X g型としてもCoproduct f X型としても扱えるようになりました。

Injectスゴイ！！

長かった説明も以上となります。
真面目に読んでくれた方、お疲れ様＆ありがとうございました。

このあたりの仕組みを知ったとき、私は感動してしまいました。
PureScriptはうぉぉスゲーって思うことが多い気がします（Haskellもスゲェんでしょうけど私はHaskellを触らずにElmからPurescriptにきたので、Haskellは語れないんですよね）。

おまけ(3つ以上のCoproduct)

ここまで紹介してきたCoproductの例は、2つの型のうちどちらかという型でしたが、これを3つ以上に増やすこともできます。
やり方は簡単で<\/>で型をつないでやるだけです。使うときはネストさせてパターンマッチします。
以下はサンプルです。

import Prelude

import Data.Either (Either(..))
import Data.Functor.Coproduct (Coproduct(..))
import Data.Functor.Coproduct.Inject (class Inject, inj)
import Data.Functor.Coproduct.Nested (type (<\/>))
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)

newtype X a = X a
newtype Y a = Y a
newtype Z a = Z a

x :: forall g a. Inject X g => a -> g a
x a = inj (X a)

y :: forall g a. Inject Y g => a -> g a
y a = inj (Y a)

z :: forall g a. Inject Z g => a -> g a
z a = inj (Z a)

type XYZ = X <\/> Y <\/> Z

echoXorYorZ :: XYZ String -> String
echoXorYorZ = case _ of
  (Coproduct (Left  (X a))) -> "X: " <> a
  (Coproduct (Right r)) -> case r of
    (Coproduct (Left  (Y a))) -> "Y: " <> a
    (Coproduct (Right (Z a))) -> "Z: " <> a

spec :: Spec Unit
spec = do
  describe "Coproduct Spec" do
    it "X型かY型かZ型のCoproductを受け取る関数を呼び出すことができる(X)" do
      echoXorYorZ (x "value") `shouldEqual` "X: value"
    
    it "X型かY型のZ型のCoproductを受け取る関数を呼び出すことができる(Y)" do
      echoXorYorZ (y "value") `shouldEqual` "Y: value"

    it "X型かY型のZ型のCoproductを受け取る関数を呼び出すことができる(Z)" do
      echoXorYorZ (z "value") `shouldEqual` "Z: value"