Семейства типов с GHC.Generics или Data.Data

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

Задний план

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

{-# 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 в получаемом кортеже фактически пришли через отдельные Mailboxes.

Все это связано для пользователя в открытой функции 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 и Behaviors, поэтому приемлемое решение может изменить одно или все runBehaviorOn или snd действия newJoinedChan.

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

Вопросы

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

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


generics haskell ghc type-families
person jberryman    schedule 19.11.2012    source источник
comment
Это можно сделать с помощью GHC.Generics. Возможно, позже на этой неделе у меня будет время написать пример, если никто не доберется до него первым.   -  person Nathan Howell    schedule 20.11.2012
comment
@NathanHowell добавил небольшую награду, если у вас есть время найти решение   -  person jberryman    schedule 22.11.2012
comment
@NathanHowell: нуууу? :)   -  person Janus Troelsen    schedule 28.11.2012
comment
Был занят, извините, я посмотрю, что я могу сделать, но не могу работать над этим сегодня.   -  person Nathan Howell    schedule 28.11.2012
comment
@JanusTroelsen оставь мужчину в покое ;)   -  person jberryman    schedule 28.11.2012

Ответы (1)


arrow_upward
4
arrow_downward

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

{-# 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))
person Alexander VoidEx Ruchkin    schedule 17.01.2013