[Haskell-cafe] generalized newtype deriving allows the definition
of otherwise undefinable functions
Max Cantor
mxcantor at gmail.com
Tue Mar 9 05:53:14 EST 2010
Isn't this just an extension of the notion that multi-parameter typeclasses without functional dependencies or type families are dangerous and allow for type-naughtiness?
On Mar 9, 2010, at 5:45 AM, Wolfgang Jeltsch wrote:
> Hello,
>
> some time ago, it was pointed out that generalized newtype deriving could be
> used to circumvent module borders. Now, I found out that generalized newtype
> deriving can even be used to define functions that would be impossible to define
> otherwise. To me, this is surprising since I thought that generalized newtype
> deriving was only intended to save the programmer from writing boilerplate
> code, not to extend expressiveness.
>
> Have a look at the following code:
>
>> {-# LANGUAGE
>> GeneralizedNewtypeDeriving,
>> MultiParamTypeClasses,
>> FlexibleInstances
>> #-}
>>
>> class Iso a b where
>>
>> conv :: item a -> item b
>>
>> instance Iso a a where
>>
>> conv = id
>>
>> newtype Wrapped a = Wrap a deriving (Iso a, Show)
>
> Now any value whose type contains some type t can be converted into a value of
> the type that you get if you replace t by Wrap t. Here is some code to
> demonstrate this for binary operations:
>
>> newtype BinOp a = BinOp (a -> a -> a)
>>
>> convBinOp :: (a -> a -> a) -> (Wrapped a -> Wrapped a -> Wrapped a)
>> convBinOp op = let BinOp op' = conv (BinOp op) in op'
>
> Now, you can enter
>
> convBinOp (*) (Wrap 5) (Wrap 3)
>
> into GHCi, and you will get
>
> Wrap 15
>
> as the result.
>
> The point is, of course, that such conversions are not only possible for
> binary operations but for arbitrary values and that these conversions are done
> by a single generic function conv. I don’t think it would be possible to
> implement conv without generalized newtype deriving.
>
> Any thoughts?
>
> Best wishes,
> Wolfgang
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list