[Haskell-cafe] Derived type definition

Miguel Mitrofanov miguelimo38 at yandex.ru
Wed Nov 24 04:56:01 EST 2010


  Well, you can resort to functional dependencies, I guess...

{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, UndecidableInstances #-}
module FunDeps where
data Rec a r = Rec a r
data RecNil = RecNil
data Wrapper a = Wrapper a
class Wrapped r w | r -> w where i :: r -> w
instance Wrapped RecNil RecNil where i RecNil = RecNil
instance Wrapped r w => Wrapped (Rec a r) (Rec (Wrapper a) w) where i (Rec a r) = Rec (Wrapper a) (i r)
type TTest = Rec Int (Rec String RecNil)
type TTestWrapped = Rec (Wrapper Int) (Rec (Wrapper String) RecNil)
a :: TTest
a = Rec 1 (Rec "a" RecNil)
f :: TTestWrapped -> (Int, String)
f (Rec (Wrapper n) (Rec (Wrapper s) RecNil)) = (n, s)
r = f (i a)

...but that would be just an awkward way to do the same thing, so, my advice: don't. Type families are much nicer.

On the other hand, you could do your "Rec" type polimorphic in "wrapper"; assuming your real-life Wrapper is not just an identity, this would be worth considering:

{-# LANGUAGE KindSignatures #-}
module PolyM where
data Rec a r w = Rec (w a) (r w)
data RecNil (w :: * -> *) = RecNil
data Wrapper a = Wrapper a -- in reality it should be something else
newtype Identity a = Identity a
class Wrapped r where i :: r Identity -> r Wrapper
instance Wrapped RecNil where i RecNil = RecNil
instance Wrapped r => Wrapped (Rec a r) where i (Rec (Identity a) r) = Rec (Wrapper a) (i r)
type TTest = Rec Int (Rec String RecNil) Identity
type TTestWrapped = Rec Int (Rec String RecNil) Wrapper
a :: TTest
a = Rec (Identity 1) (Rec (Identity "a") RecNil)
f :: TTestWrapped -> (Int, String)
f (Rec (Wrapper n) (Rec (Wrapper s) RecNil)) = (n, s)
r = f (i a)

24.11.2010 12:24, kg пишет:
> Ok, it's exactly what i hoped.
>
> And I would like to know (for fun) if it's possible to do it without type family extension.
> I've tried ... without success.
>
> Thx.
>
> On 11/22/2010 10:46 PM, Miguel Mitrofanov wrote:
>> Sure, it's possible with TypeFamilies. The following compiles OK:
>>
>> {-# LANGUAGE TypeFamilies #-}
>> module TypeCalc where
>> data Rec a r = Rec a r
>> data RecNil = RecNil
>> data Wrapper a = Wrapper a
>> class TypeList t where
>> type Wrapped t
>> i :: t -> Wrapped t
>> instance TypeList RecNil where
>> type Wrapped RecNil = RecNil
>> i RecNil = RecNil
>> instance TypeList r => TypeList (Rec a r) where
>> type Wrapped (Rec a r) = Rec (Wrapper a) (Wrapped r)
>> i (Rec a r) = Rec (Wrapper a) (i r)
>> type TTest = Rec Int (Rec String RecNil)
>> type TTestWrapped = Rec (Wrapper Int) (Rec (Wrapper String) RecNil)
>> a :: TTest
>> a = Rec 1 (Rec "a" RecNil)
>> f :: TTestWrapped -> (Int, String)
>> f (Rec (Wrapper n) (Rec (Wrapper s) RecNil)) = (n, s)
>> r = f (i a) -- so, "i a" is of the type TTestWrapped.
>>
>>
>> On 22 Nov 2010, at 23:43, kg wrote:
>>
>>> Hi,
>>>
>>> I've tried to simplify as much as possible my problem. Finally, I think I can resume it like that:
>>>
>>> Suppose these following data types :
>>> data Rec a r = Rec a r
>>> data RecNil = RecNil
>>> data Wrapper a = Wrapper a
>>>
>>> Then, we can build the following type:
>>> type TTest = Rec Int (Rec String RecNil)
>>> or this type:
>>> type TTestWrapped = Rec (Wrapper Int) (Rec (Wrapper String) RecNil)
>>>
>>> Is it possible to build TTestWrapped from TTest ?
>>>
>>>
>>> Thx in advance,
>>> Antoine.
>>>
>>> _______________________________________________
>>> Haskell-Cafe mailing list
>>> Haskell-Cafe at haskell.org
>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list