Arrowの基本(3) |||演算子で条件分岐

Arrowの基本、三本目の記事は、Arrowが関数を繋いでいく流れの中で条件分岐を作り出す ||| 演算子の再実装をしていきます。

Prelude Control.Arrow> :i (|||)
class (Arrow a) => ArrowChoice a where
  ...
  (|||) :: a b d -> a c d -> a (Either b c) d
  	-- Defined in Control.Arrow
infixr 2 |||

引数の「a b d」「a c d」に注目してください、それぞれ(b -> d) (c -> d)という関数を包んだArrow型のデータなのはOKですね、今まで使った >>> や *** 等の演算子はいずれも(b -> c)と(c -> d)のように、2引数をそのまま合成する事ができましたが、この関数は少し勝手が違うようです。

戻り値である(a (Either b c) d)を見ると、bとc各々の型を持ったEitherという型を引数に取り、d型の値を返す(Either b c -> d)という関数を作って、Arrowに包んで返却しているという事がわかります。

Prelude Control.Arrow> :i Either
data Either a b = Left a | Right b 	-- Defined in Data.Either
instance (Eq a, Eq b) => Eq (Either a b) -- Defined in Data.Either
instance Functor (Either a) -- Defined in Control.Monad.Instances
instance (Ord a, Ord b) => Ord (Either a b)
  -- Defined in Data.Either
instance (Read a, Read b) => Read (Either a b)
  -- Defined in Data.Either
instance (Show a, Show b) => Show (Either a b)
  -- Defined in Data.Either
Prelude Control.Arrow> :q
Leaving GHCi.

Either型のデータの実際の値は「Left a」または「Right b」のどちらかという事がわかります。
以上の事から、 ||| 演算子「Left a」を引数として受け取った場合は第一引数の (b -> d) という関数に、「Right a」を引数として受け取った場合は第二引数の (c -> d) という関数にそれぞれ a という値を適用する関数を包んだArrow型のデータを作ると推測することができますね。
つまり、受け取った値が「Left a」の時は第一引数の関数を、「Right b」の時は第二引数の関数を実行する「条件分岐」を行う関数を作る演算子という事です。

言葉にするとややこしいですね、なんにせよ|||演算子を真似て|-|演算子を作ってみる事にしていけばイメージできるようになるかと思われます。
先に掲載した ||| 演算子の定義を見ると、ArrowChoiceという型クラスに定義されていますが、あくまで学習のための実験なので、そのままMyArrow型クラスに作ってしまいましょう。
全体を掲載すると長くなってしまうので必要な所以外は省略していますが・・・

module Main where

...

infixr 2 |-|

data MyEither a b = MyLeft a | MyRight b deriving (Show,Eq)
class MyArrow a where

...

  (|-|) :: a b d -> a c d -> a (MyEither b c) d

...

data Foo a b = Foo { runFoo :: (a -> b) }
instance MyArrow Foo where

...

  Foo f |-| Foo g = Foo $ \x -> judg x
    where judg (MyLeft a)  = f a
          judg (MyRight a) = g a

この実装はあくまで動作を再現するためのものなので、実際の実装方法とは違うかもしれません、念の為。

それでは、実行してみましょう。
はじめに偶数の場合はLeft、奇数の場合はRightを返すevenLeft関数を用意します。

*Main> let evenLeft x | even x = MyLeft x | otherwise = MyRight x
*Main> map evenLeft [1..6]
[MyRight 1,MyLeft 2,MyRight 3,MyLeft 4,MyRight 5,MyLeft 6,MyRight 7,MyLeft 8,MyRight 9,MyLeft 10]

この関数と、先ほど定義した |-| 演算子を組み合わせて、偶数の場合と奇数の場合で違う文字列を生成するようにプログラミングしてみましょう。
(「Arrowの基本」は、このエントリが初めての方に念の為説明しますが、 --> 演算子は >>> 演算子の、myarrはarrの再実装です。)

*Main> let checkEven = Foo evenLeft --> myarr ((++" is even").show) |-| myarr ((++" is not even").show)
*Main> runFoo checkEven $ 1
"1 is not even"
*Main> runFoo checkEven $ 2
"2 is even"
*Main> runFoo checkEven $ 3
"3 is not even"
*Main> runFoo checkEven $ 4
"4 is even"
*Main> runFoo checkEven $ 5
"5 is not even"

当然の事ながら、MyArrowクラスのインスタンスにした(->)に対して、この演算子を次のように実装すれば、myarrやrunFooを書く必要はありません。

instance MyArrow (->) where

...

  f |-| g = \x -> judg x
    where judg (MyLeft a)  = f a
          judg (MyRight a) = g a

実行結果:

*Main> let checkEven = evenLeft --> (++" is even").show |-| (++" is not even").show
*Main> checkEven 1
"1 is not even"
*Main> checkEven 2
"2 is even"
*Main> checkEven 3
"3 is not even"
*Main> checkEven 4
"4 is even"

MyArrowで演算子を繋いでいく中に、上手く条件分岐を組み込めました。

- 演算子は、Arrowの 演算子を再実装したものですから、ArrowChoice型クラスを実装したデータ型では同じように扱う事ができます。

もちろん、通常の関数(->)もArrowChoiceのインスタンスなので、Control.Arrowをインポートすれば、次のように関数合成ができるというわけです。

Prelude Control.Arrow> let evenLeft x | even x = Left x | otherwise = Right x
Prelude Control.Arrow> let checkEven = evenLeft >>> (++" is even").show ||| (++" is not even").show
Prelude Control.Arrow> putStrLn.concatMap (++"\n") $ map checkEven [1..15]
1 is not even
2 is even
3 is not even
4 is even
5 is not even
6 is even
7 is not even
8 is even
9 is not even
10 is even
11 is not even
12 is even
13 is not even
14 is even
15 is not even

こっちのほうが読みやすい・・・とゆーか、「|-| 演算子」はちょっとセンスなさ過ぎな気もしますね・・・



おまけ:
evenLeftのような関数をいくつも作る必要がある場合、次のtrueLeftのような関数を作ってやるのが、Haskellらしくて良いかも。

Prelude Control.Arrow> let trueLeft f x | f x = Left x | otherwise = Right x
Prelude Control.Arrow> let checkEven = trueLeft even >>> (++" is even").show ||| (++" is not even").show