Lift instance of class with a `MonadIO` type-variable to the transformed monad

Question

As part of a program where I need to log data from monadic computations, I am trying to define a class to make this more convenient.

module Serial where
import Data.Int
import Data.IORef
import System.IO
import Control.Monad.Trans
import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable

class MonadIO m => Serial m a where
    get :: Handle -> m a
    put :: Handle -> a -> m ()

One of the things I'd like to be able to do is to define get and put in a 'higher' monad, since some data is inaccessible in IO. For simpler data, like instances of Storable, for example, IO is enough. I'd like to keep the basic instances in the 'lowest' possible monad, but allow the actions to be lifted to any 'higher' MonadIO instance.

instance (Serial m a, MonadIO (t m), MonadTrans t) 
    => Serial (t m) a where
       get = lift . get
       put h = lift . put h

instance Storable a => Serial IO a where
    get h = alloca (\ptr 
        -> hGetBuf h ptr (sizeOf (undefined :: a))
        >> peek ptr)
    put h a = with a (\ptr 
        -> hPutBuf h ptr $ sizeOf a)

The idea is to enable functions like

func :: Serial m a => Handle -> a -> m ()
func h a = put h (0::Int32) >> put h a

where an instance in IO can be combined with an instance in any MonadIO. However with my current code, GHC cannot deduce the instance for Serial m Int32. For the particular case of lifting IO this problem can be solved by liftIO, but if the base type is t IO that doesn't work anymore. I think this can be solved by overlapping instances, but I would like to avoid that if possible. Is there any way to achieve this?

Answer 1

You can just write out the required extra constraint:

func :: (Serial m a, Serial m Int32) => Handle -> a -> m ()
func h a = put h (0::Int32) >> put h a

(I think this requires -XFlexibleContexts.)

If this makes the signatures unwieldy, you can group together constraints in a “constraint synonym class”:

class (Serial m a, Serial m Int32, Serial m Int64, ...)
       => StoSerial m a
instance (Serial m a, Serial m Int32, Serial m Int64, ...)
       => StoSerial m a

func :: StoSerial m a => Handle -> a -> m ()
func h a = put h (0::Int32) >> put h a