"Generating" type synonyms without Template Haskell

I'd like to know how to conveniently generate specialisations of a product type without resorting to Template Haskell. Concretely, I have a type like data MyProduct a b c = MyProduct { foo :: a , bar :: b , baz :: c } and I use it in type signatures in various different specialisations. Generally the "base" type of each component stays fixed but it is wrapped in zero or more type constructors. For example a. MyProduct Int Bool String b. MyProduct (Maybe Int) (Maybe Bool) (Maybe String) c. MyProduct [IO Int] [IO Bool] [IO String] d. MyProduct (P Int) (P Bool) (P String) for various P that are not always functors in my uses. I thought I might be able to reduce this duplication by parametrisation, that is data MyProduct f a b c = MyProduct { foo :: f a , bar :: f b , baz :: f c } However, I can't always substitute a type constructor for `f` because that doesn't work for cases a. or c.. I thought a type family might work but it seems they have to be fully applied, like type synonyms. Is there an approach to this problem that will allow me to avoid Template Haskell here? Thanks, Tom

Hi Tom, You could push the use of that type family into the definition of MyProduct so that the type family can be fully applied:
{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-}
data MyProduct f a b c = MyProduct { foo :: MkF f a , bar :: MkF f b , baz :: MkF f c }
type family MkF (f :: k) (x :: *) :: *
type instance MkF () x = x type instance MkF (f ': fs) x = f (MkF fs x) type instance MkF '[] x = x type instance MkF f x = f x
Then your example signatures can be written as
type MP f = MyProduct f Int Bool String
type A = MP () type B = MP Maybe type C = MP [[], IO] type D = MP P
I'm not sure this approach gains you much over just writing out the type signatures has you had them. Adam

On Fri, 27 Jun 2014 17:52:39 +0100, Tom Ellis
I'd like to know how to conveniently generate specialisations of a product type without resorting to Template Haskell.
Concretely, I have a type like
data MyProduct a b c = MyProduct { foo :: a , bar :: b , baz :: c }
and I use it in type signatures in various different specialisations. Generally the "base" type of each component stays fixed but it is wrapped in zero or more type constructors. For example
a. MyProduct Int Bool String
b. MyProduct (Maybe Int) (Maybe Bool) (Maybe String)
c. MyProduct [IO Int] [IO Bool] [IO String]
d. MyProduct (P Int) (P Bool) (P String)
Using LiberalTypeSynonyms and your original MyProduct, we can define type Example f = MyProduct (f Int) (f Bool) (f String) type Id x = x type ListIO x = [IO x] type A = Example Id type B = Example Maybe type C = Example ListIO type D = Example P

On Fri, Jun 27, 2014 at 10:30:45PM +0200, Niklas Haas wrote:
On Fri, 27 Jun 2014 17:52:39 +0100, Tom Ellis
wrote: I'd like to know how to conveniently generate specialisations of a product type without resorting to Template Haskell.
Concretely, I have a type like
data MyProduct a b c = MyProduct { foo :: a , bar :: b , baz :: c }
and I use it in type signatures in various different specialisations. Generally the "base" type of each component stays fixed but it is wrapped in zero or more type constructors. For example
a. MyProduct Int Bool String
b. MyProduct (Maybe Int) (Maybe Bool) (Maybe String)
c. MyProduct [IO Int] [IO Bool] [IO String]
d. MyProduct (P Int) (P Bool) (P String)
Using LiberalTypeSynonyms and your original MyProduct, we can define
type Example f = MyProduct (f Int) (f Bool) (f String)
type Id x = x type ListIO x = [IO x]
type A = Example Id type B = Example Maybe type C = Example ListIO type D = Example P
Oh, that looks like exactly what I wanted! I didn't know about LiberalTypeSynonyms. Thanks a lot, Tom
participants (3)
-
adam vogt
-
Niklas Haas
-
Tom Ellis