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

Question

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

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

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

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

最简单的方法似乎是

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

fmap. fmap. fmap fmap. fmap. fmap fmap. fmap. fmap类似于fmap ，但它有 3 层深。

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

Answer 1

您可以将Compose类型用于 go 两个（或更多，如果您级联）级别的函子深度。

所以我们可以将其实现为：

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

通过构造一个具有两个Functor深度的结构的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)

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

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

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

function dmap'需要一个 function 来应用（很像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

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

---

为了记录，我不知道我是否曾经使用过这样的东西。 至少可以说，错误消息不是很好，对于高级 Haskellers，看到fmap. fmap 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 的内置Nat很难使用，因为我们不能在“非 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)

现在我们已经摆脱了完全无聊的部分，rest 变得非常简单。

-- @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并且第二个和第四个 arguments 相同并且第三个和第五个 arguments 相同时，GHC 才会选择第一个实例。 类似地，如果它看到第一个参数是'S ，第二个参数是一个应用程序，第三个参数是一个应用程序，并且第二个和第三个arguments中应用的构造函数相同，它只会选择第二个实例。

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

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