关于通过多个嵌套功能级别进行映射

Question

一个随机的例子：给定以下[Maybe [a]]，

x = [Just [1..3], Nothing, Just [9]]

我想通过3层映射f = (^2)，从而得到

[Just [1,4,9],Nothing,Just [81]]

似乎最简单的方法是

(fmap . fmap . fmap) (^2) x

fmap . fmap . fmap 类似于 fmap，但它的深度为 3 级。

我怀疑需要这样的东西，在一般情况下，将fmap 与自身组合给定次数，并不少见，所以我想知道标准中是否已经有一些东西可以自己组合fmap 一定次数。或者可能是“知道”它应该根据输入与自身组合 fmap 多少次的东西。

Answer 1

您可以使用Compose type 来深入两个（或更多，如果您级联）函子级别。

所以我们可以这样实现：

import Data.Functor.Compose(Compose(Compose, getCompose))

fmap (^2) (Compose (Compose [Just [1,4,9],Nothing,Just [81]]))

然后产生：

Prelude Data.Functor.Compose> fmap (^2) (Compose (Compose [Just [1,4,9],Nothing,Just [81]]))
Compose (Compose [Just [1,16,81],Nothing,Just [6561]])

因此我们可以用以下方法解开它：

Prelude Data.Functor.Compose> (getCompose . getCompose . fmap (^2)) (Compose (Compose [Just [1,4,9],Nothing,Just [81]]))
[Just [1,16,81],Nothing,Just [6561]]

通过构造一个具有两个Functors 深的结构Compose，我们因此使其成为结合两者的Functor 的实例。

Answer 2

如果您想超级对此进行过度设计，您可以使用数据种类和类型系列。这有点疯狂，但请考虑以下类型系列：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

