11

这是一个与我的模块相关的问题here，并且被简化了一点。这也与之前的问题有关，我在其中过度简化了我的问题并且没有得到我正在寻找的答案。我希望这不是太具体，如果您能想到更好的标题，请更改标题。

背景

我的模块使用并发通道，分为读取端和写入端。我使用具有关联类型同义词的特殊类来支持多态通道“加入”：

{-# LANGUAGE TypeFamilies #-}

class Sources s where
    type Joined s
    newJoinedChan :: IO (s, Messages (Joined s)) -- NOT EXPORTED

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

-- and so on for tuples of 3,4,5...

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

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

我们有一个称为 a 的递归操作Behavior，我们可以在从通道的“读取”端拉出的消息上运行它：

newtype Behavior a = Behavior (a -> IO (Behavior a))
runBehaviorOn :: Behavior a -> Messages a -> IO ()  -- NOT EXPORTED

这将允许我们Behavior (Int,Int)在其中一个msgsAor上运行 a msgsB，在第二种情况下，Int它接收的元组中的两个 s 实际上来自单独的Mailboxes。

spawn在暴露的功能中，这一切都为用户捆绑在一起

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

...调用newJoinedChanand runBehaviorOn，并返回 input Sources。

我想做的事

我希望用户能够创建Behavior任意产品类型（不仅仅是元组），因此例如我们可以Behavior (Pair Int Int)在上面的示例中运行 a Messages。我想GHC.Generics在仍然拥有 polymorphic 的同时执行此操作Sources，但无法使其工作。

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

上述示例中实际暴露在 API 中的fst部分是newJoinedChan操作的 of 和Behaviors，因此可接受的解决方案可以修改一个或全部runBehaviorOn或sndof newJoinedChan。

我还将扩展上面的 API 以支持 sum（尚未实现），Behavior (Either a b)所以我希望 GHC.Generics 对我有用。

问题

  1. 有没有办法可以扩展上面的 API 以支持任意的Generic a=> Behavior a？

  2. 如果不使用 GHC 的泛型，是否有其他方法可以让最终用户痛苦最小地获得我想要的 API（即他们只需要在他们的类型中添加一个派生子句）？例如与Data.Data？

4

1 回答 1

4

也许是这样的？

{-# 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))
于 2013-01-17T12:05:29.687 回答