原文：
nubis, 16 Mar 2013, School of Haskell

序言

在我开始学 haskell 时有些不知所措。最初我把它用于一个实际的工作项目，然后我发现几乎所有的库都使用了仅在 GHC 可用的语言扩展。这让我开始有点失望，毕竟，谁想使用一种如此贫瘠的语言，以至于你需要依靠一个编译器的扩展才能实际去应用它，对吧？

好吧，我振作起来，决定学习所有这些扩展。我发现 Haskell 社区有三个热门话题，它们都在说有关 GADT、类型家族和依赖函数类似的问题。于是我试着查找资料去了解它们，但我只能找到描述它们是什么、如何使用的文章，没有一篇真正地解释为什么我们是怎么需要它们的！因此，我决定用一个友好的例子来写这篇教程，解释我们为什么需要类型家族。

来吧，我们开始

听说过精灵宝可梦吗？它们是居住在精灵宝可梦世界的奇妙生物，像是有超能力的动物。所有宝可梦有一种类型——它们的能力取决于它们的类型。举个例子，火属性的宝可梦可以喷火，水属性的宝可梦可以射出水柱。

人们可以拥有宝可梦，它们的特殊能力可以很好地在生产中利用。但是有些人仅仅把他们的宝可梦与其他人的用来战斗，这些人们自称宝可梦训练家。这些起来可能有点残忍，不过很有趣。似乎每个人都同意，包括宝可梦它们自己。精灵宝可梦世界的人们似乎也可以接受10岁的孩子离家去，冒着生命危险成为最好的宝可梦训练家，这是前所未有的。

我们将使用 Haskell 来表达精灵宝可梦世界中一个受限制的部分（有些魔改，粉丝们请原谅）：

  • 宝可梦拥有一种类型，在例子中我们仅限于火、水和草。
  • 每种类型有三只宝可梦：小火龙、火恐龙、喷火龙为火属性；杰尼龟、卡咪龟、水箭龟为水属性；妙蛙种子、妙蛙草、妙蛙花为水属性。
  • 每种类型有自己独特的能力（moves）：水属性执行水能力、火属性执行火能力、草属性执行草能力。
  • 在战斗时：火属性宝可梦总会击败草属性宝可梦、草属性宝可梦总会击败水属性宝可梦、水属性宝可梦总会击败火属性宝可梦。
  • 两个同类型的宝可梦不可战斗，因为没法决定谁会赢。
  • 其他人可以在别的模块中添加他们自己的宝可梦。
  • 类型检查器帮助我们严格遵循这些规则。

初次尝试

首先，我们将尝试在不使用类型类和类型家族的情况下实现这些规则。

我们从一些类型的宝可梦和它们的独特能力开始，将它们分开定义有助于我们知道哪些能力与哪些宝可梦匹配。为此，我们定义了一个为宝可梦选择能力的函数。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
data Fire = Charmander | Charmeleon | Charizard deriving Show -- 宝可梦名字
data Water = Squirtle | Wartortle | Blastoise deriving Show
data Grass = Bulbasaur | Ivysaur | Venusaur deriving Show

data FireMove = Ember | FlameThrower | FireBlast deriving Show -- 宝可梦能力
data WaterMove = Bubble | WaterGun deriving Show
data GrassMove = VineWhip deriving Show

pickFireMove :: Fire -> FireMove
pickFireMove Charmander = Ember
pickFireMove Charmeleon = FlameThrower
pickFireMove Charizard = FireBlast

pickWaterMove :: Water -> WaterMove
pickWaterMove Squirtle = Bubble
pickWaterMove _ = WaterGun

pickGrassMove :: Grass -> GrassMove
pickGrassMove _ = VineWhip

到目前为止还不错，类型检查器将确保我们只能创建正确的宝可梦，它们只能使用与它们的类型相匹配的超能力。

现在我们要让宝可梦们战斗了。战斗的视觉呈现会显示每个宝可梦使用的能力以及胜者，像这样：