type family DT fs x where
  DT '[] x = x
  DT (f ': fs) x = f (DT fs x)

给定一个类型级别的函子列表（嗯，更一般地说，类型函数* -> *），这将在列表的每个值中包含一个类型。有了这个，我们可以写一个疯狂的类型类：

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

class DMap (fs :: [* -> *]) where
  dmap' :: (a -> b) -> DT fs a -> DT fs b

函数dmap' 接受一个函数来应用（很像fmap），然后将这个包装好的a 转换成一个包装好的b。这种情况的实例（有点）自然地遵循，将fmap 与自身组合的想法与列表中的函子一样多次：

instance DMap '[] where
  dmap' = id

instance (DMap fs, Functor f) => DMap (f ': fs) where
  dmap' = fmap . dmap' @fs

有了这个，我们可以写如下：

{-# LANGUAGE TypeApplications #-}

x = [Just [1..3], Nothing, Just [9]]
x' = dmap' @'[[], Maybe, []] (^2) x

哇哦！嗯，这很好，但是写出函子列表是一件很痛苦的事情，GHC 不应该能够为我们做到这一点吗？我们可以通过引入另一个类型族来添加它：

{-# LANGUAGE TypeOperators #-}

import GHC.TypeLits (Nat, type (-))

type family FType n a where
  FType 0 a = '[]
  FType n (f a) = f ': FType (n-1) a

这个类型族从一个已经被包装的类型产生一个类型级别的函子列表（使用Nat 来限制我们比我们想要的更深）。然后我们可以编写一个正确的dmap 使用FType 来解决函子列表是什么：

dmap :: forall n (fs :: [* -> *]) a b c d. (fs ~ FType n c, fs ~ FType n d, DMap fs, DT fs a ~ c, DT fs b ~ d) => (a -> b) -> c -> d
dmap = dmap' @fs

类型签名有点复杂，但基本上它告诉 GHC 使用 c 值来确定函子是什么。在实践中，这意味着我们可以这样写：

x' = dmap @3 (^2) x

（注意，我可能在这里或那里遗漏了一两个语言扩展名。）

---

为了记录，我不知道我是否曾经使用过这样的东西。至少可以说，错误消息不是很好，对于高级 Haskeller 来说，看到fmap . fmap（甚至是fmap . fmap . fmap）并不是很可怕。

Answer 3

这个答案的灵感来自 DDub，但我认为它更简单，它应该提供更好的类型推断和可能更好的类型错误。让我们先清清嗓子：

{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language DataKinds #-}
{-# language AllowAmbiguousTypes #-}
{-# language UndecidableInstances #-}
{-# language ScopedTypeVariables #-}
module DMap where
import Data.Kind (Type)
import GHC.TypeNats

GHC 的内置 Nats 很难使用，因为我们无法在“非 0”上进行模式匹配。所以让我们让它们只是接口的一部分，并在实现中避免它们。

-- Real unary naturals
data UNat = Z | S UNat

-- Convert 'Nat' to 'UNat' in the obvious way.
type family ToUnary (n :: Nat) where
  ToUnary 0 = 'Z
  ToUnary n = 'S (ToUnary (n - 1))

-- This is just a little wrapper function to deal with the
-- 'Nat'-to-'UNat' business.
dmap :: forall n s t a b. DMap (ToUnary n) s t a b
     => (a -> b) -> s -> t
dmap = dmap' @(ToUnary n)

现在我们已经摆脱了完全无聊的部分，剩下的就很简单了。

-- @n@ indicates how many 'Functor' layers to peel off @s@
-- and @t@ to reach @a@ and @b@, respectively.
class DMap (n :: UNat) s t a b where
  dmap' :: (a -> b) -> s -> t

我们如何编写实例？让我们从显而易见的方式开始，然后将其转换为能够提供更好推理的方式。显而易见的方式：

instance DMap 'Z a b a b where
  dmap' = id

instance (Functor f, DMap n x y a b)
  => DMap ('S n) (f x) (f y) a b where
  dmap' = fmap . dmap' @n

这样写的问题是多参数实例解析的常见问题。只有当 GHC 发现第一个参数是 'Z 并且第二个和第四个参数相同并且第三个​​和第五个参数相同时，GHC 才会选择第一个实例.类似地，如果它看到第一个参数是'S 并且第二个参数是一个应用程序并且第三个​​参数是一个应用程序and第二个和第三个参数中应用的构造函数是一样的。

我们想在知道第一个参数后立即选择正确的实例。我们可以通过简单地将其他所有内容移到双箭头的左侧来做到这一点：

-- This stays the same.
class DMap (n :: UNat) s t a b where
  dmap' :: (a -> b) -> s -> t

instance (s ~ a, t ~ b) => DMap 'Z s t a b where
  dmap' = id

-- Notice how we're allowed to pull @f@, @x@,
-- and @y@ out of thin air here.
instance (Functor f, fx ~ (f x), fy ~ (f y), DMap n x y a b) 
  => DMap ('S n) fx fy a b where
  dmap' = fmap . dmap' @ n

现在，我在上面声称这提供了比 DDub 更好的类型推断，所以我最好支持它。让我拉一下GHCi：

*DMap> :t dmap @3
dmap @3
  :: (Functor f1, Functor f2, Functor f3) =>
     (a -> b) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 b))

这正是fmap.fmap.fmap 的类型。完美的！使用 DDub 的代码，我反而得到了

dmap @3
  :: (DMap (FType 3 c), DT (FType 3 c) a ~ c,
      FType 3 (DT (FType 3 c) b) ~ FType 3 c) =>
     (a -> b) -> c -> DT (FType 3 c) b

这……不太清楚。正如我在评论中提到的，这可以修复，但它会给已经有些复杂的代码增加一点复杂性。

---

只是为了好玩，我们可以用traverse 和foldMap 拉同样的把戏。

dtraverse :: forall n f s t a b. (DTraverse (ToUnary n) s t a b, Applicative f) => (a -> f b) -> s -> f t
dtraverse = dtraverse' @(ToUnary n)

class DTraverse (n :: UNat) s t a b where
  dtraverse' :: Applicative f => (a -> f b) -> s -> f t

instance (s ~ a, t ~ b) => DTraverse 'Z s t a b where
  dtraverse' = id

instance (Traversable t, tx ~ (t x), ty ~ (t y), DTraverse n x y a b) => DTraverse ('S n) tx ty a b where
  dtraverse' = traverse . dtraverse' @ n

dfoldMap :: forall n m s a. (DFold (ToUnary n) s a, Monoid m) => (a -> m) -> s -> m
dfoldMap = dfoldMap' @(ToUnary n)

class DFold (n :: UNat) s a where
  dfoldMap' :: Monoid m => (a -> m) -> s -> m

instance s ~ a => DFold 'Z s a where
  dfoldMap' = id

instance (Foldable t, tx ~ (t x), DFold n x a) => DFold ('S n) tx a where
  dfoldMap' = foldMap . dfoldMap' @ n