question on type classes

Markus Lauer Markus Lauer <mlauer@lauer-edv.com>
Tue, 8 May 2001 12:07:48 +0200 (MEST)


Is it possible in Haskell to define a type class like Show, which
has a generic implementation for Lists and a special one for
[Char], but (in contrast to Show) where Char is not in this Class

I'd like to have something like the following, but this example
doesn't work:

-------------------------------------------
module Test where

class Foo a where
    foo :: a -> a
    ....
    .... 

instance FooList a => Foo [a] where
    foo lst = fooList lst
    ....
    ....

class FooList a where
    fooList :: [a] -> [a]
    .... 
    ....

genericImpl :: Foo a => [a] -> [a]
genericImpl = ...

specialImpl :: String -> String
specialImpl = ....

instance FooList Char where
    fooList s = specialImpl s
    .....

instance Foo a => FooList a where
    fooList lst = genericImpl lst
    .....

---------------------------------------------

Hugs sais ERROR Test.hs:20 - syntax error in instance head (constructor 
           expected)

ghc (5.00) sais Test.hs:20:
    Illegal instance declaration for `FooList a'
        (the instance type must be of form (T a b c)
         where T is not a synonym, and a,b,c are distinct type variables)

is there a better way, than to copy the instance declaration of
FooList for every a in that is in class Foo?

Thanks for any hint,

Markus

-- 
Markus Lauer <Markus.Lauer@lauer-edv.com>