Sử dụng lại các trường hợp MArray cho một kiểu mới

Tôi có một tá các loại mới như thế này:

newtype MyBool = MyBool Bool
newtype MyInt  = MyInt  Int

Tôi muốn sử dụng lại các trường hợp hiện có:

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

Thực hiện các trường hợp này và có tất cả các mã soạn sẵn là điều cuối cùng tôi muốn.

Tôi đã tìm thấy thứ gì đó trông rất gần với những gì tôi đang cố gắng đạt được:

{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}

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

Tuy nhiên, nó thất bại với:

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’

Làm thế nào để làm cho công việc này?

Nếu không thể, cách ít đau đớn nhất để có được những trường hợp đó là gì?

Từ tài liệu :

Chúng ta thậm chí có thể lấy được các thể hiện của các lớp đa tham số, với điều kiện newtype là tham số lớp cuối cùng.

Cũng lưu ý rằng thứ tự của các tham số lớp trở nên quan trọng, vì chúng ta chỉ có thể lấy được các thể hiện cho cái cuối cùng. Nếu StateMonadlớp trên thay vào đó được định nghĩa là

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

sau đó chúng ta sẽ không thể lấy được một thể hiện cho Parserkiểu trên. Chúng tôi đưa ra giả thuyết rằng các lớp đa tham số thường có một tham số chính của Cameron mà việc tạo ra các thể hiện mới là thú vị nhất.

Kể từ khi tham số lớp cuối cùng trong trường hợp của bạn không phải là Int/ MyInt, nhưng thay vì IO/ ST s, bạn không gặp may mắn với GeneralizedNewtypeDeriving, không may.

Được rồi, bạn đang bị mắc kẹt ở đây vì một số lựa chọn thiết kế trong arraygói đã gây khó khăn, nhưng đây là một cách tiếp cận có thể giúp giảm thiểu nồi hơi.

Bạn có thể giới thiệu một loại gia đình để ánh xạ các kiểu mới của bạn tới biểu diễn cơ bản của chúng:

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

và sau đó giới thiệu các biến thể newtype của các kiểu IOUArrayvà STUArraymảng:

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

và sử dụng THESE để có được các MArrayphiên bản phù hợp cho các loại mới của bạn:

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)

Bây giờ, bạn sẽ có thể sử dụng NTIOUArrayvà NTSTUArraythay thế cho thông thường IOUArrayvà STUArraycho cả hai loại phần tử newtype tích hợp và của bạn:

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

Bất kỳ IArraytrường hợp nào cũng có thể được tạo tự động bằng cách sử dụng dẫn viaxuất (hoạt động vì loại phần tử là đối số cuối cùng cho IArrayràng buộc):

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

hoặc bạn có thể sử dụng kỹ thuật tương tự ở trên với một NTIArrayloại mới.

Một số mã mẫu:

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