Reutilizando instâncias do MArray para um novo tipo

Eu tenho uma dúzia de tipos novos como este:

newtype MyBool = MyBool Bool
newtype MyInt  = MyInt  Int

Quero reutilizar instâncias existentes:

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

Implementar essas instâncias e ter todo o código padrão é a última coisa que eu quero.

Encontrei algo que parece muito próximo do que estou tentando alcançar:

{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}

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

No entanto, ele falha com:

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’

Como fazer isso funcionar?

Se não for possível, qual é a maneira menos dolorosa de obter essas instâncias?

A partir da documentação :

Podemos até derivar instâncias de classes multiparâmetros, desde que o newtype seja o último parâmetro da classe.

Observe também que a ordem dos parâmetros da classe se torna importante, pois só podemos derivar instâncias para o último. Se a StateMonadclasse acima fosse definida como

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

então não teríamos sido capazes de derivar uma instância para o Parsertipo acima. Nossa hipótese é que as classes multiparâmetros geralmente têm um parâmetro "principal" para o qual derivar novas instâncias é mais interessante.

Como o último parâmetro de classe no seu caso não é Int/ MyInt, mas sim IO/ ST s, você está sem sorte GeneralizedNewtypeDeriving, infelizmente.

Ok, você está meio que preso aqui porque algumas opções de design no arraypacote dificultaram, mas aqui está uma abordagem que pode ajudar a minimizar o clichê.

Você pode introduzir uma família de tipos para mapear seus novos tipos para a representação subjacente:

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

e, em seguida, introduza variantes newtype dos tipos IOUArraye STUArrayarray:

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

e use ESTES para obter MArrayinstâncias apropriadas para seus novos 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)

Agora, você deve poder usar NTIOUArraye NTSTUArrayno lugar do habitual IOUArraye STUArraypara os tipos de elemento interno e 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

Qualquer IArrayinstância pode ser gerada automaticamente usando viaderivação (que funciona porque o tipo de elemento é o último argumento da IArrayrestrição):

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

ou você pode usar a mesma técnica acima com um NTIArraynovo tipo.

Algum código de exemplo:

{-# 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)