[英]Store polymorphic callbacks in Haskell
提前,对于这个冗长的帖子,我们深表歉意。
我正在用Haskell编写一个事件驱动的应用程序,因此我需要存储几个回调函数以备将来使用。 我希望这样的回调是:
ReaderT
, ErrorT
, StateT
而非裸IO
; (MonadIO m, MonadReader MyContext m, MonadState MyState m, MonadError MyError m) => m ()
而不是ReaderT MyContext (StateT MyState (ErrorT MyError IO)))
为了简单起见,让我们忘记State
和Error
层。
我开始编写所有回调的记录,这些记录存储在MyContext
,类似于:
data MyContext = MyContext { _callbacks :: Callbacks {- etc -} }
-- In this example, 2 callbacks only
data Callbacks = Callbacks {
_callback1 :: IORef (m ()),
_callback2 :: IORef (m ())}
主要问题是:将m
的类型类约束放在哪里? 我尝试了以下方法,但是没有编译:
我以为我可以用m
参数化Callbacks
,例如:
data (MonadIO m, MonadReader (MyContext m) m) => Callbacks m = Callbacks { _callback1 :: IORef (m ()), _callback2 :: IORef (m ())}
由于Callbacks
是MyContext
一部分,因此后者也必须参数化,并且会导致无限类型问题( MonadReader (MyContext m) m
)。
然后,我想到了使用存在量词 :
data Callbacks = forall m . (MonadIO m, MonadReader MyContext m) => Callbacks { _callback1 :: IORef (m ()), _callback2 :: IORef (m ())}
在我编写在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)
但是我得到了以下错误(这里简化了):
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 ()
我找不到解决方法。
如果有人能启发我,我将不胜感激。 如果有的话,设计这个的好方法是什么?
预先感谢您的评论。
[编辑]据我了解ysdx的答案,我尝试使用m
参数化我的数据类型,而没有施加任何类型类约束,但是后来我无法使Callbacks
成为Data.Default
的实例; 写这样的事情:
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 ()}
...导致GHC投诉:
Variable occurs more often in a constraint than in the instance head
in the constraint: MonadReader (MyContext m) m
它建议使用UndecidableInstances,但我听说这是一件很糟糕的事情,尽管我不知道为什么。 这是否意味着我必须放弃使用Data.Default
?
简单的适应(使事物编译):
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)
但是,需要-XFlexibleContexts。
您真的需要IORef吗? 为什么不使用简单的状态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" }
即使没有MonadIO,此代码也可以使用。
定义“默认”似乎可以正常工作:
instance (MonadIO m, MonadCallback m) => Default (Callbacks m) where
def = Callbacks {
_callback1 = getCallbacks >>= \c -> setCallbacks $ c { _callback2 = _callback1 c },
_callback2 = return ()}
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.