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?
CodePudding user response:
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.