这是我将采取的方法。根据@Carl 的回答，我将通过使用由类型“标签”参数化的 GADT 在类型级别区分“A”和“B”环境。为标签使用一对空类型（data Aand data B，就像@Carl 所做的那样）有效，但我更喜欢使用DataKinds它，因为它使意图更清晰。
以下是预赛：
{-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns #-}
{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
import Control.Monad.Reader
import Control.Monad.Random
这是环境类型的定义：
data EnvType = A | B
data Environment (e :: EnvType) where
EnvironmentA :: Integer -> Environment 'A
EnvironmentB :: Integer -> Environment 'B
在这里，不同的环境碰巧具有相同的内部结构（即，它们每个都包含一个Integer），但并不要求它们必须这样做。
我将做一个简化的假设，即您的 monad 始终将环境ReaderT作为最外层，但我们将在基本 monad 中保持多态性（因此您可以使用IO或Gen提供随机性）。您可以改用约束来完成所有这些操作MonadReader，但是由于一些晦涩的技术原因，事情变得更加复杂（如果您真的需要这个，请添加评论，我会尝试发布补充答案）。也就是说，对于任意基础 monad b，我们将在 monad 中工作：
type E e b = ReaderT (Environment e) b
现在，我们可以mainMonad如下定义动作。请注意没有MonadReader约束，因为这是由E e b Type签名处理的。对基本 monad的MonadRandom b约束确保E e b它将有一个MonadRandom实例。因为签名E e b Type在 中是多态的e :: EnvType，所以mainMonad可以在任何类型的环境中工作。通过环境 GADT 上的大小写匹配，它可以将约束e ~ 'A等带入范围，允许它分派到monadA等。
data Type = Type [String] -- some return type
mainMonad ::
( MonadRandom b )
=> E e b Type
mainMonad = do
env <- ask
case env of
EnvironmentA _ -> monadA
EnvironmentB _ -> monadB
monadA和的类型签名monadB相似，尽管它们修复了EnvType：
monadA ::
( MonadRandom b )
=> E 'A b Type
monadB ::
( MonadRandom b )
=> E 'B b Type
该monadA动作可以调用 A-specifichelperA以及 common helper：
monadA = do
result1 <- helperA
result2 <- helper
return $ Type [result1, result2]
助手可以使用这些MonadRandom设施并使用环境getData中的案例匹配等功能检查环境。
helperA :: (Monad b) => E 'A b String -- we don't need MonadRandom on this one
helperA = do
n <- asks getData
return $ show n
helper :: (MonadRandom b) => E e b String
helper = do
n <- asks getData
x <- getRandomR (0,n)
return $ show x
getData :: Environment e -> Integer
getData (EnvironmentA x) = x
getData (EnvironmentB x) = x
也可以直接在环境中进行大小写匹配。在通用助手中，所有环境类型都需要处理，但在EnvType特定助手中，只EnvType需要处理（即，模式匹配将是详尽的，因此即使使用-Wall，也不会生成有关不匹配情况的警告）：
helper2 :: (Monad b) => E e b String
helper2 = do
env <- ask
case env of
-- all cases must be handled or you get "non-exhaustive" warnings
EnvironmentA n -> return $ show n ++ " with 'A'-appropriate processing"
EnvironmentB n -> return $ show n ++ " with 'B'-appropriate processing"
helperA2 :: (Monad b) => E 'A b String
helperA2 = do
env <- ask
case env of
-- only A-case need be handled, and trying to match B-case generates warning
EnvironmentA n -> return $ show n
该monadB操作可以调用通用助手，并可以monadA通过适当的withReaderT调用进行调度。
monadB = do
Type start <- withReaderT envBtoA monadA
result <- helper
return $ Type $ start ++ [result]
envBtoA :: Environment 'B -> Environment 'A
envBtoA (EnvironmentB x) = EnvironmentA x
当然，最重要的是，您不能意外地从 B 类操作调用 A 类操作：
badMonadB ::
( MonadRandom b )
=> E 'B b Type
badMonadB = do
monadA -- error: couldn't match A with B
您也不能不小心从通用助手调用 A 类型操作：
-- this is a common helper
badHelper :: (Monad b) => E e b String
badHelper = do
-- so it can't assume EnvironmentA is available
helperA -- error: couldn't match "e" with B
尽管您可以使用大小写匹配来检查适当的环境，然后分派：
goodHelper :: (Monad b) => E e b String
goodHelper = do
env <- ask
case env of
EnvironmentA _ -> helperA -- if we're "A", it's okay
_ -> return "default"
我觉得我应该指出 @DanielWagner 的解决方案的相对优缺点（我认为你误解了）。
他的解决方案：
- 确实提供类型安全。如果您尝试坚持
res <- monadB的定义monadA，它将不会进行类型检查。
- 正如所写的那样，没有提供一种机制来定义访问环境的通用帮助函数（只需要的通用帮助函数就
MonadRandom可以正常工作），但这可以通过引入一个带有实例的类型类来完成，EnvironmentA并EnvironmentB提供方法来做任何事情允许普通助手处理环境
- 需要对环境进行特殊处理
mainMonad（尽管有一些关于为什么首先需要的问题mainMonad）
- 避免高级类型级别的技巧，因此可能更容易使用
- 我相信每个环境转换都会增加一个额外的
ReaderT层，因此如果存在深度递归 A-to-B-to-A-to-B 嵌套，可能会导致运行时损失。
要并排查看它们，这是我的完整解决方案：
{-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns #-}
{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
import Control.Monad.Reader
import Control.Monad.Random
data EnvType = A | B
data Environment (e :: EnvType) where
EnvironmentA :: Integer -> Environment 'A
EnvironmentB :: Integer -> Environment 'B
getData :: Environment e -> Integer
getData (EnvironmentA x) = x
getData (EnvironmentB x) = x
type E e b = ReaderT (Environment e) b
data Type = Type [String] -- some return type
mainMonad :: (MonadRandom b) => E e b Type
mainMonad = do
env <- ask
case env of
EnvironmentA _ -> monadA
EnvironmentB _ -> monadB
monadA :: (MonadRandom b) => E 'A b Type
monadA = do
result1 <- helperA
result2 <- helper
return $ Type [result1, result2]
monadB :: (MonadRandom b) => E 'B b Type
monadB = do
Type start <- withReaderT envBtoA monadA
result <- helper
return $ Type $ start ++ [result]
envBtoA :: Environment 'B -> Environment 'A
envBtoA (EnvironmentB x) = EnvironmentA x
helperA :: (Monad b) => E 'A b String -- we don't need MonadRandom on this one
helperA = do
n <- asks getData
return $ show n
helper :: (MonadRandom b) => E e b String
helper = do
n <- asks getData
x <- getRandomR (0,n)
return $ show x
这是他的一个版本：
{-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns #-}
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Reader
import Control.Monad.Random
data EnvType = A | B
data EnvironmentMain = EnvironmentMain EnvType Integer
data EnvironmentA = EnvironmentA Integer
data EnvironmentB = EnvironmentB Integer
class Environment e where getData :: e -> Integer
instance Environment EnvironmentA where getData (EnvironmentA n) = n
instance Environment EnvironmentB where getData (EnvironmentB n) = n
convertAToB :: EnvironmentA -> EnvironmentB
convertAToB (EnvironmentA x) = EnvironmentB x
convertBToA :: EnvironmentB -> EnvironmentA
convertBToA (EnvironmentB x) = EnvironmentA x
data Type = Type [String] -- some return type
mainMonad :: (MonadReader EnvironmentMain m, MonadRandom m) => m Type
mainMonad = do
env <- ask
case env of
EnvironmentMain A n -> runReaderT monadA (EnvironmentA n)
EnvironmentMain B n -> runReaderT monadB (EnvironmentB n)
monadA :: (MonadReader EnvironmentA m, MonadRandom m) => m Type
monadA = do
result1 <- helperA
result2 <- helper
return $ Type $ [result1] ++ [result2]
monadB :: (MonadReader EnvironmentB m, MonadRandom m) => m Type
monadB = do
env <- ask
Type start <- runReaderT monadA (convertBToA env)
result <- helper
return $ Type $ start ++ [result]
helperA :: (MonadReader EnvironmentA m) => m String
helperA = do
EnvironmentA n <- ask
return $ show n
helper :: (Environment e, MonadReader e m, MonadRandom m) => m String
helper = do
n <- asks getData
x <- getRandomR (0,n)
return $ show x