[Haskell-cafe] I hate Haskell's typeclasses
Ryan Ingram
ryani.spam at gmail.com
Mon Apr 21 03:50:41 EDT 2008
On Fri, Apr 18, 2008 at 10:01 PM, Jonathan Cast
<jonathanccast at fastmail.fm> wrote:
> {-# GHC_OPTIONS -foverlapping-instances -fundecidable-instances #-} :)
> What you want to work is precisely what this allows.
Of course, I bring that point up. And overlapping instances has the
problem that it doesn't really do what you want; you always eventually
end up with this problem:
oops :: Eq a => a -> a -> Property
oops x y = x ~= y
Overlapping instances for EqTestable a
arising from a use of `~='
Matching instances:
instance [overlap ok] (Eq a) => EqTestable a
instance [overlap ok] (Show a, Arbitrary a, EqTestable b) =>
EqTestable (a -> b)
(The choice depends on the instantiation of `a'
To pick the first instance above, use -fallow-incoherent-instances
when compiling the other instance declarations)
In the expression: x ~= y
In the definition of `oops': oops x y = x ~= y
> I call. Name a language that is
>
> a) Completely statically typed (no type errors at runtime),
> b) Has an ad-hoc overloading mechanism powerful enough to encode Num and
> Monad, and
> c) Is substantially better than Haskell + extensions for your examples.
No fair! I'm on haskell-cafe for a reason: every language sucks,
Haskell just sucks less :)
But I can give a couple of thoughts that almost meet your criteria:
1) Ruby. Totally misses (a) but absolutely nails (b) and (c).
2) C++: Fine on (a) as long as you don't write stupid stuff. Template
meta-programming involves pattern-matching on types and I believe is
strong enough for (b). But it's really verbose; from an elegance
point of view it probably misses (c).
3) Scala? I don't know enough about it to say for sure but what I
have seen looks promising.
> On 18 Apr 2008, at 9:29 PM, Ryan Ingram wrote:
> > 1) You can't make sensible default implementations. For example, it'd
> > be nice to make all my Monads be Applicatives and Functors without
> > resorting to Template Haskell or infinite boilerplate. Why can't I
> > just write this?
> >
> > instance Monad m => Applicative m where
> > pure = return
> > (<*>) = ap
> >
> > Sure, I get that there might be ambiguity of which instance to choose.
> > But why not warn me about that ambiguity, or let me choose somehow on
> > a case-by-case basis when it happens?
> >
>
> You can already choose on a case-by-case basis.
That's true, but if the authors of Applicative could, I am sure they
would have chosen to make it (and Functor) a superclass of Monad with
the proper default implementation; after all (1) Applicative is damn
useful, and (2) it's the common case.
> More generally, specifying what you want is really not hard. Do you really
> have gazillions of monads in your code you have to repeat this
> implementation for?
Yes, actually. First, I like writing monads. See
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/MonadPrompt-1.0.0.1
And second, just today I had to write
instance Applicative STM where
pure = return
(<*>) = ap
It felt like it was driving home the point.
> > 2) You can't add sensible superclasses. I was playing with QuickCheck
> > and wanted to write "equal with regards to testing". So I wrote up a
> > class for it:
> >
> > class TestableEq a where
> > (~=) :: a -> a -> Property
> >
> > instance Eq a => TestableEq a where
> > -- should be a superclass of Eq instead!
> > a ~= b = a == b
> >
>
> Again, this is one (*) line per type. How many types do you declare?
I don't declare too many myself, except on days when I'm trying to
embed system F in Haskell via GADTs, but I use a lot of them; and many
of them the authors have conveniently already made instances of useful
typeclasses. Then I try to add some new functionality and run into a
lot of friction because now every library I use needs an
implementation which matches.
Have you ever tried to write a monad transformer that is compatible
with the MTL? O(n^2) instances is not a fun place to be, especially
when most of the definitions are just variations on "lift".
Disclaimer: this is actually a hard problem; I don't expect the
compiler to be able to solve it, but it's frustrating nonetheless.
The things I bring up here are easy in comparison.
> > Sure, there is an alternative: I could manually declare instances of
> > TestableEq for EVERY SINGLE TYPE that is an instance of Eq. I am sure
> > nobody here would actually suggest that I do so.
> Bzzzt. Wrong. Thanks for playing!
Ha ha, you got me there :)
> > But why do I need to jump through these hoops for a perfectly safe &
> > commonly desired operation?
>
> It's called a proof obligation.
My argument is that there shouldn't even be a proof obligation here;
the language is just not expressive enough to allow me to write the
code that I want; something that is actually completely decidable &
non-overlapping.
> > 3) There's no reflection or ability to choose an implementation based
> > on other constraints.
> >
> > In QuickCheck, (a -> b) is an instance of Arbitrary for appropriate a,
> > b. But you can't use this instance in forAll or for testing functions
> > without being an instance of Show. Now, this is probably a design
> > mistake, but it's the right choice with the current typeclass system
> > (see (2)). But it'd be a million times better to have something like
> > the following:
> >
> > class Arbitrary a => MkArbitrary a where
> > mkArbitrary :: Gen (a, String)
> >
> > case instance MkArbitrary a where
> > Show a =>
> > mkArbitrary = do
> > x <- arbitrary
> > return (x, show x)
> > otherwise =>
> > mkArbitrary = do
> > st <- getGenState
> > x <- arbitrary
> > return (x, "evalGen arbitrary " ++ show st)
> >
>
> So we compile in a table of every instance and every datatype, add a
> Typeable constraint to forAll (since parametricity just got shot to heck),
> and scan through that table on every test. Millions of times better. And
> slower.
It's had a lot of research; I want the best of all worlds. For a start:
http://www.google.com/search?q=optimizing+dynamic+dispatch
You could get close without going to full dynamic dispatch, though;
consider the following "core":
-- This part is all in haskell now
data ShowDict a = ShowDict { show :: a -> String }
show_String :: ShowDict String
show_Int :: ShowDict Int
show_List :: ShowDict a -> ShowDict [a]
-- foo :: Show a => [a] -> String
-- foo x = show x ++ "!"
foo :: ShowDict a -> [a] -> String
foo sd x = show (show_List sd) x ++ "!"
-- This part isn't in haskell, and the syntax sucks, but the idea is there.
type MaybeShow a = Maybe (ShowDict a)
-- bar :: MaybeInstance Show a => [a] -> String
-- bar xs
-- | Show a = foo xs
-- | otherwise = show (length xs)
bar :: MaybeShow a -> [a] -> String
bar (Just sd) xs = foo sd xs
bar Nothing xs = show (show_Int) (length xs)
With this I could write
instance (MaybeInstance Show a, Arbitrary a) => MkArbitrary a where
mkArbitrary xs
| Show a = do
x <- arbitrary
return (x, show x)
| otherwise = do
st <- getGenState
x <- arbitrary
return (x, "evalGen arbitrary " ++ show st)
Now, every concrete type would be an instance of MaybeInstance
<classname>, and "dynamic" dispatch and (I think) closed typeclasses
would be a free benefit.
> And more likely to develop odd changes and hard-to-debug errors.
Or so you claim :)
> QuickCheck makes testing so easy, I think the Arbitrary (a -> b) instance
> is almost unnecessary; (btw., functions /are/ instances of Show).
Now it's my turn to call:
Prelude Test.QuickCheck> show ((\x -> x) :: Int -> Int)
<interactive>:1:0:
No instance for (Show (Int -> Int))
Although, I do see a useless instance in the standard prelude at
http://www.haskell.org/haskell-report/standard-prelude.html
I actually would love to have (unsafeShow :: a -> String) which made a
"best effort" attempt (subject to the compiler's debugging level) to
evaluate an object and tell you what it contains, including source
code for functions if possible.
> You can easily write a showable ADT encoding the functions you want to test.
That's fair (and actually pretty interesting). But definitely less elegant than
-- assuming Arbitrary (Behavior Int)
prop_fmap_at :: (Int -> Int) -> Property
prop_fmap_at f = fmap f . at ~= at . fmap f
(see Conal's recent FRP paper for the formulation of this property)
> > 4) Every concrete type should be an instance of Typeable without
> > having to do anything,
>
> Sure. And seq should go back to being a class method. (See earlier about
> parametricity being shot to heck). I have an excellent design which will
> preserve the language's semantics (which are fine the way they are, thank
> you), while being convenient for programmers, which this margin is too small
> to contain.[1]
At least we agree on something. But please don't keep your design to
yourself, share!
> Reflection is harder, because of the need for the lookup table with every
> instance of every class I mentioned earlier. (And you get to figure out how
> to encode polymorphic instances, too! Good luck[2]).
See dynamic dispatch, above. Although polymorphic instances do seem
tricky. But you could probably get away with treating each typeclass
as a member of the "typerep" object for each type with some amount of
lookup; doesn't one of the existing compilers implement typeclasses in
this way already?
-- ryan
More information about the Haskell-Cafe
mailing list