Haskell语言学习笔记（47）Arrow（2）

Function, Monad, Arrow

f :: Int -> (Int, Int)
f = \x ->
let y  = 2 * x
z1 = y + 3
z2 = y - 5
in (z1, z2)

-- ghci> f 10
-- (23, 15)

fM :: Int -> Identity (Int, Int)
fM = \x -> do
y  <- return (2 * x)
z1 <- return (y + 3)
z2 <- return (y - 5)
return (z1, z2)

-- ghci> runIdentity (fM 10)
-- (23,15)

fA :: Int -> (Int, Int)
fA = proc x -> do
y  <- (2 *) -< x
z1 <- (+ 3) -< y
z2 <- (subtract 5) -< y
returnA -< (z1, z2)

-- ghci> fA 10
-- (23,15)

ArrowZero, ArrowPlus, ArrowChoice

class Arrow a => ArrowZero a where
zeroArrow :: a b c

class ArrowZero a => ArrowPlus a where
(<+>) :: a b c -> a b c -> a b c

class Arrow a => ArrowChoice a where
left :: a b c -> a (Either b d) (Either c d)
left = (+++ id)

right :: a b c -> a (Either d b) (Either d c)
right = (id +++)

(+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
f +++ g = left f >>> arr mirror >>> left g >>> arr mirror
where
mirror :: Either x y -> Either y x
mirror (Left x) = Right x
mirror (Right y) = Left y

(|||) :: a b d -> a c d -> a (Either b c) d
f ||| g = f +++ g >>> arr untag
where
untag (Left x) = x
untag (Right y) = y

instance MonadPlus m => ArrowZero (Kleisli m) where
zeroArrow = Kleisli (\_ -> mzero)

instance MonadPlus m => ArrowPlus (Kleisli m) where
Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x)

instance ArrowChoice (->) where
left f = f +++ id
right f = id +++ f
f +++ g = (Left . f) ||| (Right . g)
(|||) = either

instance Monad m => ArrowChoice (Kleisli m) where
left f = f +++ arr id
right f = arr id +++ f
f +++ g = (f >>> arr Left) ||| (g >>> arr Right)
Kleisli f ||| Kleisli g = Kleisli (either f g)

Prelude Control.Arrow> runKleisli ((Kleisli (\x -> [x * 2])) <+> (Kleisli (\x -> [x, -x]))) 2
[4,2,-2]
Prelude Control.Arrow> either (+2) (*3) (Left 3)
5
Prelude Control.Arrow> either (+2) (*3) (Right 3)
9
Prelude Control.Arrow> (+2) ||| (*3) $ (Left 3)
5
Prelude Control.Arrow> (+2) +++ (*3) $ (Left 3)
Left 5
Prelude Control.Arrow> (+2) ||| (*3) $ (Right 3)
9
Prelude Control.Arrow> (+2) +++ (*3) $ (Right 3)
Right 9
Prelude Control.Arrow> left (+2) (Left 3)
Left 5
Prelude Control.Arrow> right (*3) (Right 3)
Right 9
Prelude Control.Arrow> left (+2) (Right 3)
Right 3
Prelude Control.Arrow> right (*3) (Left 3)
Left 3
Prelude Control.Arrow> runKleisli ((Kleisli (\x -> [x * 2])) ||| (Kleisli (\x -> [x, -x]))) (Left 3)
[6]
Prelude Control.Arrow> runKleisli ((Kleisli (\x -> [x * 2])) ||| (Kleisli (\x -> [x, -x]))) (Right 3)
[3,-3]
Prelude Control.Arrow> runKleisli ((Kleisli (\x -> [x * 2])) +++ (Kleisli (\x -> [x, -x]))) (Left 3)
[Left 6]
Prelude Control.Arrow> runKleisli ((Kleisli (\x -> [x * 2])) +++ (Kleisli (\x -> [x, -x]))) (Right 3)
[Right 3,Right (-3)]