Type Families with GHC.Generics or Data.Data

Question

This is a question related to my module here, and is simplified a bit. It's also related to this previous question, in which I oversimplified my problem and didn't get the answer I was looking for. I hope this isn't too specific, and please change the title if you can think if a better one.

Background

My module uses a concurrent chan, split into a read side and write side. I use a special class with an associated type synonym to support polymorphic channel "joins":

{-# 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...

The code above allows us to do this kind of thing:

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

We have a recursive action called a Behavior that we can run on the messages we pull out of the "read" end of the channel:

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

This would allow us to run a Behavior (Int,Int) on either of msgsA or msgsB, where in the second case both Ints in the tuple it receives actually came through separate Mailboxes.

This is all tied together for the user in the exposed spawn function

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

...which calls newJoinedChan and runBehaviorOn, and returns the input Sources.

What I'd like to do

I'd like users to be able to create a Behavior of arbitrary product type (not just tuples) , so for instance we could run a Behavior (Pair Int Int) on the example Messages above. I'd like to do this with GHC.Generics while still having a polymorphic Sources, but can't manage to make it work.

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

The parts of the above example that are actually exposed in the API are the fst of the newJoinedChan action, and Behaviors, so an acceptable solution can modify one or all of runBehaviorOn or the snd of newJoinedChan.

I'll also be extending the API above to support sums (not implemented yet) like Behavior (Either a b) so I hoped GHC.Generics would work for me.

Questions

1. Is there a way I can extend the API above to support arbitrary Generic a=> Behavior a?

2. If not using GHC's Generics, are there other ways I can get the API I want with minimal end-user pain (i.e. they just have to add a deriving clause to their type)? e.g. with Data.Data?

Answer 1

Maybe something like this?

{-# 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))