Reutilización de instancias de matriz para un nuevo tipo

Tengo una docena de nuevos tipos como este:

newtype MyBool = MyBool Bool
newtype MyInt  = MyInt  Int

Quiero reutilizar instancias existentes:

instance MArray IOUArray Int IO         where ...
instance MArray (STUArray s) Int (ST s) where ...

Implementar estas instancias y tener todo el código repetitivo es lo último que quiero.

Encontré algo que se parece mucho a lo que estoy tratando de lograr:

{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}

deriving instance MArray IOUArray MyInt IO      
deriving instance MArray (STUArray s) MyInt (ST s)  

Sin embargo, falla con:

Can't make a derived instance of ‘MArray IOUArray MyInt IO’
    (even with cunning GeneralizedNewtypeDeriving):
    cannot eta-reduce the representation type enough
In the stand-alone deriving instance for ‘MArray IOUArray MyInt IO’

¿Cómo hacer que esto funcione?

Si no es posible, ¿cuál es la forma menos dolorosa de obtener esas instancias?

De la documentación :

Incluso podemos derivar instancias de clases de parámetros múltiples, siempre que el nuevo tipo sea el último parámetro de clase.

Observe también que el orden de los parámetros de clase se vuelve importante, ya que solo podemos derivar instancias para el último. Si la StateMonadclase anterior se definiera como

class StateMonad m s | m -> s where ...

entonces no hubiéramos podido derivar una instancia para el Parsertipo anterior. Presumimos que las clases de parámetros múltiples generalmente tienen un parámetro "principal" para el cual derivar nuevas instancias es más interesante.

Dado que el último parámetro de clase en su caso no es Int/ MyInt, sino más bien IO/ , desafortunadamente ST sno tiene suerte GeneralizedNewtypeDeriving.

De acuerdo, estás un poco atrapado aquí porque algunas opciones de diseño en el arraypaquete lo han dificultado, pero aquí hay un enfoque que puede ayudar a minimizar las repeticiones.

Puede introducir una familia de tipos para asignar sus nuevos tipos a su representación subyacente:

type family UType e where
  UType MyBool = Bool
  UType MyInt = Int
  UType a = a    -- default for built-in types

y luego introducir newtype variantes de la IOUArrayy STUArrayde la matriz tipos:

newtype NTSTUArray s i e = NTSTUArray (STUArray s i (UType e))
newtype NTIOUArray i e = NTIOUArray (IOUArray i (UType e))

y use ESTOS para obtener MArrayinstancias apropiadas para sus nuevos tipos:

instance (MArray (STUArray s) (UType e) (ST s), Coercible e (UType e))
       => MArray (NTSTUArray s) e (ST s) where
  getBounds (NTSTUArray arr) = getBounds arr
  getNumElements (NTSTUArray arr) = getNumElements arr
  newArray (a,b) e = NTSTUArray <$> newArray (a,b) (coerce e)
  newArray_ (a,b) = NTSTUArray <$> newArray_ (a,b)
  unsafeNewArray_ (a,b) = NTSTUArray <$> unsafeNewArray_ (a,b)
  unsafeRead (NTSTUArray arr) i = coerce <$> unsafeRead arr i
  unsafeWrite (NTSTUArray arr) i e = unsafeWrite arr i (coerce e)

instance (MArray IOUArray (UType e) IO, Coercible e (UType e))
       => MArray NTIOUArray e IO where
  getBounds (NTIOUArray arr) = getBounds arr
  getNumElements (NTIOUArray arr) = getNumElements arr
  newArray (a,b) e = NTIOUArray <$> newArray (a,b) (coerce e)
  newArray_ (a,b) = NTIOUArray <$> newArray_ (a,b)
  unsafeNewArray_ (a,b) = NTIOUArray <$> unsafeNewArray_ (a,b)
  unsafeRead (NTIOUArray arr) i = coerce <$> unsafeRead arr i
  unsafeWrite (NTIOUArray arr) i e = unsafeWrite arr i (coerce e)

Ahora, debería poder usar NTIOUArrayy NTSTUArrayreemplazar el habitual IOUArrayy STUArraypara los tipos de elementos integrados y de tipo newtype:

main = do
  x <- newArray (1,10) (MyInt 0) :: IO (NTIOUArray Int MyInt)
  y <- newArray (1,10) 0         :: IO (NTIOUArray Int Int)
  readArray x 5 >>= writeArray y 8 . coerce

Cualquier IArrayinstancia se puede generar automáticamente mediante viaderivación (que funciona porque el tipo de elemento es el último argumento de la IArrayrestricción):

deriving via MyBool instance IArray UArray MyBool
deriving via MyInt instance IArray UArray MyInt

o podría usar la misma técnica anterior con un NTIArraynuevo tipo.

Algún código de muestra:

{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
    MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, UndecidableInstances #-}

import Data.Coerce (coerce, Coercible)
import Data.Array.Base
import Data.Array.IO
import Control.Monad.ST (ST)

newtype MyBool = MyBool Bool deriving (Show)
newtype MyInt = MyInt Int deriving (Show)

-- newtype arrays
type family UType e where
  UType MyBool = Bool
  UType MyInt = Int
  UType a = a
newtype NTSTUArray s i e = NTSTUArray (STUArray s i (UType e))
newtype NTIOUArray i e = NTIOUArray (IOUArray i (UType e))

deriving via MyBool instance IArray UArray MyBool
deriving via MyInt instance IArray UArray MyInt

instance (MArray (STUArray s) (UType e) (ST s), Coercible e (UType e))
       => MArray (NTSTUArray s) e (ST s) where
  getBounds (NTSTUArray arr) = getBounds arr
  getNumElements (NTSTUArray arr) = getNumElements arr
  newArray (a,b) e = NTSTUArray <$> newArray (a,b) (coerce e)
  newArray_ (a,b) = NTSTUArray <$> newArray_ (a,b)
  unsafeNewArray_ (a,b) = NTSTUArray <$> unsafeNewArray_ (a,b)
  unsafeRead (NTSTUArray arr) i = coerce <$> unsafeRead arr i
  unsafeWrite (NTSTUArray arr) i e = unsafeWrite arr i (coerce e)

instance (MArray IOUArray (UType e) IO, Coercible e (UType e))
       => MArray NTIOUArray e IO where
  getBounds (NTIOUArray arr) = getBounds arr
  getNumElements (NTIOUArray arr) = getNumElements arr
  newArray (a,b) e = NTIOUArray <$> newArray (a,b) (coerce e)
  newArray_ (a,b) = NTIOUArray <$> newArray_ (a,b)
  unsafeNewArray_ (a,b) = NTIOUArray <$> unsafeNewArray_ (a,b)
  unsafeRead (NTIOUArray arr) i = coerce <$> unsafeRead arr i
  unsafeWrite (NTIOUArray arr) i e = unsafeWrite arr i (coerce e)

main = do
  x <- newArray (1,10) (MyInt 0) :: IO (NTIOUArray Int MyInt)
  y <- newArray (1,10) 0         :: IO (NTIOUArray Int Int)
  readArray x 5 >>= writeArray y 8 . coerce
  x' <- freeze x :: IO (UArray Int MyInt)
  y' <- freeze y :: IO (UArray Int Int)
  print $ (x' ! 5, y' ! 8)

foo :: ST s (NTSTUArray s Int MyInt)
foo = newArray (1,10) (MyInt 0)