This is a toy example to learn about language constructs, I understand that in real code this would be a typical case of “premature optimization”.
Scenario
Consider
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Lib where
convert :: (Convertible a, Convertible b) => a -> b
convert = fromPivot . toPivot
class (Num a) => Convertible a where
toPivot :: a -> Pivot
fromPivot :: Pivot -> a
newtype Pivot = Pivot Double deriving (Eq, Ord, Show, Num)
instance Convertible Pivot where
fromPivot = id
toPivot = id
newtype Unit1 = U1 Double deriving (Eq, Ord, Show, Num)
instance Convertible Unit1 where
fromPivot (Pivot x) = U1 (x / 12.12)
toPivot (U1 x) = Pivot (x * 12.12)
newtype Unit2 = U2 Double deriving (Eq, Ord, Show, Num)
instance Convertible Unit2 where
fromPivot (Pivot x) = U2 (x * 211.112)
toPivot (U2 x) = Pivot (x / 211.112)
Assume I’d like to “specialize” the convert
function to have a more efficient implementation of Unit1 -> Unit2
instead of (x / 12.12 * 211.112), I’d like to provide a specialization so that, effectively:
-- convert specialized to Unit1 -> Unit2
convert :: Unit1 -> Unit2
convert (U1 x) = x * 17.418481848
How can I achieve that?
When thinking of specialized implementations overriding a default implementation I certainly think of … classes, again:
class (Convertible a) => Convertible' a where
-- default implementation
convert' :: (Convertible b) => a -> b
convert' = fromPivot . toPivot
instance Convertible' Unit2
instance Convertible' Unit1
However, I don’t know how I could bring into scope the other unit to define a specialized convert function.
Ok, so let’s make a two-parameter typeclass:
{-# LANGUAGE MultiParamTypeClasses #-}
class (Convertible a, Convertible b) => SpecConv a b where
-- default implementation
convert' :: a -> b
convert' = convert
instance SpecConv Unit1 Unit2 where
convert' (U1 x) = U2 (x * 17.418481848)
instance SpecConv Unit2 Unit1 where
convert' (U2 x) = U1 (x * 0.057410285)
Ok, so I guess I figured it out while rubber-ducking here, in the forum window.
But once here, let me use the chance to ask some questions:
Questions
-
Is there a nice way to provide a unified interface for
convert
andconvert'
? I.e. the library user should be able to use the function on newtypes which are onlyConvertible
, but if aSpecConv
instance is available for the unit pair, that should be applied automatically, ie. without the user having to manually change the function toconvert'
. -
The Haskell Wiki on MultiParameterTypeClasses says:
Naive use of MPTCs may result in ambiguity, so functional dependencies were developed as a method of resolving that ambiguity, declaring that some subset of the parameters is sufficient to determine the values of the others.
Some uses of MPTCs with functional dependencies can be replaced with type families.
So, is there maybe a way to achieve this unified API (with only one method, that automatically chooses specialized instances when available) with one of these two? Or otherwise: would be using type families (if feasible at all) be preferable for the above scenario, independent of unified API, e.g. by allowing a more succinct and readable definition?
Thanks!