1
2
3
4
5
6
7
8
9
printBattle :: String -> String -> String -> String -> String -> IO ()
printBattle pokemonOne moveOne pokemonTwo moveTwo winner = do
  putStrLn $ pokemonOne ++ " used " ++ moveOne
  putStrLn $ pokemonTwo ++ " used " ++ moveTwo
  putStrLn $ "Winner is: " ++ winner ++ "\n"

main :: IO ()
main =
  printBattle "Water Pokemon" "Water Attack" "Fire Pokemon" "Fire Attack" "Water Pokemon"

显示出使用的能力只是为了表达出战斗过程，我们会根据宝可梦的类型决定赢家，不管能力是什么。这里有一个水属性和火属性宝可梦之间战斗的例子。

1
2
3
4
5
6
7
8
battleWaterVsFire :: Water -> Fire -> IO ()
battleWaterVsFire water fire = do
  printBattle (show water) moveOne (show fire) moveTwo (show water)
 where
  moveOne = show $ pickWaterMove water
  moveTwo = show $ pickFireMove fire

battleFireVsWater = flip battleWaterVsFire -- 和上面的一样，不过翻转了参数

现在我们把这些代码放在在一起，定义剩下的战斗函数，就得到了一个程序！

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
data Fire = Charmander | Charmeleon | Charizard deriving Show
data Water = Squirtle | Wartortle | Blastoise deriving Show
data Grass = Bulbasaur | Ivysaur | Venusaur deriving Show

data FireMove = Ember | FlameThrower | FireBlast deriving Show
data WaterMove = Bubble | WaterGun deriving Show
data GrassMove = VineWhip deriving Show

pickFireMove :: Fire -> FireMove
pickFireMove Charmander = Ember
pickFireMove Charmeleon = FlameThrower
pickFireMove Charizard = FireBlast

pickWaterMove :: Water -> WaterMove
pickWaterMove Squirtle = Bubble
pickWaterMove _ = WaterGun

pickGrassMove :: Grass -> GrassMove
pickGrassMove _ = VineWhip

printBattle :: String -> String -> String -> String -> String -> IO ()
printBattle pokemonOne moveOne pokemonTwo moveTwo winner = do
  putStrLn $ pokemonOne ++ " used " ++ moveOne
  putStrLn $ pokemonTwo ++ " used " ++ moveTwo
  putStrLn $ "Winner is: " ++ winner ++ "\n"

-- 显示战斗的函数
battleWaterVsFire :: Water -> Fire -> IO ()
battleWaterVsFire water fire = do
  printBattle (show water) moveOne (show fire) moveTwo (show water)
 where
  moveOne = show $ pickWaterMove water
  moveTwo = show $ pickFireMove fire

battleFireVsWater = flip battleWaterVsFire

battleGrassVsWater :: Grass -> Water -> IO ()
battleGrassVsWater grass water = do
  printBattle (show grass) moveOne (show water) moveTwo (show grass)
 where
  moveOne = show $ pickGrassMove grass
  moveTwo = show $ pickWaterMove water

battleWaterVsGrass = flip battleGrassVsWater

battleFireVsGrass :: Fire -> Grass -> IO ()
battleFireVsGrass fire grass = do
  printBattle (show fire) moveOne (show grass) moveTwo (show fire)
 where
  moveOne = show $ pickFireMove fire
  moveTwo = show $ pickGrassMove grass

battleGrassVsFire = flip battleFireVsGrass

main :: IO ()
main = do
  battleWaterVsFire Squirtle Charmander
  battleFireVsWater Charmeleon Wartortle
  battleGrassVsWater Bulbasaur Blastoise 
  battleWaterVsGrass Wartortle Ivysaur
  battleFireVsGrass Charmeleon Ivysaur
  battleGrassVsFire Venusaur Charizard

引入类型类

等等，这是在复读：试想一下有人在这些代码中加入一个电属性的皮卡丘，他们还得自己定义自己的 battleElectricVs(Grass|Fire|Water)函数。这里出现了一些模式，我们可以将其形式化，以帮助人们更好地理解宝可梦是什么，并帮助他们创造新的宝可梦。

这是我们学会的：

  • 宝可梦使用函数去选择它们的能力
  • 战斗决定赢家并打印出战斗过程

我们将定义一些类型类来使它们形式化，在过程中，我们还将讨论很妙的命名方案，其中每个函数都包含它所操作的类型。

在此，我假设你熟悉传统的类型类，如果不熟悉，请阅读 Haskell 趣学指南的这章。

宝可梦类型类

宝可梦类型将代表宝可梦选择它们能力的依据。它让我们定义的 pickMove 可被重载，以便同样的函数可以操作对于我们已经定义好的类型类的不同属性。

与原生的类型类不同，我们的宝可梦类型类需要知道两个类型：宝可梦的类型和能力类型，因为后者取决于前者。我们需要启用 MultiParamTypeClasses 语言扩展来让我们的类型类能接收两个参数。

还要注意，我们必须添加约束条件，这样宝可梦类型和能力类型也是可以 show 的。

以下是定义，以及现有宝可梦类型的一些实例：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
{-# LANGUAGE MultiParamTypeClasses #-}
data Fire = Charmander | Charmeleon | Charizard deriving Show
data Water = Squirtle | Wartortle | Blastoise deriving Show
data Grass = Bulbasaur | Ivysaur | Venusaur deriving Show

data FireMove = Ember | FlameThrower | FireBlast deriving Show
data WaterMove = Bubble | WaterGun deriving Show
data GrassMove = VineWhip deriving Show

-- 显示
class (Show pokemon, Show move) => Pokemon pokemon move where
  pickMove :: pokemon -> move

instance Pokemon Fire FireMove where
  pickMove Charmander = Ember
  pickMove Charmeleon = FlameThrower
  pickMove Charizard = FireBlast

instance Pokemon Water WaterMove where
  pickMove Squirtle = Bubble
  pickMove _ = WaterGun

instance Pokemon Grass GrassMove where
  pickMove _ = VineWhip

main :: IO ()
main = do
  print (pickMove Charmander :: FireMove)
  print (pickMove Blastoise :: WaterMove)
  print (pickMove Bulbasaur :: GrassMove)

注意事情是如何开始变得棘手的：由于宝可梦的类型和能力类型在类型类中作为分开的参数进行处理，调用 pickMove 和传入一个小火龙（Charmander）会让类型检查器查找看起来像 Pokemon Fire a 这样宝可梦类型类的实例，但我们没有，所以会失败。

可以试试在没有类型签名的情况下调用上面的 pickMove，然后看一下出现的错误。

通过表示我们希望 pickMove 产生一个 FireMove，我们给了类型检查器决定使用 Pokemon Fire FireMove 实例所需的所有信息。

战斗类型类

我们已经有了能够选择自己能力的宝可梦，现在我们需要一个表示宝可梦间能够相互战斗的抽象，来代替 battle...Vs... 这一系列函数。

所以接下来我们将定义另一个多参类型类（MultiParamTypeClass），限制参数为宝可梦多参类型类。我们还将定义每种希望支持战斗的类型类实例。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
{-# LANGUAGE MultiParamTypeClasses #-}
data Fire = Charmander | Charmeleon | Charizard deriving Show
data Water = Squirtle | Wartortle | Blastoise deriving Show
data Grass = Bulbasaur | Ivysaur | Venusaur deriving Show

data FireMove = Ember | FlameThrower | FireBlast deriving Show
data WaterMove = Bubble | WaterGun deriving Show
data GrassMove = VineWhip deriving Show

class (Show pokemon, Show move) => Pokemon pokemon move where
  pickMove :: pokemon -> move

instance Pokemon Fire FireMove where
  pickMove Charmander = Ember
  pickMove Charmeleon = FlameThrower
  pickMove Charizard = FireBlast

instance Pokemon Water WaterMove where
  pickMove Squirtle = Bubble
  pickMove _ = WaterGun

instance Pokemon Grass GrassMove where
  pickMove _ = VineWhip
  
printBattle :: String -> String -> String -> String -> String -> IO ()
printBattle pokemonOne moveOne pokemonTwo moveTwo winner = do
  putStrLn $ pokemonOne ++ " used " ++ moveOne
  putStrLn $ pokemonTwo ++ " used " ++ moveTwo
  putStrLn $ "Winner is: " ++ winner ++ "\n"
  
-- 显示战斗类型类
class (Pokemon pokemon move, Pokemon foe foeMove) => Battle pokemon move foe foeMove where
  battle :: pokemon -> foe -> IO ()
  battle pokemon foe = do
    printBattle (show pokemon) (show move) (show foe) (show foeMove) (show pokemon)
   where
    move = pickMove pokemon
    foeMove = pickMove foe

instance Battle Water WaterMove Fire FireMove

main :: IO ()
main = do
  battle Squirtle Charmander

当我们运行上面的代码片段时会得到一个错误。类型检查器告诉我们：想要让杰尼龟（Squirtle）和小火龙（Charmander）战斗，我们得有一个像 Battle Water move0 Fire foeMove0 这样的类型类实例。

这又让我们回到了刚刚定义宝可梦多参类型类时的问题。在刚才那种情况下，我们通过在调用 pickMove 时加上类型签名解决了它。

因为战斗返回的类型是 IO()，这次我们就没那么走运了。

有一个快速并且糟糕的方法解决这个问题——让战斗返回使用的能力，这样我们就能在调用 battle 时加上类型签名来帮助类型检查器确定使用的类型类实例。所以，我们现在就这样做 :)

我会继续，并定义 battle 为返回 IO(move, foeMove)。接下来定义剩下的实例，完成与第一版相同的功能，只是现在一切都应该更加形式化一些。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
{-# LANGUAGE MultiParamTypeClasses #-}
import Data.Tuple (swap)
data Fire = Charmander | Charmeleon | Charizard deriving Show
data Water = Squirtle | Wartortle | Blastoise deriving Show
data Grass = Bulbasaur | Ivysaur | Venusaur deriving Show

data FireMove = Ember | FlameThrower | FireBlast deriving Show
data WaterMove = Bubble | WaterGun deriving Show
data GrassMove = VineWhip deriving Show

class (Show pokemon, Show move) => Pokemon pokemon move where
  pickMove :: pokemon -> move

instance Pokemon Fire FireMove where
  pickMove Charmander = Ember
  pickMove Charmeleon = FlameThrower
  pickMove Charizard = FireBlast

instance Pokemon Water WaterMove where
  pickMove Squirtle = Bubble
  pickMove _ = WaterGun

instance Pokemon Grass GrassMove where
  pickMove _ = VineWhip

printBattle :: String -> String -> String -> String -> String -> IO ()
printBattle pokemonOne moveOne pokemonTwo moveTwo winner = do
  putStrLn $ pokemonOne ++ " used " ++ moveOne
  putStrLn $ pokemonTwo ++ " used " ++ moveTwo
  putStrLn $ "Winner is: " ++ winner ++ "\n"

-- 显示我们的战斗类型类，恶星
class (Pokemon pokemon move, Pokemon foe foeMove)
  => Battle pokemon move foe foeMove where
  battle :: pokemon -> foe -> IO (move, foeMove)
  battle pokemon foe = do
    printBattle (show pokemon) (show move) (show foe) (show foeMove) (show pokemon)
    return (move, foeMove)
   where
    foeMove = pickMove foe
    move = pickMove pokemon
  
instance Battle Water WaterMove Fire FireMove
instance Battle Fire FireMove Water WaterMove where
  battle a b = fmap swap $ flip battle a b

instance Battle Grass GrassMove Water WaterMove
instance Battle Water WaterMove Grass GrassMove where
  battle a b = fmap swap $ flip battle a b
  
instance Battle Fire FireMove Grass GrassMove
instance Battle Grass GrassMove Fire FireMove where
  battle a b = fmap swap $ flip battle a b

main :: IO ()
main = do
  battle Squirtle Charmander :: IO (WaterMove, FireMove)
  battle Charmeleon Wartortle :: IO (FireMove, WaterMove)
  battle Bulbasaur Blastoise :: IO (GrassMove, WaterMove)
  battle Wartortle Ivysaur :: IO (WaterMove, GrassMove)
  battle Charmeleon Ivysaur :: IO (FireMove, GrassMove)
  battle Venusaur Charizard :: IO (GrassMove, FireMove)
  putStrLn "Done Fighting"

最后，引入类型家族！

所以，到目前为止，我们的程序有点糟糕。我们必须携带所有这些类型签名，甚至不得不改变一个函数（战斗）内部行为以便我们能够使用类型签名去帮助编译器。我可以说，当前这版程序尽管更加形式、更少重复，在引入所有新的恶星代码之后并没有太大改进。

但我们可以追回到宝可梦类型类定义时的恶星之处。它拥有宝可梦的类型以及动作类型作为两个独立的类变量：类型检查器不知道在宝可梦类型和动作类型间它可利用的关系。它甚至可以允许我们定义水属性的宝可梦执行火属性动作！这并不对，但你可以这么做。回去尝试创建一个 Pokemon Fire WaterMove 实例。

这就是类型家族发挥作用的地：它们让我们告诉类型检查器火属性的宝可梦需要和火属性动作在一起，等。

使用类型家族的宝可梦类型类

为了使用类型家族，我们需要开启 TypeFamilies 扩展。这样做之后，我们的宝可梦类型类看起来如下：

1
2
3
class (Show a, Show (Move a)) => Pokemon a where
  data Move a :: *
  pickMove :: a -> Move a

我们定义宝可梦类型类拥有一个参数和一个关联的 Move 类型。Move 成为了一个“类型函数”，返回要用到动作的类型。这意味着我们将有 Move Fire 而不是 FireMove、Move Water 而不是 WaterMove，等等。

注意，类型约束看起来和前一个相似，只是我们使用 Show (Move a)) 来代替 Show move。我们需要开启另一个扩展来实现：FlexibleContexts.

之后，Haskell 提供了很妙的语法糖，这样我们就可以在定义实例时定义实际关联数据类型的构造函数。

让我们重新定义所有的这些数据类型、我们的宝可梦类型类，以及所有需要使用类型家族的实例：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
class (Show pokemon, Show (Move pokemon)) => Pokemon pokemon where
  data Move pokemon :: *
  pickMove :: pokemon -> Move pokemon

data Fire = Charmander | Charmeleon | Charizard deriving Show
instance Pokemon Fire where
  data Move Fire = Ember | FlameThrower | FireBlast deriving Show
  pickMove Charmander = Ember
  pickMove Charmeleon = FlameThrower
  pickMove Charizard = FireBlast

data Water = Squirtle | Wartortle | Blastoise deriving Show
instance Pokemon Water where
  data Move Water = Bubble | WaterGun deriving Show
  pickMove Squirtle = Bubble
  pickMove _ = WaterGun

data Grass = Bulbasaur | Ivysaur | Venusaur deriving Show
instance Pokemon Grass where
  data Move Grass = VineWhip deriving Show
  pickMove _ = VineWhip

main :: IO ()
main = do
  print $ pickMove Squirtle
  print $ pickMove Charmander
  print $ pickMove Ivysaur

炒鸡整洁，对吧？我们不需要为 pickMove 添加类型签名了！先不要着急向上滚动：等待第三版程序完善之后，再与第二版比较以获得完整的效果。

船新的战斗类型类

因此，现在我们不需要那些冗长的类型签名，可以回到引入恶星黑科技前，回到 battle 的上一个版本，它只返回 IO ()。

1
2
3
4
5
6
7
class (Pokemon pokemon, Pokemon foe) => Battle pokemon foe where
  battle :: pokemon -> foe -> IO ()
  battle pokemon foe = do
    printBattle (show pokemon) (show move) (show foe) (show foeMove) (show pokemon)
   where
    foeMove = pickMove foe
    move = pickMove pokemon

此外，注意战斗不再需要知道动作了，它又回到了在我们第一版中的萌新实现那样。

让我再一次定义所有剩余的战斗实例，并给你第三次版的完整程序：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}
class (Show pokemon, Show (Move pokemon)) => Pokemon pokemon where
  data Move pokemon :: *
  pickMove :: pokemon -> Move pokemon

data Fire = Charmander | Charmeleon | Charizard deriving Show
instance Pokemon Fire where
  data Move Fire = Ember | FlameThrower | FireBlast deriving Show
  pickMove Charmander = Ember
  pickMove Charmeleon = FlameThrower
  pickMove Charizard = FireBlast

data Water = Squirtle | Wartortle | Blastoise deriving Show
instance Pokemon Water where
  data Move Water = Bubble | WaterGun deriving Show
  pickMove Squirtle = Bubble
  pickMove _ = WaterGun

data Grass = Bulbasaur | Ivysaur | Venusaur deriving Show
instance Pokemon Grass where
  data Move Grass = VineWhip deriving Show
  pickMove _ = VineWhip

printBattle :: String -> String -> String -> String -> String -> IO ()
printBattle pokemonOne moveOne pokemonTwo moveTwo winner = do
  putStrLn $ pokemonOne ++ " used " ++ moveOne
  putStrLn $ pokemonTwo ++ " used " ++ moveTwo
  putStrLn $ "Winner is: " ++ winner ++ "\n"

class (Pokemon pokemon, Pokemon foe) => Battle pokemon foe where
  battle :: pokemon -> foe -> IO ()
  battle pokemon foe = do
    printBattle (show pokemon) (show move) (show foe) (show foeMove) (show pokemon)
   where
    foeMove = pickMove foe
    move = pickMove pokemon

instance Battle Water Fire
instance Battle Fire Water where
  battle = flip battle

instance Battle Grass Water
instance Battle Water Grass where
  battle = flip battle

instance Battle Fire Grass
instance Battle Grass Fire where
  battle = flip battle
    
main :: IO ()
main = do
  battle Squirtle Charmander
  battle Charmeleon Wartortle
  battle Bulbasaur Blastoise
  battle Wartortle Ivysaur
  battle Charmeleon Ivysaur
  battle Venusaur Charizard

就这样。我们的程序最终看起来很不错，我们已经改进到现在的程度，引入更多的类型检查，更少的重复，并且有一个整洁的 API 提供给其他开发人员。

酷！我们完成了！希望你喜欢！

好吧，我明白了，你现在很开心，你不能相信这么快就结束了，而且你已经看了你的浏览器的滚动条，它仍然显示下面还有更多的页面可以看。

所以，让我们给宝可梦世界添加一个新特性：

现在我们将水属性和火属性的战斗实力定义为 Battle Water Fire，之后我们定义 Battle Water Fire 是同样一个战斗，只是与前一个相比参数翻转了。第一个传给 battle 的宝可梦一定是赢者，输出总是如下的：

1
2
3
-- Winner Pokemon move
-- Loser Pokemon move
-- Winner pokemon Wins.

尽管在实例中输者是第一个参数，第一行的输出总是赢者的攻击。

但让我们改变这一点，让战斗实例能够决定谁是这场比赛的赢者，以便在某些情况下战斗的最终结果是：

1
2
3
-- Loser Pokemon move
-- Winner Pokemon move
-- Winner pokemon Wins

关联类型别名

当决定返回两种值的任意一种时，你通常会返回一个Either a b，但这是在运行期。我们希望类型检查器能够保证水与火的战斗中水总是赢者。

所以我们在 Battle 中定义了新的函数 winner，以同样顺序接收传给 battle 函数的两个竞争对手，并决定谁是赢者。

不管返回哪个输入的宝可梦，都会让 winner 函数变复杂，你可以自己看一下：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
class (Pokemon pokemon, Pokemon foe) => Battle pokemon foe where
  battle :: pokemon -> foe -> IO ()
  battle pokemon foe = do
    printBattle (show pokemon) (show move) (show foe) (show foeMove) (show pokemon)
   where
    foeMove = pickMove foe
    move = pickMove pokemon
  
  winner :: pokemon -> foe -> ??? -- 是 `pokemon` 还是 `foe`？
  
instance Battle Water Fire where
  winner :: Water -> Fire -> Water -- 水是类型类的第一个类型变量，应该是 `pokemon`
  winner water _ = water

instance Battle Fire Water
  winner :: Fire -> Water -> Water -- 水是类型类的第二个类型变量，应该是 `foe`
  winner _ water = water

