[Haskell-cafe] Is there a better way to subtyping?

Yves Parès yves.pares at gmail.com
Wed Mar 14 18:13:32 CET 2012


I might have a simpler way: make you base type polymorphic and add
capabilities to it thanks to that type:

data Base a = Base Foo Bar a

data Capa1 a = Capa1 Stuff Baz a  -- We leave the 'a' so that you can
continue to "stack".
data Capa2 = Capa2 Thing Stuff  -- We want it to be final, so no additional
parameter

Then to make derived types, just use (Base (Capa1 a)) or (Base Capa2).
Anything that accepts a (Base a) will accept a (Base Something).

You can also make some aliases if you want to keep types short:
type Deriv1 a = Base (Capa1 a)
type Deriv2 = Base Capa2

Le 14 mars 2012 01:26, Ryan Ingram <ryani.spam at gmail.com> a écrit :

> data Common = ...
> data A = ...
> data B = ...
> data C = ...
> data Super =
>     SubA { commonFields :: Common, getA :: A }
>     | SubB { commonFields :: Common, getB :: B }
>     | SubC { commonFields :: Common, getC :: C }
>
> foldWithSubtype :: (A -> r) -> (B -> r) -> (C -> r) -> Super -> r
> foldWithSubtype k _ _ (SubA {getA = a}) = k a
> foldWithSubtype _ k _ (SubB {getB = b}) = k b
> foldWithSubtype _ _ k (SubC {getC = c}) = k c
>
> foldSuper :: (A -> Common -> r) -> (B -> Common -> r) -> (C -> Common ->
> r) -> Super -> r
> foldSuper ka kb kc sup = foldWithSubtype ka kb kc sup $ commonFields sup
>
>
>
> On Mon, Mar 12, 2012 at 8:32 AM, Jeff Shaw <shawjef3 at msu.edu> wrote:
>
>> More specifically, if I have a record type from which I construct
>> multiple sub-record types, and I want to store these in a collection which
>> I want to map over while preserving the ability to get at the sub-fields,
>> is there a better way to do it than to have an enumeration for the
>> sub-types and then use Dynamic? I also have a nastier version that doesn't
>> require the enumeration, which throws an exception when fromDynamic can't
>> return a value with one of the expected types.
>>
>> {-# LANGUAGE Rank2Types, DeriveDataTypeable #-}
>> module Super where
>>
>> import Data.Dynamic
>> import Data.Typeable
>> import Data.Maybe
>>
>> data Super a = Super { commonFields :: (), subFields :: a }
>>    deriving Typeable
>>
>> data SubTypes = SubA | SubB | SubC
>>
>> data A = A { aFields :: () }
>>    deriving Typeable
>>
>> data B = B { bFields :: () }
>>    deriving Typeable
>>
>> data C = C { cFields :: () }
>>    deriving Typeable
>>
>> doSomethingWithSubType :: (Super A -> ()) -> (Super B -> ()) -> (Super C
>> -> ()) -> (SubTypes, Dynamic) -> Maybe ()
>> doSomethingWithSubType a _ _ (SubA, dynamic) = fromDynamic dynamic >>=
>> return . a
>> doSomethingWithSubType _ b _ (SubB, dynamic) = fromDynamic dynamic >>=
>> return . b
>> doSomethingWithSubType _ _ c (SubC, dynamic) = fromDynamic dynamic >>=
>> return . c
>>
>> doSomethingWithSubType2 :: (Super A -> ()) -> (Super B -> ()) -> (Super C
>> -> ()) -> Dynamic -> ()
>> doSomethingWithSubType2 a b c dynamic =
>>    let dynamicAsA = fromDynamic dynamic :: Maybe (Super A)
>>        dynamicAsB = fromDynamic dynamic :: Maybe (Super B)
>>        dynamicAsC = fromDynamic dynamic :: Maybe (Super C) in
>>    head $ catMaybes [ dynamicAsA >>= return . a
>>                     , dynamicAsB >>= return . b
>>                     , dynamicAsC >>= return . c]
>>
>>
>> ______________________________**_________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/**mailman/listinfo/haskell-cafe<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
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120314/67894bcf/attachment.htm>


More information about the Haskell-Cafe mailing list