Haskell中如何为自定义Monad添加HasCallStack约束？

你在自定义XIO类型时遇到的问题，根源在于：data XIO a = HasCallStack => XIO { unXIO :: IO a }这种写法是给数据构造器加约束，只有调用XIO构造器的时候需要当前调用栈，但pure、>>=这些Monad实例方法并没有要求HasCallStack。当你用pure创建XIO值，或者用>>=组合操作时，不会捕获当前的调用栈，最终抛出异常时自然拿不到完整的调用链。

下面是两种可行的解决方案：

方案一：给所有XIO操作显式加HasCallStack约束 #

去掉data定义里的约束，转而给构造器、所有实例方法加上HasCallStack，确保每个创建或组合XIO值的操作都捕获当前调用栈：

module Main (main) where

import RIO

main :: IO ()
main = do
  catchAny (unXIO $ f1) $ \ex -> do
    putStrLn "::: Now with callstack!"
    putStrLn $ displayException ex

f1 :: HasCallStack => XIO ()
f1 = do
  pure ()
  f2
  pure ()

f2 :: HasCallStack => XIO ()
f2 = do
  pure ()
  _ <- liftIO $ throwIO $ stringException "Hello"
  pure ()

newtype XIO a = XIO { unXIO :: IO a }

-- 给构造器加约束，确保创建XIO时捕获调用栈
mkXIO :: HasCallStack => IO a -> XIO a
mkXIO = XIO

instance Functor XIO where
  fmap :: HasCallStack => (a -> b) -> XIO a -> XIO b
  fmap f (XIO m) = mkXIO $ fmap f m

instance Applicative XIO where
  pure :: HasCallStack => a -> XIO a
  pure = mkXIO . pure
  (<*>) :: HasCallStack => XIO (a -> b) -> XIO a -> XIO b
  XIO f <*> XIO a = mkXIO $ f <*> a

instance Monad XIO where
  return :: HasCallStack => a -> XIO a
  return = pure
  (>>=) :: HasCallStack => XIO a -> (a -> XIO b) -> XIO b
  XIO m >>= f = mkXIO $ m >>= (\k -> unXIO $ f k)

instance MonadIO XIO where
  liftIO :: HasCallStack => IO a -> XIO a
  liftIO = mkXIO

这样，每个XIO的操作都需要HasCallStack，调用栈会被自动捕获并传递，抛出异常时就能看到完整的调用链。

方案二：显式携带CallStack（更可控） #

把CallStack作为XIO的一部分，显式传递，这样能更灵活地控制调用栈的捕获：

module Main (main) where

import RIO
import GHC.Stack (CallStack, callStack, addCallStack)

main :: IO ()
main = do
  catchAny (runXIO f1) $ \ex -> do
    putStrLn "::: Explicit callstack"
    putStrLn $ displayException ex

-- 运行XIO时传入当前调用栈
runXIO :: HasCallStack => XIO a -> IO a
runXIO (XIO f) = f callStack

f1 :: XIO ()
f1 = do
  pure ()
  f2
  pure ()

f2 :: XIO ()
f2 = do
  pure ()
  throwXIO $ stringException "Hello"
  pure ()

newtype XIO a = XIO { unXIO :: CallStack -> IO a }

instance Functor XIO where
  fmap f (XIO m) = XIO $ \cs -> fmap f (m cs)

instance Applicative XIO where
  pure a = XIO $ \_ -> pure a
  XIO f <*> XIO a = XIO $ \cs -> f cs <*> a cs

instance Monad XIO where
  return = pure
  XIO m >>= f = XIO $ \cs -> m cs >>= \x -> unXIO (f x) cs

instance MonadIO XIO where
  liftIO m = XIO $ \_ -> m

-- 自定义抛出异常的函数，把当前CallStack附加到异常上
throwXIO :: Exception e => e -> XIO a
throwXIO e = XIO $ \cs -> throwIO $ e `addCallStack` cs

这种方式下，CallStack被显式保存在XIO中，每个步骤都会传递，你可以在throwXIO里把调用栈附加到异常上，得到最完整的调用链信息。

补充说明 #

• 类型别名XIO' a = HasCallStack => IO a之所以有效，是因为它给所有返回XIO'的函数自动加上了HasCallStack约束，每次调用这类函数都会捕获当前调用栈；而自定义data类型的构造器约束只在构造时生效，后续操作不会自动传递约束。
• 如果觉得每个实例方法加约束太繁琐，可以用ConstraintKinds定义一个别名，比如type XIOFn a = HasCallStack => XIO a，但本质还是需要在函数类型中声明。

内容的提问来源于stack exchange，提问作者carbolymer