Typeclass default implementation in subclasses

Hi all, This email is literate Haskell. I have a question about default implementations of typeclasses.
{-# LANGUAGE TypeSynonymInstances #-}
module Thing where
import Text.PrettyPrint.HughesPJ
Let say I want to pretty-print some values, enclosed in double quotes. The natural thing to do (within the HughesPJ pretty-printing framework, anyway - and that's where I am in this problem's wider context) is:
ppQuote :: Show a => a -> Doc ppQuote = doubleQuotes . text . show
Now, this works nicely for (say) Int:
x :: Int x = 1
*Thing> ppQuote x "1" But less nicely for String and Char, because their Show instances already insert double/single quotes respectively:
y :: String y = "hello" z :: Char z = 'a'
*Thing> ppQuote y ""hello"" *Thing> ppQuote z "'a'" I don't want this. I'd like them to be "hello" and "a" respectively. So I thought I'd create a typeclass, whose default implementation is as above...
class (Show a) => Quotable a where quote :: a -> Doc quote = ppQuote
... but with specialised instances for String and Char (the former seems to need the TypeSynonymInstances extension?):
instance Quotable String where quote = text . show -- don't need the doubleQuotes call for String instance Quotable Char where quote c = quote [c] -- just lift it to String
Unfortunately, while this works great for String and Char... *Thing> quote y "hello" *Thing> quote z "a" ... the "default implementation" mechanism doesn't work as I'd expect/hope: *Thing> quote x <interactive>:1:0: No instance for (Quotable Int) arising from a use of `quote' at <interactive>:1:0-6 Possible fix: add an instance declaration for (Quotable Int) In the expression: quote x In the definition of `it': it = quote x What I would _like_ would be for the compiler to say "OK, the Quotable class depends on the Show class, and Int is an instance of Show so Int is also an instance of Quotable, having the default implementation (since there isn't a specialised one for it)" - but clearly it doesn't. Please can someone tell me why this doesn't happen, and if there is a way of making it happen? Also, if there's a more sensible way of attacking this whole problem, I'd be curious to hear it. I should perhaps add that this isn't a huge problem for me, because my instances will in practice tend to be String and Char anyway, and one can of course add Quotable instances for anything else easily enough - but I'm curious now I've come this far. :-) Many thanks! -Andy

This post is also literate haskell. By enabling these potentially dangerous extensions you'll get the behaviour you want.
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-}
module Thing where
import Text.PrettyPrint.HughesPJ
ppQuote :: Show a => a -> Doc ppQuote = doubleQuotes . text . show
x :: Int x = 1
y :: String y = "hello" z :: Char z = 'a'
class (Show a) => Quotable a where quote :: a -> Doc quote = ppQuote
instance (Show a) => Quotable a
instance Quotable String where quote = text . show -- don't need the doubleQuotes call for String
instance Quotable Char where quote c = quote [c] -- just lift it to String
Example: *Thing> quote "pi" "pi" *Thing> quote 3.14159 "3.14159"
participants (2)
-
Andy Gimblett
-
Roel van Dijk