使用recursion-schemes为通用的多态代数数据类型创建Haskell - Functor实例

4

问题:

最近我在这里提出了以下问题,询问如何创建一个通用的映射函数,并为任意多态ADT(代数数据类型)创建一个通用的Functor实例,例如Lists、Trees等:

Functor instance for generic polymorphic ADTs in Haskell?

现在,我正在尝试重新制定上述内容,以便与recursion-schemes兼容。也就是说,我想要在一方面定义类型,在另一方面定义基本的functor,并使用Base家族类型将它们相关联。

因此,不再执行以下操作:

data ListF a b = NilF | ConsF a b
newtype Fix f = Fix { unFix :: f (Fix f) }
type List a = Fix (ListF a)

我想要做到这个:

data ListF a b = NilF | ConsF a b
data List a = Nil | Cons a (List a)
type instance Base (List a) = ListF a

这样,我就可以利用递归方案(recursion-schemes)库的强大功能,同时仍然能够为这些多态类型定义一个通用的fmap。不仅如此,使用“正常”的类型而不是类型同义词对于体验来说更加愉悦。

尝试:

一开始,我考虑在一方面上实现Bifunctor实例,然后以某种方式强制或使它等于相应的Base族实例。目前,我只能想到使用Data.Type.Equality中的a:~:b。以下是我的工作进展:
{-# LANGUAGE TypeOperators, Rank2Types #-}
import Data.Bifunctor
import Data.Functor.Foldable
import Data.Type.Equality

gmap :: (Bifunctor p, Foldable (f a), Unfoldable (f b)) => 
        (forall x. p x :~: Base (f x)) -> (a -> b) -> f a -> f b
gmap refl f = cata alg
    where
        alg = embed . 
              castWith (apply refl Refl) . 
              bimap f id . 
              castWith (apply (sym refl) Refl)

我的问题在于尝试定义一个Functor实例。我不知道如何在定义实例时指定这些特定的类型约束。

我考虑过创建一个Equals类型类,并进行以下操作:

instance (Bifunctor p, Foldable (f a), Unfoldable (f b), Equals (p a) (Base (f a))) 
    => Functor f where

但我不知道是否可行,也不确定我的方法是否正确(例如,我不确定我对gmap的定义是否正确)。


供参考,这是原始SO问题中通用gmap的定义:

gmap :: (Bifunctor f) => (a -> b) -> Fix (f a) -> Fix (f b)
gmap f = unwrapFixBifunctor . cata alg . wrapFixBifunctor
  where
    alg = Fix . bimap f id

    unwrapFixBifunctor :: (Bifunctor f) => Fix (WrappedBifunctor f a) -> Fix (f a)
    unwrapFixBifunctor = Fix . unwrapBifunctor . fmap unwrapFixBifunctor . unFix

    wrapFixBifunctor :: (Bifunctor f) => Fix (f a) -> Fix (WrappedBifunctor f a)
    wrapFixBifunctor = Fix . fmap wrapFixBifunctor . WrapBifunctor . unFix

更新:

注意到以下gmap的定义更加通用,不需要任何奇怪的类型级别等式应用:

gmap :: (Foldable t, Unfoldable d, Bifunctor p, Base d ~ p b, Base t ~ p a)
        => (a -> b) -> t -> d
gmap f = cata ( embed . bimap f id )

然而,我仍然无法找到一种创建具有类似类型约束的Functor实例的方法。

  1. :~: 的作用是什么?如果您必须一直使用 Refl 调用函数,那么它可能不实用。
  2. 如果我写 gmap f = cata ( embed . bimap f id ) 并让编译器推断类型,我得到 (Foldable t, Unfoldable d, Bifunctor p, Base d ~ p b, Base t ~ p a) => (a -> b) -> t -> d。这个最通用的类型有什么问题吗?如果您愿意,可以使用更具体的类型。编译器对您的函数非常满意,所以我不知道实际问题是什么。
- user2407038
@user2405038 我想使用 fmap = gmap 创建一个 Functor 实例。 - gonzaw
1个回答

1

在@kosmikus的帮助下, 我成功地拼凑出了一个版本,只要你接受UndecidableInstances

这个想法是通过要求forall x. Foldable (f x)等来移除gmap上下文中所有对ab的引用,并使用constraints包进行编码:

{-# LANGUAGE TypeFamilies, ScopedTypeVariables, TypeOperators, ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
import Data.Bifunctor
import Data.Functor.Foldable
import Data.Constraint
import Data.Constraint.Forall

-- https://dev59.com/aYfca4cB1Zd3GeqPeRvD#28067872
class (p x ~ Base (f x)) => Based p f x
instance (p x ~ Base (f x)) => Based p f x

gmap :: forall p f a b. ( Bifunctor p 
                        , ForallF Foldable f
                        , ForallF Unfoldable f
                        , Forall (Based p f))
     => (a -> b) -> f a -> f b
gmap f = case (instF :: ForallF Foldable f :- Foldable (f a)) of
  Sub Dict -> case (instF :: ForallF Unfoldable f :- Unfoldable (f b)) of
    Sub Dict -> case (inst :: Forall (Based p f) :- Based p f a) of
      Sub Dict -> case (inst :: Forall (Based p f) :- Based p f b) of
        Sub Dict -> cata (embed . bimap f id)

有了ab,我们可以将gmap转换为fmap

{-# LANGUAGE UndecidableInstances #-}
instance (Bifunctor p, ForallF Foldable f, ForallF Unfoldable f, Forall (Based p f)) => Functor f where
    fmap = gmap

编辑补充:上面示例的问题是它将匹配右侧任何类型,正如@gonzaw所指出的那样:如果你有

data ListT a = NilT
             | ConsT a (ListT a)

data ListF a b = NilF
               | ConsF a b

type instance Base (ListT a) = ListF a

instance Bifunctor ListF where ...
instance Functor (ListF a) where ...
instance Foldable (ListT a) where ...
instance Unfoldable (ListT a) where ...

如果你没有仔细考虑,可能会得到更多的东西,泛型的 Functor 实例和一个 ListF a 的实例重叠了。

你可以添加一层新类型包装来解决这个问题:如果你有

newtype F f x = F{ unF ::  (f x) }

instance (Bifunctor p, ForallF Foldable f, ForallF Unfoldable f, Forall (Based p f)) => Functor (F f) where
    fmap f = F . gmap f . unF

type ListT' = F ListT

然后最终进行以下类型检查:
*Main> unF . fmap (+1) . F $ ConsT 1 $ ConsT 2 NilT
ConsT 2 (ConsT 3 NilT)

无论这种额外的 newtype 包装对你是否可接受,这是你需要决定的事情。

太棒了!只有一个小问题。我正在尝试使用典型的List类型进行测试,如下所示:data ListT a = ConsT a (ListT a) | NilTdata ListF a b = NilF | ConsF a btype instance Base (ListT a) = ListF a。我创建了一个Bifunctor实例,当我尝试创建一个instance Foldable (ListT a) where实例时,我会得到以下错误:Couldn't match type ‘Base (ListF a Data.Constraint.Forall.A)’ with ‘p1 Data.Constraint.Forall.A’ The type variable p1 is ambiguousUnfoldable也是一样。 - gonzaw
这是因为那个可怕的Functor实例不仅匹配ListT,还匹配ListF... - Cactus
太好了,现在它可以工作了!我不介意使用newtype包装。根据我的阅读,使用newtype包装是一种最佳实践,用于创建这些“奇特”的常见类型类(Applicative、Functor、Monad)的自动实例,以避免孤立实例等问题。当使用ListT时,我总是可以仅使用gmap,但如果我需要使用Functor的功能,我只需快速地进行包装和解包即可。如果这让我很烦恼,我会快速包含一个instance Functor ListT where fmap f = unF . fmap f. F,然后就完成了。 - gonzaw
事实上,我在想是否可以使用模板Haskell来包含那个小的Functor ListT实例。无论类型如何,该定义都将是相同的。如果我有另一个类型,比如TreeT,它仍然是fmap f = unF . fmap f . F,对吗?如果是这样,我想我可以尝试一下! - gonzaw
抱歉三次发布,但这是否是应该包含在递归方案库中的好功能? - gonzaw
当然,如果您可以添加手写的instance Functor ListT实例,那么您也可以在其中设置fmap = gmap,从而减轻对于这个通用实例和F新类型包装器的需求。 - Cactus

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接