在 Haskell 中存储多态回调

Posted 2023-02-19

【中文标题】在 Haskell 中存储多态回调

【英文标题】：Store polymorphic callbacks in Haskell

【发布时间】：2012-08-16 04:28:27

【问题描述】：

提前，很抱歉这篇长篇文章。

我正在用 Haskell 编写一个事件驱动的应用程序，因此我需要存储几个回调函数以供进一步使用。我希望这样的回调是：

丰富：使用ReaderT、ErrorT、StateT 而不是裸露的IOs； 多态：类型为(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 ()

我找不到解决方法。

如果有人能启发我，我将不胜感激。如果有的话， 好的设计方法是什么？

提前感谢您的 cmets。

[EDIT] 据我了解 ysdx 的回答，我尝试使用 m 参数化我的数据类型而不施加任何类型类约束，但后来我无法使 Callbacks 成为 @ 的实例987654344@;写这样的东西：

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？

【问题讨论】：

我现在没有可用的 ghc，但是否因为 IORef 具有固定类型一旦构造？如果是这样，请尝试在 (MonadIO m, ...) => m () 上创建一个存在的新类型，并将您的回调改为 IORef <the newtype>。

另外，是否有理由使用modifyIORef ref1 (const f) 而不是writeIORef ref1 f？

多态数据是一种非常罕见的需求；你确定你不只是指参数化数据吗？如果参数化就够了，那么看ysdx的回答；否则，请告诉我，我会写一个多态版本。

@hzap writeIORef 在这里更有意义，确实，谢谢。

有多种方法可以构建这样的东西。为您选择正确方式的关键问题是“如何使用回调？”。什么代码在做回调？

【参考方案1】：

简单适配（使东西编译）：

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 吗？为什么不使用简单的状态单子？

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 ()

【讨论】：

我仍然遇到无限类型问题：Occurs check: cannot construct the infinite type m1 = ReaderT (MyContext m1) IO 写完runReaderT (MyContext aCallback) f...