自动为更高种类参数的数据生成映射函数

Posted 2023-02-16

【中文标题】自动为更高种类参数的数据生成映射函数

【英文标题】：Automatically generate mapping function for data with higher-kinded parameter

【发布时间】：2018-08-11 14:53:15

【问题描述】：

考虑数据类型

data Foo f = Foo fooInt :: f Int, fooBool :: f Bool

我想要一个函数mapFoo :: (forall a. f a -> g a) -> Foo f -> Foo g。我的选择：

我可以手动编写。这有点烦人，但最重要的反对意见是我希望 Foo 随着时间的推移会获得字段，并且我希望它尽可能地顺畅，因此必须为这个函数添加一个案例很烦人。 我可以编写Haskell 模板。我很确定这并不太难，但我倾向于将 TH 视为最后的手段，所以我希望有更好的东西。 我可以使用泛型吗？我派生了Generic，但是当我尝试实现K1 案例（特别是处理Rec0）时，我不知道该怎么做；我需要它来改变类型。 我错过了第四个选项吗？

如果有一种通用的方式来编写 mapFoo 而无需使用 Template Haskell，我很想知道！谢谢。

【参考方案1】：

The rank2classes packagecan derive this给你。

-# LANGUAGE TemplateHaskell #-

import Rank2.TH (deriveFunctor)

data Foo f = Foo fooInt :: f Int, fooBool :: f Bool

$(deriveFunctor ''Foo)

现在你可以写mapFoo = Rank2.(<$>)了。

【讨论】：

事实证明这在我的实际用例中不起作用，因为rank2classes 不支持多类型参数，但您的回答仍然是我提出的问题的一个很好的答案。跨度>

【参考方案2】：

编辑：哦，我应该明确指出这是一个 manual 方法 - 它是一个指向具有许多有用函数和类型类的包的指针，但 afaik 没有 TH 来生成你想要的东西。欢迎拉取请求，我敢肯定。

parameterized-utils package 提供了一组丰富的高级课程。对于您的需求，有FunctorF：

-- | A parameterized type that is a function on all instances.
class FunctorF m where
  fmapF :: (forall x . f x -> g x) -> m f -> m g

这些实例可能是您所期望的：

-# LANGUAGE RankNTypes #-
import Data.Parameterized.TraversableF

data Foo f = Foo fooInt :: f Int, fooBool :: f Bool

instance FunctorF Foo where
  fmapF op (Foo a b) = Foo (op a) (op b)

【参考方案3】：

如果您仍然不想使用TemplateHaskell，这里是基于GHC.Generics 的实现：

-# LANGUAGE DeriveGeneric #-
-# LANGUAGE FlexibleInstances #-
-# LANGUAGE FlexibleContexts #-
-# LANGUAGE MultiParamTypeClasses #-
-# LANGUAGE RankNTypes #-
-# LANGUAGE TypeOperators #-
-# LANGUAGE UndecidableInstances #-

import GHC.Generics

data Foo f = Foo 
    fooInt :: f Int,
    fooBool :: f Bool,
    fooString :: f String
     deriving (Generic)


class Functor2 p q f where
    fmap2 :: (forall a. p a -> q a) -> f p -> f q

instance (Generic (f p), Generic (f q), GFunctor2 p q (Rep (f p)) (Rep (f q))) => Functor2 p q f where
    fmap2 f = to . (gfmap2 f) . from 

class GFunctor2 p q f g where
    gfmap2 :: (forall a. p a -> q a) -> f x -> g x

instance (GFunctor2 p q a b) => GFunctor2 p q (D1 m1 (C1 m2 a)) (D1 m1 (C1 m2 b)) where
    gfmap2 f (M1 (M1 a)) = M1 (M1 (gfmap2 f a))

instance (GFunctor2 p q a c, GFunctor2 p q b d) => GFunctor2 p q (a :*: b) (c :*: d) where
    gfmap2 f (a :*: b) = gfmap2 f a :*: gfmap2 f b

instance GFunctor2 p q (S1 m1 (Rec0 (p a))) (S1 m1 (Rec0 (q a))) where
   gfmap2 f (M1 (K1 g)) = M1 (K1 (f g))   


-- Tests
foo = Foo (Just 1) (Just True) (Just "foo")

test1 = fmap2 (\(Just a) -> [a]) foo   

test2 = fmap2 (\[a] -> Left "Oops") test1

我不确定是否可以避免 MultiParamTypeClasses 使 class Functor2 与定义的 rank2classes 相同。