[SOLVED] Deriving a class instance for a type based on another class it's an instance of

Deriving a class instance for a type based on another class it's an instance of

I have a situation where I have some similar newtypes that all need to be instances of Random, Arbitrary, and lots of other stuff. They all need the same custom implementation of the functions randomR, random, arbitrary, etc. So I put all of those implementations in a class.

Here's a simplified example, that just handles Random.

{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE ScopedTypeVariables     #-}
{-# LANGUAGE StandaloneDeriving      #-}
{-# LANGUAGE TypeFamilies            #-}

import qualified System.Random as SR

-- Numbers that are restricted to a narrower range
class Narrow t where
  type BaseType t

  -- Unsafe constructor for the instance type
  bless :: BaseType t -> t

  -- Safe constructor for the instance type
  narrow :: (Ord t, Bounded t) => BaseType t -> t
  narrow x | x' < (minBound :: t) = error "too small"
           | x' > (maxBound :: t) = error "too big"
           | otherwise     = x'
    where x' = bless x :: t

  -- Deconstructor for the instance type
  wide :: t -> BaseType t

  -- Random
  randomR
    :: (Ord t, Bounded t, SR.Random (BaseType t), SR.RandomGen g)
    => (t, t) -> g -> (t, g)
  randomR (a, b) g = (narrow x, g')
    where (x, g') = SR.randomR (wide a, wide b) g

  random
    :: (Ord t, Bounded t, SR.Random t, SR.RandomGen g)
    => g -> (t, g)
  random = SR.randomR (minBound, maxBound)

Here's a example of one of the types that I want.

-- | A number on the unit interval
newtype UIDouble = UIDouble Double
  deriving (Eq, Ord)

instance Bounded UIDouble where
  minBound = UIDouble 0
  maxBound = UIDouble 1

instance Narrow UIDouble where
  type BaseType UIDouble = Double
  bless = UIDouble
  wide (UIDouble x) = x

I want this to be an instance of Random. Ideally I'd like to write something like:

deriving ?strategy? instance SR.Random UIDouble

and have the compiler know to use the methods defined in Narrow to implement Random. But instead I have to write

instance SR.Random UIDouble where
  randomR = randomR
  random = random

It's not a problem doing this for a few methods, but doing this for Num, Fractional, RealFrac, Floating, Serialize, etc. for each of my types is a bit tedious.

An alternative I've explored is to write

instance (Narrow t) => SR.Random t where
  randomR = randomR
  random = random

because I'd only have to write this once for the class, rather than repeat it for each type. But that leads to UndecidableInstances which I understand are bad. I could do this with TemplateHaskell, I'm sure. But I wonder if there is some fancy language pragma or type-level programming magic that will streamline this?

Solution

First you define a newtype and give it the instance you want once and for all:

newtype UseNarrow a = UN a
instance Narrow a => SR.Random (UseNarrow a) where
    randomR (UN lo, UN hi) g = (UN v, g) where v = randomR (lo, hi) g
    random g = (UN v, g) where v = random g

Then in all of the places where you want to use that instance, you write:

deriving via (UseNarrow UIDouble) instance SR.Random UIDouble

I may have some of the syntax a tad off, as I didn't test the above. But you should have the idea.

For further reading, look for DerivingVia in the GHC User Manual.