「Learn Haskell」#7 一些其它类型类

< #6

#A >

Foldable

Foldable是表示可以折叠（fold）的类型类，在Data.Foldable中定义，这使得和fold相关的函数可以用在任意Foldable的实例类型上。它的定义是：

class Foldable t where
    fold     :: Monoid m => t m -> m
    foldMap  :: Monoid m => (a -> m) -> t a -> m
    foldMap' :: Monoid m => (a -> m) -> t a -> m
    foldr    :: (a -> b -> b) -> b -> t a -> b
    foldr'   :: (a -> b -> b) -> b -> t a -> b
    foldl    :: (b -> a -> b) -> b -> t a -> b
    foldl'   :: (b -> a -> b) -> b -> t a -> b
    foldr1   :: (a -> a -> a) -> t a -> a
    foldl1   :: (a -> a -> a) -> t a -> a
    toList   :: t a -> [a]
    null     :: t a -> Bool
    length   :: t a -> Int
    elem     :: Eq a => a -> t a -> Bool
    maximum  :: Ord a => t a -> a
    minimum  :: Ord a => t a -> a
    sum      :: Num a => t a -> a
    product  :: Num a => t a -> a
    {-# MINIMAL foldMap | foldr #-}

最少只要实现foldr和foldMap其中之一就可以使一个类型成为Foldable的实例，其它的函数都有由这两个函数提供的默认实现，而且这两个函数之间也有相互实现。因此只要实现foldr或foldMap一个函数就可以使用所有其它Foldable中的函数。foldr函数在前面已经有学过，foldMap的例子是：

ghci> foldMap Sum [1, 3, 5]
Sum {getSum = 9}
ghci> foldMap Product [1, 3, 5]
Product {getProduct = 15}
ghci> foldMap (replicate 3) [1, 2, 3]
[1,1,1,2,2,2,3,3,3]

Foldable实例

[]、Maybe、Either a、(,) a都是Foldable的实例，标准容器库中的Map、Set等也都是Foldable的实例。也可以自定义二叉树类型，并使其成为Foldable的实例：

data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)

instance Foldable Tree where 
    foldMap :: Monoid m => (a -> m) -> Tree a -> m
    foldMap f Empty        = mempty
    foldMap f (Leaf x)     = f x
    foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r

常用函数

• asum :: (Alternative f, Foldable t) => t (f a) -> f a，用<|>逐个连接所有元素
• sequenceA_ :: (Applicative f, Foldable t) => t (f a) -> f ()，由于丢弃结果，所以Foldable t就可以满足；因此不同于sequenceA需要Traversable
• traverse_ :: (Applicative f, Foldable t) => (a -> f b) -> t a -> f ()
• for_ :: (Applicative f, Foldable t) => t a -> (a -> f b) -> f ()

Traversable

Traversable是表示可遍历的类型类，在Data.Traversable模块中定义，它是Foldable的升级版，同时也是一个Functor，它的定义是：

