[haskell] How To Arrow3 選択

import Control.Arrow
newtype SF a b = SF {runSF ::[a]->[b]}
instance Arrow SF where
    arr f = SF (map f)
    SF f >>> SF g = SF (f >>> g)
    first (SF f) = SF (unzip >>> first f >>> uncurry zip)
instance ArrowChoice SF where
    left (SF f) = SF(\xs -> combine xs (f [y | Left y <- xs]))
      where combine (Left y:xs) (z:zs) = Left z: combine xs zs
            combine (Right y:xs) zs = Right y: combine xs zs
            combine [] zs = []

-- 次に Haskell でも割と邪悪な匂いのする Either 型について試してみる。
-- Either 型は either 関数と一緒に使って条件文を構成する。either 関数
-- の最後の引数が Left なら左の文、Right なら右の文を実行する。文に渡
-- す型が違っていても良い。文の結果の型は同じにしないといけない。

question x = either ("String= "++) (\y -> "Number= "++ show (y * 2)) x
-- *Main> question (Left "etoys")
-- "String= etoys"
-- *Main> question (Right 21)
-- "Number= 42"

-- ここから本題。今までの Arrow は素直にデータを流すだけだったが、ここ
-- で条件分岐。『こんにちはマイコン』に敬意を示して、来たデータが 
-- "ARASHI" だったら "TENSAI" それ以外は "BAKA" を返してみる。例によっ
-- て一つの文字列でも文字列のリストでも使える！

hantei "ARASHI" = Left "ARASHI"
hantei x = Right x

tesuto :: ArrowChoice a => a String String
tesuto = arr hantei >>> arr (++ ", TENSAI.") ||| arr (++ ", BAKA.")
-- *Main> tesuto "ARASHI"
-- "ARASHI, TENSAI."
-- *Main> tesuto "SATORU"
-- "SATORU, BAKA."
-- *Main> runSF tesuto ["ARASHI", "SATORU", "IPPEITA"]
-- ["ARASHI, TENSAI.","SATORU, BAKA.","IPPEITA, BAKA."]

-- 先ほど Arrow を並列に並べる例で、&&& と *** そして first の関係につ
-- いて書いた。実は条件分岐に使った ||| も相当する物として +++ と left 
-- があり、美しい対象性が存在する。説明は省略して left を使った例だけ
-- 挙げる。first は IF THEN ELSE の ELSE 無し版と考える事が出来る。ま
-- た、戻り値は Either であり、*** や first が平行な Arrow をそのまま
-- 通すように、+++ や left は条件の Arrow をそのまま通す。

tesuto' :: ArrowChoice a => a String (Either String String)
tesuto' = arr hantei >>> left (arr (++ ", TENSAI"))
-- *Main> tesuto' "ARASHI"
-- Left "ARASHI, TENSAI"
-- *Main> tesuto' "Satoru"
-- Right "Satoru"

-- まとめ
-- >>>          Arrow を直列に繋げる
-- &&&   一本の Arrow を分岐して同時に実行
-- ***   二本の Arrow を        同時に実行
-- first 二本の Arrow を        同時に実行する左側の処理
-- |||   二本の Arrow のどちらかを実行して一本に纏める。
-- +++   二本の Arrow のどちらかを実行
-- left  二本の Arrow のどちらかを実行する左側の処理