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

Jeff Shaw shawjef3 at msu.edu
Mon Mar 12 16:32:41 CET 2012


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]




More information about the Haskell-Cafe mailing list