Okay, you're kind of stuck here because some design choices in the array
package have made it difficult, but here's one approach that may help minimize boilerplate.
You can introduce a type family to map your newtypes to their underlying representation:
type family UType e where
UType MyBool = Bool
UType MyInt = Int
UType a = a -- default for built-in types
and then introduce newtype variants of the IOUArray
and STUArray
array types:
newtype NTSTUArray s i e = NTSTUArray (STUArray s i (UType e))
newtype NTIOUArray i e = NTIOUArray (IOUArray i (UType e))
and use THESE to get appropriate MArray
instances for your new types:
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)
Now, you should be able to use NTIOUArray
and NTSTUArray
in place of the usual IOUArray
and STUArray
for both built-in and your newtype element types:
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
Any IArray
instances can be generated automatically using via
deriving (which works because the element type is the last argument to the IArray
constraint):
deriving via MyBool instance IArray UArray MyBool
deriving via MyInt instance IArray UArray MyInt
or you could use the same technique above with an NTIArray
newtype.
Some sample code:
{-# 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)