[Haskell-cafe] how would this be done? type classes? existential
types?
Ross Paterson
ross at soi.city.ac.uk
Thu Mar 16 09:24:50 EST 2006
On Thu, Mar 16, 2006 at 12:57:54PM +0100, Matthias Fischmann wrote:
> i have a type class that looks something like this:
>
> class Resource a where
> resourceName :: a -> String
> resourceAdvance :: a -> a
> resourceStarved :: a -> Bool
> resourceSpend :: a -> Int -> a
> resourceEarn :: a -> Int -> a
>
> resource types are rice, crude oil, pizza, software code, and so on.
> they all have a different internal structure and the same abstract
> interface, that's why i have defined this type class.
>
> now i want to create a list of a type similar to
>
> [r1, r2, r3] :: (Resource a) => [a]
>
> but with r1 being pizza, r2 being crude oil, and so on.
The existential is equivalent to a recursive type, as in this solution
(in Haskell 98):
data ResourceProperties a = ResourceProperties {
resourceName :: String,
resourceAdvance :: a,
resourceStarved :: Bool,
resourceSpend :: Int -> a,
resourceEarn :: Int -> a
}
instance Functor ResourceProperties where
fmap f p = ResourceProperties {
resourceName = resourceName p,
resourceAdvance = f (resourceAdvance p),
resourceStarved = resourceStarved p,
resourceSpend = f . resourceSpend p,
resourceEarn = f . resourceEarn p
}
class Resource a where
resourceProperties :: a -> ResourceProperties a
newtype Rs = Rs (ResourceProperties Rs)
instance Resource Rs where
resourceProperties (Rs r) = r
mkRs :: Resource a => a -> Rs
mkRs = Rs . fmap mkRs . resourceProperties
There won't be an unRs.
More information about the Haskell-Cafe
mailing list