带有GHC.Generics或Data.Data的类型族

这是一个与我的模块相关的问题，简化了一点。这也和上一个问题有关，在这个问题中，我把问题简化了，没有得到我想要的答案。我希望这不是太具体，如果你能想一个更好的，请更改标题

背景 我的模块使用并发chan，分为读端和写端。我使用一个带有关联类型同义词的特殊类来支持多态通道“连接”：

上面的代码允许我们做这种事情：

example = do
    (mb ,        msgsA) <- newJoinedChan
    ((mb1, mb2), msgsB) <- newJoinedChan
    --say that: msgsA, msgsB :: Messages (Int,Int)
    --and:      mb :: Mailbox (Int,Int)
    --          mb1,mb2 :: Mailbox Int

这将允许我们在

msgsA

或

msgsB

上运行

行为（Int，Int）

，在第二种情况下，它接收的元组中的

Int

实际上都是通过单独的

邮箱来的

这对于暴露的
spawn
函数中的用户来说都是绑定在一起的

spawn :: (Sources s) => Behavior (Joined s) -> IO s

…它调用
newJoinedChan
和
runBehaviorOn
，并返回输入
源

我想做什么
我希望用户能够创建任意产品类型（不仅仅是元组）的
行为
，例如，我们可以在上面的示例
消息
上运行
行为（Pair Int Int）
。我想用
GHC.Generics
实现这一点，但仍然有多态
源代码，但无法使其工作

spawn :: (Sources s, Generic (Joined s), Rep (Joined s) ~ ??) => Behavior (Joined s) -> IO s

上述示例中实际在API中公开的部分是
newJoinedChan
操作的
fst
和
行为
s，因此可接受的解决方案可以修改
runBehaviorOn
中的一个或全部，或者
newJoinedChan
的
snd

我还将扩展上面的API以支持sum（尚未实现），比如
行为（a或b）
，所以我希望GHC.Generics对我有用

问题
是否有一种方法可以扩展上述API以支持任意
通用a=>行为a

如果不使用GHC的泛型，是否有其他方法可以以最小的最终用户痛苦获得我想要的API（即，他们只需在其类型中添加派生子句）？e、 g.使用
数据。数据

也许是这样的

{-# LANGUAGE TypeFamilies, DeriveGeneric, DefaultSignatures, TypeOperators, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

import Control.Arrow
import GHC.Generics

class Sources s where
    type Joined s
    newJoinedChan :: IO (s, Messages (Joined s)) -- NOT EXPORTED
    default newJoinedChan :: (Generic s, SourcesG (Rep s)) => IO (s, Messages (JoinedG (Rep s)))
    newJoinedChan = fmap (first to) newJoinedChanG

class SourcesG g where
    type JoinedG g
    newJoinedChanG :: IO (g a, Messages (JoinedG g))

--output and input sides of channel:
data Messages a  -- NOT EXPORTED
data Mailbox a

instance Sources (Mailbox a) where
    type Joined (Mailbox a) = a
    newJoinedChan = undefined

instance (Sources a, Sources b)=> Sources (a,b) where
    type Joined (a,b) = (Joined a, Joined b)
    newJoinedChan = undefined

instance (SourcesG a, SourcesG b) => SourcesG (a :*: b) where
    type JoinedG (a :*: b) = (JoinedG a, JoinedG b)
    newJoinedChanG = undefined

instance (SourcesG a, Datatype c) => SourcesG (M1 D c a) where
    type JoinedG (M1 D c a) = JoinedG a
    newJoinedChanG = fmap (first M1) newJoinedChanG

instance (SourcesG a, Constructor c) => SourcesG (M1 C c a) where
    type JoinedG (M1 C c a) = JoinedG a
    newJoinedChanG = fmap (first M1) newJoinedChanG

instance (SourcesG a, Selector c) => SourcesG (M1 S c a) where
    type JoinedG (M1 S c a) = JoinedG a
    newJoinedChanG = fmap (first M1) newJoinedChanG

instance Sources s => SourcesG (K1 i s) where
    type JoinedG (K1 i s) = Joined s
    newJoinedChanG = fmap (first K1) newJoinedChan

newtype Behavior a = Behavior (a -> IO (Behavior a))

runBehaviorOn :: Behavior a -> Messages a -> IO ()
runBehaviorOn = undefined

spawn :: (Sources s) => Behavior (Joined s) -> IO s
spawn = undefined

data Pair a b = Pair a b deriving (Generic)

instance (Sources a, Sources b) => Sources (Pair a b) where
    type Joined (Pair a b) = JoinedG (Rep (Pair a b))

使用
GHC.Generics
可以实现这一点。如果没有其他人先动手，我可能会在本周晚些时候编写一个示例。@NathanHowell补充说，如果你有时间找出一个解决方案，我会给你一点奖励solution@NathanHowell：Weeeell？：）“我一直很忙，对不起，我会看看我能做些什么，但今天不能做了。”@JanusTroelsen别管那个人；）
spawn :: (Sources s, Generic (Joined s), Rep (Joined s) ~ ??) => Behavior (Joined s) -> IO s

{-# LANGUAGE TypeFamilies, DeriveGeneric, DefaultSignatures, TypeOperators, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

import Control.Arrow
import GHC.Generics

class Sources s where
    type Joined s
    newJoinedChan :: IO (s, Messages (Joined s)) -- NOT EXPORTED
    default newJoinedChan :: (Generic s, SourcesG (Rep s)) => IO (s, Messages (JoinedG (Rep s)))
    newJoinedChan = fmap (first to) newJoinedChanG

class SourcesG g where
    type JoinedG g
    newJoinedChanG :: IO (g a, Messages (JoinedG g))

--output and input sides of channel:
data Messages a  -- NOT EXPORTED
data Mailbox a

instance Sources (Mailbox a) where
    type Joined (Mailbox a) = a
    newJoinedChan = undefined

instance (Sources a, Sources b)=> Sources (a,b) where
    type Joined (a,b) = (Joined a, Joined b)
    newJoinedChan = undefined

instance (SourcesG a, SourcesG b) => SourcesG (a :*: b) where
    type JoinedG (a :*: b) = (JoinedG a, JoinedG b)
    newJoinedChanG = undefined

instance (SourcesG a, Datatype c) => SourcesG (M1 D c a) where
    type JoinedG (M1 D c a) = JoinedG a
    newJoinedChanG = fmap (first M1) newJoinedChanG

instance (SourcesG a, Constructor c) => SourcesG (M1 C c a) where
    type JoinedG (M1 C c a) = JoinedG a
    newJoinedChanG = fmap (first M1) newJoinedChanG

instance (SourcesG a, Selector c) => SourcesG (M1 S c a) where
    type JoinedG (M1 S c a) = JoinedG a
    newJoinedChanG = fmap (first M1) newJoinedChanG

instance Sources s => SourcesG (K1 i s) where
    type JoinedG (K1 i s) = Joined s
    newJoinedChanG = fmap (first K1) newJoinedChan

newtype Behavior a = Behavior (a -> IO (Behavior a))

runBehaviorOn :: Behavior a -> Messages a -> IO ()
runBehaviorOn = undefined

spawn :: (Sources s) => Behavior (Joined s) -> IO s
spawn = undefined

data Pair a b = Pair a b deriving (Generic)

instance (Sources a, Sources b) => Sources (Pair a b) where
    type Joined (Pair a b) = JoinedG (Rep (Pair a b))