Question

最近我一直在研究一个使用几种不同的monad变换器的项目。我厌倦了编写运行各种monad堆栈的函数，所以我决定编写一个通用函数来执行它们。它是这样的：

class MonadRun outer args inner | outer -> args, args outer -> inner where
    monadRun :: outer -> args -> inner

-- Base instances: The Identity monad can be removed, while other monads, in general, cannot
instance MonadRun (Identity a) () a where
    monadRun a _ = runIdentity a

instance (Monad m, ma ~ (m a), ma' ~ (m a), u ~ ()) => MonadRun ma u ma' where
    monadRun a _ = a

然后我有每个monad变换器的实例：

instance (MonadRun (m a) r' m') => MonadRun (ReaderT r m a) (r, r') m' where
    monadRun outer (r, r') = monadRun (runReaderT outer r) r'

其他实例只是样板文件，与ReaderT实例相同。如果我有一个monad，如

> type Test = StateT Int (ReaderT Bool IO)
>:t monadRun (undefined :: Test ())
monadRun (undefined :: Test ()) :: (Int, (Bool, ())) -> IO ((), Int)

结果函数的类型具有冗余();它应该减少到(Int, Bool) -> IO ((), Int)（如果可能的话，也应该删除返回类型中的();但这对我来说并不重要。）我可以按如下方式重新定义实例：

instance (MonadRun (m a) r' m', r'' ~ (r, r')) => MonadRun (ReaderT r m a) r'' m' where
    monadRun outer (r, r') = monadRun (runReaderT outer r) r'

instance (MonadRun (m a) () m') => MonadRun (ReaderT r m a) r m' where
    monadRun outer r = monadRun (runReaderT outer r) ()

我会得到正确的类型。现在的问题是：

1。有人写过这样的东西（运行任意monad堆栈）？如果是这样，我可以放弃我的努力。

2。可以这样写，以便从结果类型中“自动”消除单位吗？在给定的示例中，()出现在最后。但情况并非总是如此，()可以出现在堆栈中的任何位置。我尝试过做这样的事情，但无法让它发挥作用。

class Tuple a b c | a b -> c where fst' :: c -> a; snd' :: c -> b;
instance Tuple a () a ....
instance Tuple () a a ....
instance Tuple a b (a,b) ....

3。而不是一些复杂的嵌套元组类型，我可以使用不同的（更好的）异构集合吗？

For those interested, here is the complete code.

Answer 1

所以我终于得到了'工作'。首先，我使用DataKinds创建了一个异类集合：

infixr 7 :>
data Args (xs :: [*]) where
    None :: Args '[]
    (:>) :: x -> Args xs -> Args (x ': xs) 

type family Concat (a :: [*]) (b :: [*]) :: [*]
type instance Concat '[] ys = ys
type instance Concat (x ': xs) ys = x ': (Concat xs ys)

concatArgs :: Args xs -> Args ys -> Args (Concat xs ys)
concatArgs None x = x
concatArgs (x :> xs) ys = x :> concatArgs xs ys

然后是一个运行单级monad的类：

class Rule tyCons m input fr res | tyCons -> m input fr res where
    rule :: tyCons m fr -> Args input -> m (Args res)

instance Monad m => Rule (ReaderT r) m '[r] a '[a] where 
    rule m (r :> None) = liftM (:> None) $ runReaderT m r
    rule _ _ = undefined

instance Monad m => Rule (WS.WriterT w) m '[] a '[a, w] where
    rule m _ = liftM (\(x,y) -> x:>y:>None) $ WS.runWriterT m

然后一个用于排序规则：

class RunRules input args output | input -> args, args input -> output where
    runRules :: input -> Args args -> output

-- base case
instance (Monad m, ma ~ (m a), u ~ '[], mar ~ (m (Args ar)),
          RemU a ar  -- if a == () then '[] else '[a]
         ) => RunRules ma u mar where
    runRules a _ = liftM remU a

-- recursive case
instance 
    ( Rule tyCon0 m0 arg0 fr0 out0, RunRules (m0 (Args out0)) arg1 (m1 f), UnpackArgs f f'
    , args ~ Concat arg0 arg1, From arg0 args arg0 arg1
    , Monad m1
    ) => RunRules (tyCon0 m0 fr0) args (m1 f')  where
        runRules input args = liftM unpackArgs $ runRules (rule input arg0) arg1
          where (arg0, arg1) = from (Proxy :: Proxy arg0) args

从异构集合中删除单元

1 个答案: