如何修复这种嵌套 fmap 仿函数的混乱？

Question

data Color = White | Black deriving (Eq, Show)
data Role = King | Queen | Rook deriving (Eq, Show)

data Piece = Piece { color :: Color, 
                     role  :: Role } deriving (Eq)

data Piese = Piese { piece :: Piece,
                     coord :: Coord } deriving (Eq)

data ColorMap a = ColorMap {
    white :: a,
    black :: a
  } deriving (Eq)

instance Functor ColorMap where
  fmap fn (ColorMap white black) = 
    ColorMap (fn white) (fn black)

colorMapFromList :: (a -> Color) -> [a] -> ColorMap [a]
colorMapFromList fn lst = ColorMap 
    (filter ((== White) . fn) lst)
    (filter ((== Black) . fn) lst)
                  
data RoleMap a = RoleMap {
    king  :: a,
    queen :: a,
    rook  :: a }

instance Functor RoleMap where
  fmap fn (RoleMap king queen rook) = 
    RoleMap (fn king) (fn queen) (fn rook)

roleMapFromList :: (a -> Role) -> [a] -> RoleMap [a]
roleMapFromList fn lst = RoleMap
    (filter ((== King ) . fn) lst)
    (filter ((== Queen) . fn) lst)
    (filter ((== Rook ) . fn) lst)

mapso :: [Piese] -> ColorMap (RoleMap [Coord])
mapso lst = 
 fmap (fmap (fmap coord))                -- ColorMap (RoleMap [Coord])
   (fmap (roleMapFromList (role . piece))  -- ColorMap (RoleMap [Piese])
         (colorMapFromList (color . piece)   -- ColorMap [Piese]
              lst))                            -- [Piese]

我刚刚进入 Haskell，它可以编译，但对我来说似乎很容易出错。这里有一个模式我可以把它简化成吗？特别是mapso 函数。

Answer 1

您可以利用函子组合这一事实。虽然您可以通过使用 Data.Functor.Compose 定义新类型来相当明确地表示这一点，但实际上它只是意味着您可以使用 fmap 自己编写。

mapso :: [Piese] -> ColorMap (RoleMap [Coord])
mapso lst = fmap (fmap (fmap coord))
  (fmap (roleMapFromList (role.piece)) (colorMapFromList (color.piece) lst))

变成

mapso = (fmap . fmap . fmap) coord . 
        fmap (roleMapFromList (role.piece)) .
        colorMapFromList (color.piece)

或进行一些重构：

mapso = let fffmap = fmap . fmap . fmap
            makeColorMap = colorMapFromList (color.piece)
            makeRoleMap = roleMapFromList (role.piece)
        in fffmap coord . 
           fmap makeRoleMap .
           makeColorMap

我已切换到无点形式来突出三个阶段：

1. 创建ColorMap
2. 创建RoleMap
3. 将 coord 映射到包裹在 RoleMap 内的 [Piese] 值上，包裹在 ColorMap 内。

我们使用函数组合来减少mapso定义中显式嵌套的数量。

如果您还不习惯考虑函数组合，您可以在let 表达式中定义更多临时变量：

mapso lst = let fffmap = fmap . fmap . fmap
                makeColorMap = colorMapFromList (color.piece)
                makeRoleMap = fmap (roleMapFromList (role.piece))
            in let colorMap = makeColorMap lst
                   rolemap = makeRoleMap colorMap
            in fffmap coord roleMap

（我们需要两个let 表达式吗？不需要。但将辅助函数与辅助函数计算的值分开可能会有所帮助。）

Answer 2

一种选择是使您的地图Monoid 实例。所以：

instance Semigroup a => Semigroup (RoleMap a) where
    RoleMap ks qs rs <> RoleMap ks' qs' rs' = 
        RoleMap (ks <> ks') (qs <> qs') (rs <> rs')
instance Monoid a => Monoid (RoleMap a) where 
    mempty = RoleMap mempty mempty mempty

instance Semigroup a => Semigroup (ColorMap a) where
    ColorMap ws bs <> ColorMap ws' bs' = 
        ColorMap (ws <> ws') (bs <> bs')
instance Monoid a => Monoid (ColorMap a) where 
    mempty = ColorMap mempty mempty

现在，提供一个创建单例映射的函数，而不是过滤。

singletonRole :: Monoid a => Role -> a -> RoleMap a
singletonRole r a = case r of
    King  -> mempty { king  = a }
    Queen -> mempty { queen = a }
    Rook  -> mempty { rook  = a }

singletonColor :: Monoid a => Color -> a -> ColorMap a
singletonColor c a = case c of
    White -> mempty { white = a }
    Black -> mempty { black = a }

使用这些，很容易编写一个使用单个 Piese 的函数：

singletonFromPiese :: Piese -> ColorMap (RoleMap [Coord])
singletonFromPiese (Piese p c) = 
    singletonColor (color p) . 
        singletonRole (role p) $ [c]

消耗大量Pieses 只是foldMap：

mapso :: [Piese] -> ColorMap (RoleMap [Coord])
mapso = foldMap singletonFromPiese

这种方法的一个优点是，对我来说，每一段代码看起来都很明显，不需要心理类型推断。嵌套的fmaps——即使我们认为它们是组合类型上的单个fmap——至少对我来说没有那个属性。

另一个很好的特性是我们只遍历列表一次；在fmap 版本的明显实现中，我们对创建RoleMap 的三个过滤器进行三遍，对创建ColorMap 的两个过滤器进行两遍，总共五遍。