[Haskell-cafe] Data structure containing elements which are instances of the same type class
Alexander Solla
alex.solla at gmail.com
Wed Aug 8 01:35:09 CEST 2012
On Tue, Aug 7, 2012 at 11:03 AM, Daniel Trstenjak <
daniel.trstenjak at gmail.com> wrote:
>
> 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?
>
Read "Data types a la carte". You can use the "free" package for most of
the plumbing (I think -- it definitely does free monads, which are a
tangentially related idea, but it has a module for dealing with these funny
functors, if I recall correctly.)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120807/9f563799/attachment.htm>
More information about the Haskell-Cafe
mailing list