[Haskell-cafe] Data structure containing elements which are instances of the same type class
Daniel Trstenjak
daniel.trstenjak at gmail.com
Tue Aug 7 20:03:42 CEST 2012
Hi all,
it should be possible a call a function on all elements of the data
structure, to add and remove elements.
What I currently have:
the type class:
class Foo a where
hasId :: a -> Int -> Maybe a
a few instances:
data A = A deriving Show
instance Foo A where
hasId a 1 = Just a
hasId _ _ = Nothing
data B = B deriving Show
instance Foo B where
hasId a 2 = Just a
hasId _ _ = Nothing
data C = C deriving Show
instance Foo C where
hasId a 3 = Just a
hasId _ _ = Nothing
the data structure holding any instance of Foo, which itself is a
instance of Foo:
data Foos l r = Foos l r
| FooL l
| FooR r
| NoFoos deriving Show
instance (Foo l, Foo r) => Foo (Foos l r) where
hasId (Foos l r) id =
case (hasId l id, hasId r id) of
(Just l, Just r) -> Just $ Foos l r
(Just l, _ ) -> Just $ FooL l
(_ , Just r) -> Just $ FooR r
_ -> Nothing
combinator for Foos:
(+++) :: l -> r -> Foos l r
l +++ r = Foos l r
infixr 5 +++
Now I can write:
*Main> A +++ B +++ C +++ A
Foos A (Foos B (Foos C A))
*Main> (A +++ B +++ C +++ A) `hasId` 1
Just (Foos A (FooR (FooR A)))
Doesn't seem that nice. For every operation I would have to extend the
type class. After some operations the data structure contains many
dummy nodes (FooR, FooL).
Is there some nicer way?
Greetings,
Daniel
More information about the Haskell-Cafe
mailing list