看，对于 Battle Water Fire 实例，winner 的返回类型会和类型类中的 pokemon 类型变量相同，而对于 Battle Fire Water 返回类型则是 foe。

幸运的是，类型家族还包括关联类型同义词的支持：在战斗类型类中我们定义一个 Winner pokemon foo 关联类型，让实例去决定使用的类型。

我们使用了关键字 type 而不是 data，因为它将是 pokemon 或者 foe 的类型别名。

Winner 本身是一个 kind 为 * -> * -> * 的类型函数，同时接收 pokemon 和 foo，并返回将使用的那个。

我们还定义了 Winner 的默认实现，给定 pokemon 和 foo 时它会选择 pokemon。

1
2
3
4
5
6
7
8
9
10
11
12
13
class (Show (Winner pokemon foe), Pokemon pokemon, Pokemon foe) => Battle pokemon foe where
  type Winner pokemon foe :: * -- 这是个关联类型
  type Winner pokemon foe = pokemon -- 这是它的默认实现

  battle :: pokemon -> foe -> IO ()
  battle pokemon foe = do
    printBattle (show pokemon) (show move) (show foe) (show foeMove) (show winner)
   where
    foeMove = pickMove foe
    move = pickMove pokemon
    winner = pickWinner pokemon foe
  
  pickWinner :: pokemon -> foe -> (Winner pokemon foe)

这就是宝可梦的最终程序了，有时敌人会赢得战斗：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}
class (Show pokemon, Show (Move pokemon)) => Pokemon pokemon where
  data Move pokemon :: *
  pickMove :: pokemon -> Move pokemon

data Fire = Charmander | Charmeleon | Charizard deriving Show
instance Pokemon Fire where
  data Move Fire = Ember | FlameThrower | FireBlast deriving Show
  pickMove Charmander = Ember
  pickMove Charmeleon = FlameThrower
  pickMove Charizard = FireBlast

data Water = Squirtle | Wartortle | Blastoise deriving Show
instance Pokemon Water where
  data Move Water = Bubble | WaterGun deriving Show
  pickMove Squirtle = Bubble
  pickMove _ = WaterGun

data Grass = Bulbasaur | Ivysaur | Venusaur deriving Show
instance Pokemon Grass where
  data Move Grass = VineWhip deriving Show
  pickMove _ = VineWhip

printBattle :: String -> String -> String -> String -> String -> IO ()
printBattle pokemonOne moveOne pokemonTwo moveTwo winner = do
  putStrLn $ pokemonOne ++ " used " ++ moveOne
  putStrLn $ pokemonTwo ++ " used " ++ moveTwo
  putStrLn $ "Winner is: " ++ winner ++ "\n"

class (Show (Winner pokemon foe), Pokemon pokemon, Pokemon foe) => Battle pokemon foe where
  type Winner pokemon foe :: *
  type Winner pokemon foe = pokemon

  battle :: pokemon -> foe -> IO ()
  battle pokemon foe = do
    printBattle (show pokemon) (show move) (show foe) (show foeMove) (show winner)
   where
    foeMove = pickMove foe
    move = pickMove pokemon
    winner = pickWinner pokemon foe
  
  pickWinner :: pokemon -> foe -> (Winner pokemon foe)

instance Battle Water Fire where
  pickWinner pokemon foe = pokemon

instance Battle Fire Water where
  type Winner Fire Water = Water
  pickWinner = flip pickWinner

instance Battle Grass Water where
  pickWinner pokemon foe = pokemon

instance Battle Water Grass where
  type Winner Water Grass = Grass
  pickWinner = flip pickWinner

instance Battle Fire Grass where
  pickWinner pokemon foe = pokemon

instance Battle Grass Fire where
  type Winner Grass Fire = Fire
  pickWinner = flip pickWinner
    
main :: IO ()
main = do
  battle Squirtle Charmander
  battle Charmeleon Wartortle
  battle Bulbasaur Blastoise
  battle Wartortle Ivysaur
  battle Charmeleon Ivysaur
  battle Venusaur Charizard

就这样！尝试在上面的代码片段末尾加上你的电属性宝可梦！