How to declare an ad hoc polymorphic type be an instance of an specific type class?-CodePudding

I have a type class named ManagedValue defined as follows:

class ManagedValue a where
    type ManagedPtr a = (r :: *) | r -> a
    withManaged :: a -> (ManagedPtr a -> IO b) -> IO b
    getManaged :: ManagedPtr a -> IO a
    castManagedToPtr :: ManagedPtr a -> Ptr b
    castPtrToManaged :: Ptr b -> ManagedPtr a

For every type that is an instance of Storable typeclass, it is also an instance of ManagedValue typeclass, but not all ManagedValues are storable. However, I can't define it as something like instance Storable a => ManagedPtr a where ... becasue GHC gives the error The constraint ‘Storable a’ is no smaller than the instance head ‘ManagedValue a’.

I know I can define a type class hierarchy as Num to Intergral like class (Storable a, ManagedValue a) => StorableValue a where .... But this way needs to define all the instances manually, which is tiresome.

What I want is to declare that all Storable values are also ManagedValue so that I can define an instance just in one place and get the implementations for Int, Double and so on automatically, something like:

-- This definition doesn't work
instance Storable a => ManagedValue a where
  type ManagedPtr a = Ptr a

  withManaged v f = do
    fp <- mallocForeignPtr
    withForeignPtr fp $ \p -> do
       poke p v
       f p

  getManaged p = peek p

  castManagedToPtr = castPtr
  castPtrToManaged = castPtr

Then I can implement the methods of ManagedValue for Int, Double, et al.

Thanks for any tips!

CodePudding user response：

You're looking for default method signatures:

{-# LANGUAGE DefaultSignatures, TypeFamilyDependencies #-}

import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable

class ManagedValue a where
    type ManagedPtr a = (r :: *) | r -> a
    type ManagedPtr a = Ptr a

    withManaged :: a -> (ManagedPtr a -> IO b) -> IO b
    default withManaged :: (Storable a, ManagedPtr a ~ Ptr a) => a -> (ManagedPtr a -> IO b) -> IO b
    withManaged v f = do
        fp <- mallocForeignPtr
        withForeignPtr fp $ \p -> do
            poke p v
            f p

    getManaged :: ManagedPtr a -> IO a
    default getManaged :: (Storable a, ManagedPtr a ~ Ptr a) => ManagedPtr a -> IO a
    getManaged p = peek p

    castManagedToPtr :: ManagedPtr a -> Ptr b
    default castManagedToPtr :: ManagedPtr a ~ Ptr a => ManagedPtr a -> Ptr b
    castManagedToPtr = castPtr

    castPtrToManaged :: Ptr b -> ManagedPtr a
    default castPtrToManaged :: ManagedPtr a ~ Ptr a => Ptr b -> ManagedPtr a
    castPtrToManaged = castPtr

You'll still have to write instance ManagedValue Int, instance ManagedValue Double, etc., but you won't have to implement anything inside of those instances.

There's another option that wouldn't require you to manually write any instances for things that are Storable, but it has some caveats of its own:

{-# LANGUAGE TypeFamilies #-}

import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable

class ManagedPtr r where
    type ManagedValue r
    withManaged :: ManagedValue r -> (r -> IO b) -> IO b
    getManaged :: r -> IO (ManagedValue r)
    castManagedToPtr :: r -> Ptr b
    castPtrToManaged :: Ptr b -> r

instance Storable a => ManagedPtr (Ptr a) where
  type ManagedValue (Ptr a) = a

  withManaged v f = do
    fp <- mallocForeignPtr
    withForeignPtr fp $ \p -> do
       poke p v
       f p

  getManaged p = peek p

  castManagedToPtr = castPtr
  castPtrToManaged = castPtr

I basically turned the typeclass inside-out here, putting the typeclass on the pointer type and having the value be an associated type. The main caveat there's no longer a dependency from the value type to the pointer type, so when you actually use this typeclass, you'll probably have a ton of ambiguous types that you need to resolve with TypeApplications or something. The second caveat is that ManagedPtr can only ever be a Ptr now if the underlying value is Storable.