class (Functor t, Foldable t) => Traversable t where 
    traverse  :: Applicative f => (a -> f b) -> t a -> f (t b)
    sequenceA :: Applicative f => t (f a) -> f (t a)
    mapM      ::       Monad m => (a -> m b) -> t a -> m (t b)
    sequence  ::       Monad m => t (m a) -> m (t a)
    {-# MINIMAL traverse | sequenceA #-}

最少只需要实现traverse函数或者sequenceA函数。其中各个函数的功能通过类型签名也都能推测出来。但是其中mapM就是traverse，sequence就是sequenceA，它们存在只是历史遗留（

Traversable实例

instance Traversable Maybe where
    traverse _ Nothing = pure Nothing
    traverse f (Just x) = Just <$> f x

instance Traversable [] where
    {-# INLINE traverse #-}
    traverse f = foldr cons_f (pure [])
      where cons_f x ys = liftA2 (:) (f x) ys

instance Traversable (Either a) where
    traverse _ (Left x) = pure (Left x)
    traverse f (Right y) = Right <$> f y

instance Traversable ((,) a) where
    traverse f (x, y) = (,) x <$> f y

...

上面的Tree也可以成为Traversable的实例：

instance Functor Tree where
    fmap :: (a -> b) -> Tree a -> Tree b
    fmap     g Empty        = Empty
    fmap     g (Leaf x)     = Leaf $ g x
    fmap     g (Node l x r) = Node (fmap g l)
                                   (g x)
                                   (fmap g r)

instance Traversable Tree where
    traverse :: Applicative f => (a -> f b) -> Tree a -> f (Tree b) 
    traverse g Empty        = pure Empty
    traverse g (Leaf x)     = Leaf <$> g x
    traverse g (Node l x r) = Node <$> traverse g l
                                   <*> g x
                                   <*> traverse g r

Traversable Laws

Traversable也有两条定律：

1. traverse Identity = Identity
2. traverse (Compose . fmap g . f) = Compose . fmap (traverse g) . traverse f

其中Identity和Compose分别定义在Data.Functor.Identity和Data.Functor.Compose两个模块中：

newtype Identity a = Identity { runIdentity :: a } deriving (...)
newtype Compose f g a = Compose { getCompose :: f (g a) } deriving (...)

Bifunctor

Functor的实例的kind都是* -> *，因此fmap只能将一个函数映射到一个值上。而Bifunctor（在Data.Bifunctor模块中定义）的实例的kind是* -> * -> *，而且它的bimap可以同时将两个函数映射到两个值上：

class Bifunctor p where 
    bimap  :: (a -> b) -> (c -> d) -> p a c -> p b d 
    first  :: (a -> b) -> p a c -> p b c 
    second :: (b -> c) -> p a b -> p a c 
    {-# MINIMAL bimap | first, second #-}

同时bimap和first,second之间也可以相互转换：

bimap f g = first f . second g

first  f = bimap f id
second g = bimap id g

对于Functor，((,) e)和Either e才是Functor的实例，因为他们是* -> *。但是对于Bifunctor，(,)和Either就是Bifunctor的实例：

ghci> bimap (+1) length (4, [1,2,3])
(5,3)

Bifunctor Laws

1. bimap id id = id
   first id = id
   second id = id
2. bimap (f . g) (h . i) = bimap f h . bimap g i
   first (f . g) = first f . first g
   second (f . g) = second f . second g

Category

Haskell中的Category将一般的函数推广到了普遍的态射上，它在Control.Category模块中，定义是：

class Category cat where 
    id  :: cat a a 
    (.) :: cat b c -> cat a b -> cat a c

它的实例有(->)和Kleisli m：

instance Category (->) where
    id = GHC.Base.id
    (.) = (GHC.Base..)

Kleisli是一个范畴，用来表示函数a -> m b，Haskell中，它在Control.Arrow模块中定义：

newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }

instance Monad m => Category (Kleisli m) where
    id :: Kleisli m a a
    id = Kleisli return

    (.) :: Kleisli m b c -> Kleisli m a b -> Kleisli m a c
    Kleisli g . Kleisli h = Kleisli (h >=> g)

Category要满足的定律只有id是(.)操作的单位元，以及(.)操作是可结合的

同时Category还提供了两个函数<<<和>>>：

(<<<) :: Category cat => cat b c -> cat a b -> cat a c
(<<<) = (.)

(>>>) :: Category cat => cat a b -> cat b c -> cat a c 
f >>> g = g . f 

Arrow

Arrow将函数进一步抽象化，它定义在Control.Arrow模块中：

class Category a => Arrow a where 
    arr    :: (b -> c) -> a b c 
    first  :: a b c -> a (b, d) (c, d)
    second :: a b c -> a (d, b) (d, c)
    (***)  :: a b c -> a b' c' -> a (b, b') (c, c')
    (&&&)  :: a b c -> a b c' -> a b (c, c')
    {-# MINIMAL arr, (first | (***)) #-}

其中：

• arr函数将一个函数变成一个Arrow
• first函数将一个Arrow变成一个二元组间的Arrow，且只会对一个元素进行操作，第二个元素保持不变
• second函数与first相反，第一个元素保持不变
• ***函数是Arrow之间的parallel composition，对于函数: (g *** h) (x, y) = (g x, h y)
• &&&函数是Arrow之间的fanout composition，对于函数: (g &&& h) x = (g x, h x)

它的实例也有(->)和Kleisli：

instance Arrow (->) where
  arr :: (b -> c) -> (b -> c)
  arr g = g

  first :: (b -> c) -> ((b,d) -> (c,d))
  first g (x,y) = (g x, y)

instance Monad m => Arrow (Kleisli m) where
  arr :: (b -> c) -> Kleisli m b c
  arr f = Kleisli (return . f)

  first :: Kleisli m b c -> Kleisli m (b,d) (c,d)
  first (Kleisli f) = Kleisli (\ ~(b,d) -> do c <- f b
                                              return (c,d) )

常用函数：

returnA :: Arrow a => a b b
returnA = arr id

(^>>) :: Arrow a => (b -> c) -> a c d -> a b d
f ^>> a = arr f >>> a

(>>^) :: Arrow a => a b c -> (c -> d) -> a b d
a >>^ f = a >>> arr f

(<<^) :: Arrow a => a c d -> (b -> c) -> a b d
a <<^ f = a <<< arr f

(^<<) :: Arrow a => (c -> d) -> a b c -> a b d
f ^<< a = arr f <<< a

Arrow notation

类似do-notation，Arrow也提供了一套方便的语句：

proc x -> do 
    y <- action1 -< ... 
    z <- action2 -< ...
    returnA -< ...

其中proc代替了lambda表达式中的斜杠\，-<右边的为输入，左边的为接收输入的函数。比如，下面三种写法达成的效果是一样的：

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)

ArrowChoice

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 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)

ArrowZero & ArrowPlus

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

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)

例子

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

Reference

• Typeclassopedia - Haskell wiki
• Haskell语言学习笔记（40）Arrow（1） - zwvista
• 24 Days of GHC Extensions: Arrows - Tom Ellis
• Haskell语言学习笔记（47）Arrow（2） - zwvista

---

目录

#0 | 总章        
#1 | 基础语法与函数   
#2 | 高阶函数与模块   
#3 | 类型与类型类    
#4 | 输入输出与文件   
#5 | 函子、应用函子与单子
#6 | 半群与幺半群    
#7 | 一些其它类型类   
#A | Haskell与范畴论