Store polymorphic callbacks in Haskell

callback, haskell, monads, polymorphism

Solution

Simple adaptation (make the thing compile):

data MyContext m = MyContext { _callbacks :: Callbacks m }

data Callbacks m = Callbacks {
  _callback1 :: IORef (m ()),
  _callback2 :: IORef (m ())}

-- Needs FlexibleContexts:
register :: (MonadIO m, MonadReader (MyContext m) m) => m () -> m ()
register f = do
  (Callbacks { _callback1 = ref1 }) <- asks _callbacks
  liftIO $ modifyIORef ref1 (const f)

However -XFlexibleContexts is needed.

Do you really need IORef? Why not using a simple state monad?

import Control.Monad.State
import Control.Monad.Reader.Class
import Control.Monad.Trans

data Callbacks m = Callbacks {
  _callback1 :: m (),
  _callback2 :: m ()
  }

-- Create a "new" MonadTransformer layer (specialization of StateT):

class Monad m => MonadCallback m where
  getCallbacks :: m (Callbacks m)
  setCallbacks :: Callbacks m -> m ()

newtype CallbackT m a = CallbackT (StateT (Callbacks (CallbackT m) ) m a)

unwrap (CallbackT x) = x

instance Monad m => Monad (CallbackT m) where
  CallbackT x >>= f = CallbackT (x >>= f')
    where f' x = unwrap $ f x
  return a =  CallbackT $ return a
instance Monad m => MonadCallback (CallbackT m) where
  getCallbacks = CallbackT $ get
  setCallbacks c = CallbackT $ put c
instance MonadIO m => MonadIO (CallbackT m) where
  liftIO m = CallbackT $ liftIO m
instance MonadTrans (CallbackT) where
  lift m = CallbackT $ lift m
-- TODO, add other instances

-- Helpers:

getCallback1 = do
  c <- getCallbacks
  return $ _callback1 c

-- This is you "register" function:
setCallback1 :: (Monad m, MonadCallback m) => m () -> m ()
setCallback1 f = do
  callbacks <- getCallbacks
  setCallbacks $ callbacks { _callback1 = f }   

-- Test:

test :: CallbackT IO ()
test = do
  c <- getCallbacks
  _callback1 c
  _callback2 c

main = runCallbackT test s
  where s = Callbacks { _callback1 = lift $ print "a" (), _callback2 = lift $ print "b" }

This code code works even without MonadIO.

Defining "Default" seems to work fine:

instance (MonadIO m, MonadCallback m) => Default (Callbacks m) where
def = Callbacks {
  _callback1 = getCallbacks >>= \c -> setCallbacks $ c { _callback2 = _callback1 c },
  _callback2 = return ()}

Problem

In advance, sorry for this long post. I'm writing an event-driven application in Haskell, as such I need to store several callback functions for further use. I would like such callbacks to be: - enriched : use of `ReaderT`, `ErrorT`, `StateT` rather than bare `IO`s ; - polymorphic : of type `(MonadIO m, MonadReader MyContext m, MonadState MyState m, MonadError MyError m) => m ()`, rather than `ReaderT MyContext (StateT MyState (ErrorT MyError IO)))` Let's forget about the `State` and `Error` layers, for the sake of simplicity. I started writing a record of all callbacks, stored inside `MyContext`, something like: ``` data MyContext = MyContext { _callbacks :: Callbacks {- etc -} } -- In this example, 2 callbacks only data Callbacks = Callbacks { _callback1 :: IORef (m ()), _callback2 :: IORef (m ())} ``` The main issue is : where to put the typeclasses constraints for `m` ? I tried the following, but none compiled: I thought I might parameterize `Callbacks` with `m` such as : ``` data (MonadIO m, MonadReader (MyContext m) m) => Callbacks m = Callbacks { _callback1 :: IORef (m ()), _callback2 :: IORef (m ())} ``` As `Callbacks` is part of `MyContext`, the latter has to be parameterized as well and it results in an infinite type issue (`MonadReader (MyContext m) m`). I then thought of using existential quantifiers : ``` data Callbacks = forall m . (MonadIO m, MonadReader MyContext m) => Callbacks { _callback1 :: IORef (m ()), _callback2 :: IORef (m ())} ``` It seemed to work fine until I wrote the actual code that registers a new callback in `Callbacks`: ``` register :: (MonadIO m, MonadReader MyContext m) => m () -> m () register f = do (Callbacks { _callback1 = ref1 }) <- asks _callbacks -- Note the necessary use of pattern matching liftIO $ modifyIORef ref1 (const f) ``` But I got the following error (simplified here): ``` Could not deduce (m ~ m1) from the context (MonadIO m, MonadReader MyContext m) bound by the type signature for register :: (MonadIO m, MonadReader MyContext m) => m () -> m () or from (MonadIO m1, MonadReader MyContext m1) bound by a pattern with constructor Callbacks :: forall (m :: * -> *). (MonadIO m, MonadReader MyContext m) => IORef (m ()) -> IORef (m ()) -> Callbacks, Expected type: m1 () Actual type: m () ``` I was unable to find a workaround. I would be really grateful if someone could enlighten me. What would be the good way of designing this, if any ? Thank you in advance for your comments. [EDIT] As far as I understood ysdx's answer, I tried parameterizing my datatypes with `m` without imposing any typeclass constraint, but then I was unable to make `Callbacks` an instance of `Data.Default`; writing something like this: ``` instance (MonadIO m, MonadReader (MyContext m) m) => Default (Callbacks m) where def = Callbacks { _callback1 = {- something that makes explicit use of the Reader layer -}, _callback2 = return ()} ``` ... resulted in GHC complaining with: ``` Variable occurs more often in a constraint than in the instance head in the constraint: MonadReader (MyContext m) m ``` It suggests using UndecidableInstances, but I heard it was a very bad thing, although I don't know why. Does it mean I have to give up using `Data.Default` ?

Original source