Тип Семьи с GHC.Generics или Data.Data

Это вопрос, связанный с моим модулем здесь и немного упрощен. Это также связано с этим предыдущим вопросом, в котором я упростил свою проблему и не получил ответа, который я искал. Я надеюсь, что это не слишком специфично, и, пожалуйста, измените название, если вы думаете, что лучший.

Фон

Мой модуль использует параллельный chan, разделенный на сторону чтения и записи. Я использую специальный класс с ассоциированным типом синонима для поддержки полиморфного канала "присоединяется":

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

У нас есть рекурсивное действие, называемое Behavior, которое мы можем запускать на сообщениях, которые мы выходим из "прочитанного" конца канала:

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

Это позволило бы нам запустить Behavior (Int,Int) на любом из msgsA или msgsB, где во втором случае оба Int в кортеже, который он получает, фактически пришли через отдельные Mailbox es.

Все это связано для пользователя в открытой spawn функции

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

... который вызывает newJoinedChan и runBehaviorOn и возвращает вход Sources.

Что я хотел бы сделать

Я хочу, чтобы пользователи могли создавать Behavior произвольного типа продукта (а не только кортежи), поэтому, например, мы могли бы запустить Behavior (Pair Int Int) в примере Messages выше. Я хотел бы сделать это с помощью GHC.Generics, все еще имея полиморфный Sources, но не могу заставить его работать.

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

Части вышеприведенного примера, которые фактически отображаются в API, являются fst действия newJoinedChan и Behavior s, поэтому приемлемое решение может изменить один или все runBehaviorOn или snd of newJoinedChan.

Я также буду расширять API выше для поддержки сумм (еще не реализованных), таких как Behavior (Either a b), поэтому я надеялся, что GHC.Generics будет работать для меня.

Вопросы

  • Есть ли способ расширить API выше для поддержки произвольного Generic a=> Behavior a?

  • Если вы не используете GHC Generics, есть ли другие способы, с помощью которых я могу получить API, который я хочу, с минимальной болью конечного пользователя (т.е. им просто нужно добавить предложение о выводе к их типу)? например с Data.Data?

ОТВЕТЫ

Ответ 1

Может быть, что-то вроде этого?

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