Specialized specializable function (Class a, Class b) => a -> b (morally)?

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

  1. Is there a nice way to provide a unified interface for convert and convert'? I.e. the library user should be able to use the function on newtypes which are only Convertible, but if a SpecConv instance is available for the unit pair, that should be applied automatically, ie. without the user having to manually change the function to convert'.

  2. 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!

You can use overlapping instances:

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

class (Convertible a, Convertible b) => Convert a b where
  convert :: a -> b
  convert = fromPivot . toPivot

-- general instance
instance (Convertible a, Convertible b) => Convert a b

-- specialized instances
instance {-# OVERLAPPING #-} Convert Unit1 Unit2 where
  convert (U1 x) = U2 (x * 17.418481848)
instance {-# OVERLAPPING #-} Convert Unit2 Unit1 where
  convert (U2 x) = U1 (x * 0.057410285)

EDIT: Read this blog post for much more info: https://kseo.github.io/posts/2017-02-05-avoid-overlapping-instances-with-closed-type-families.html

1 Like

Thanks, @jaror!

For (my and others’, stumbling upon this question) future reference, my corresponding reddit post led to some very insightful answers and alternatives to the above overlapping instances.