如何在类型层面区分两类函数并实现Unwrap转换类？

需求概述 #

我们需要将任意参数个数的、以环境作为第一个参数的函数：

Monad f => env -> f z
Monad f => env -> a -> f z
Monad f => env -> a -> b -> f z

转换为基于MonadReader的风格：

MonadReader env m => m z
MonadReader env m => a -> m z
MonadReader env m => a -> b -> m z

当前实现尝试 #

我尝试通过定义辅助类型族和类型类来实现这个转换，但遇到了实例重叠的问题。以下是初始实现代码：

{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}

import           Control.Monad.Reader
import           Data.Kind

(&>>) :: Functor f => f (p -> b) -> p -> f b
ff &>> x = ff <&> ($ x)
infixl 4 &>>

-- 提取MonadReader的环境类型
type family RdType a where
  RdType (r -> a) = r

-- 定义转换后的函数类型
type family RetType a where
  RetType (r -> a -> b -> c -> m d) = a -> b -> c -> m d
  RetType (r -> a -> b -> m c) = a -> b -> m c
  RetType (r -> a -> m b) = a -> m b
  RetType (r -> m a) = m a

-- 捕获任意参数个数的函数的类型类
class (MonadReader (RdType a) m, RetType a ~ b) => Unwrap a b m | a b -> m where
  unwrap :: a -> b

-- INSTANCE #1：单参数+环境的情况
-- instance (RetType (r -> a -> m b) ~ (a -> m b), MonadReader r m) => Unwrap (r -> a -> m b) (a -> m b) m where
--   unwrap f a = join $ asks f &>> a

-- INSTANCE #2：双参数+环境的情况
instance (RetType (r -> a -> b -> m c) ~ (a -> b -> m c), MonadReader r m) => Unwrap (r -> a -> b -> m c) (a -> b -> m c) m where
  unwrap f a b = join $ asks f &>> a &>> b

遇到的问题 #

取消注释INSTANCE #1后，使用以下代码会触发类型错误：

data SomeEnv
f1 ::  Functor m => SomeEnv -> Int -> String -> m ()
f1 = undefined

-- 错误发生在这里
x :: MonadReader SomeEnv m => m ()
x = unwrap f1 1 "asdf"

错误信息：

• Couldn't match type ‘[Char]’ with ‘SomeEnv’
    arising from a functional dependency between:
      constraint ‘MonadReader SomeEnv ((->) String)’
        arising from a use of ‘unwrap’
      instance ‘MonadReader r ((->) r)’ at <no location info>
• In the expression: unwrap f1 1 "asdf"
  In an equation for ‘x’: x = unwrap f1 1 "asdf"

问题根源在于INSTANCE #1的类型模式r -> a -> m b会错误匹配r -> a -> b -> m c（把b推断为b -> m c），导致实例重叠，打乱了类型推断逻辑。

使用示例参考 #

以下是预期的unwrap使用场景：

data Env m = Env { logger :: Logger m }
data Logger m = Logger { flush :: m (), logAt :: Int -> String -> m () }

type AppEnv = Env App
newtype App a = App { unApp :: ReaderT AppEnv IO a }
  deriving (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv)

myApp :: App ()
myApp = do
  logInfo "fooo"
  unwrap (flush . logger)

logInfo :: MonadReader AppEnv m => String -> m ()
logInfo txt = (logAt . logger) `unwrap` 1 txt

解决方案：递归式类型类实例 #

要解决实例重叠问题，我们可以采用递归式的类型类实例，自动处理任意个数的参数，无需手动枚举每个参数数量的情况：

{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

import Control.Monad.Reader
import Data.Kind

-- 辅助运算符：将函数应用到函子内的函数上
(&>>) :: Functor f => f (p -> b) -> p -> f b
ff &>> x = ff <&> ($ x)
infixl 4 &>>

-- 提取函数的环境参数类型
type family EnvType a where
  EnvType (r -> a) = r

-- 定义转换后的目标类型：递归剥离环境参数后的函数类型
type family UnwrappedType a where
  UnwrappedType (r -> m z) = m z
  UnwrappedType (r -> a -> rest) = a -> UnwrappedType (r -> rest)

-- 核心类型类：关联原函数类型、目标Monad类型
class MonadReader (EnvType a) m => Unwrap a m | a -> m where
  unwrap :: a -> UnwrappedType a

-- 基础实例：无额外参数的情况（仅环境+Monad返回）
instance MonadReader r m => Unwrap (r -> m z) m where
  unwrap f = asks f >>= id

-- 递归实例：带额外参数的情况，逐步剥离参数后递归处理
instance (Unwrap (r -> rest) m) => Unwrap (r -> a -> rest) m where
  unwrap f a = unwrap (\r -> f r a)

原理说明 #

1. 递归类型族UnwrappedType：自动递归处理函数参数，直到最终得到Monad类型的返回值。
2. 递归类实例：每次将第一个非环境参数应用到函数上，生成一个新的r -> rest类型的函数，然后递归调用unwrap，直到只剩下环境参数和Monad返回值，触发基础实例。

验证代码 #

现在之前的错误案例可以正常运行：

data SomeEnv
f1 :: Functor m => SomeEnv -> Int -> String -> m ()
f1 = undefined

x :: MonadReader SomeEnv m => m ()
x = unwrap f1 1 "asdf" -- 无类型错误

适配原有使用示例 #

调整后的unwrap可以直接适配原有的使用场景，甚至支持更多参数的函数：

data Env m = Env { logger :: Logger m }
data Logger m = Logger { flush :: m (), logAt :: Int -> String -> m () }

type AppEnv = Env App
newtype App a = App { unApp :: ReaderT AppEnv IO a }
  deriving (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv)

-- 定义中缀版本保持原有写法习惯
infixl 0 `unwrapF`
unwrapF :: (Unwrap a m) => a -> UnwrappedType a
unwrapF = unwrap

myApp :: App ()
myApp = do
  logInfo "fooo"
  unwrap (flush . logger)

logInfo :: MonadReader AppEnv m => String -> m ()
logInfo txt = (logAt . logger) `unwrapF` 1 txt -- 和原有写法一致

总结 #

通过递归式的类型类实例和类型族，我们可以完美区分不同参数个数的函数，避免实例重叠问题，同时支持任意数量的参数转换，完全满足需求。

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