0
votes

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?

1
Why don't you just add Serial m Int32 to the constraints of func? Seems like the right thing to do here.leftaroundabout
It works... why did I not think of that? Should I answer the question myself, or do you want to?notBob
The super-polymorphic instance of Serial for t m will land you in overlapping territory immediately. Better to use DefaultSignatures to give default definitions based on that idea.dfeuer
Something like default get :: (m ~ t n, MonadTrans t, Serial n a) => Handle -> m a with a default definition of get = lift . get.dfeuer

1 Answers

3
votes

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