关于通过几个嵌套函数级别的映射

问题描述

随机示例：给定以下 [Maybe [a]]，

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

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

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

最简单的方法似乎是

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

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

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

解决方法

您可以使用 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,Just [81]]))
Compose (Compose [Just [1,16,81],Just [6561]])

因此我们可以打开它：

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

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

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

{-# 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],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）并不是很可怕。

这个答案的灵感来自 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)

既然我们已经解决了完全无聊的部分，剩下的就变得非常简单了。

-- @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 并且第二个参数是一个应用程序并且第三个参数是一个应用程序，它只会选择第二个实例和在第二个和第三个参数中应用的构造函数是相同的。

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

-- 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,DFold n x a) => DFold ('S n) tx a where
  dfoldMap' = foldMap . dfoldMap' @ n

functional-programming functor haskell haskell idioms nested