使用MTL分离DSL中的关注点

Question

我正在使用monad-transformers编写一个小的领域特定语言，遵循这里给出的想法，here。为了说明起见，我在这里提供了一个很小的子集。

class Monad m => ProjectServiceM m where
  -- | Create a new project.
  createProject :: Text -- ^ Name of the project
                -> m Project
  -- | Fetch all the projects.
  getProjects :: m [Project]
  -- | Delete project.
  deleteProject :: Project -> m ()

这种DSL的思想是能够编写API级别的测试。为此，所有这些操作createProject、getProjects、deleteProject都将通过对web服务的REST调用来实现。

我还编写了一个DSL来编写expectations。下面给出了一个代码片段：

class (MonadError e m, Monad m) => ExpectationM e m | m -> e where
  shouldContain :: (Show a, Eq a) => [a] -> a -> m ()

您可以想象，可以将更多的领域特定语言添加到日志记录和性能指标see the gist linked above的组合中。

使用这些DSL可以编写一些简单的测试，如下所示：

createProjectCreates :: (ProjectServiceM m, ExpectationM e m) => m ()
createProjectCreates = do
  p <- createProject "foobar"
  ps <- getProjects
  ps `shouldContain` p

下面显示了两个解释器：

newtype ProjectServiceREST m a =
  ProjectServiceREST {runProjectServiceREST :: m a}
  deriving (Functor, Applicative, Monad, MonadIO)

type Error = Text
instance (MonadIO m, MonadError Text m) => ProjectServiceM (ProjectServiceREST m) where
  createProject projectName = return $ Project projectName
  getProjects = return []
  deleteProject p = ProjectServiceREST (throwError "Cannot delete")

newtype ExpectationHspec m a =
  ExpectationHspec {runExpectationHspec :: m a}
  deriving (Functor, Applicative, Monad, MonadIO)

instance (MonadError Text m, MonadIO m) => ExpectationM Text (ExpectationHspec m) where
  shouldContain xs x = if any (==x) xs
                       then ExpectationHspec $ return ()
                       else ExpectationHspec $ throwError msg
    where msg = T.pack (show xs) <> " does not contain " <> T.pack (show x)

现在，为了运行场景createProjectCreates，可以用不同的方式堆叠monad转换器。我发现它有意义的一种方式是：

runCreateProjectCreates :: IO (Either Text ())
runCreateProjectCreates = ( runExceptT
                            . runExpectationHspec
                            . runProjectServiceREST
                            ) createProjectCreates

这需要：

instance ProjectServiceM (ProjectServiceREST (ExpectationM (ExceptT Text IO)))
instance ExpectationM Text (ProjectServiceREST (ExpectationM (ExceptT Text IO)))

这样做的问题是要么ProjectSeviceM的实例必须知道ExpectationM并为其创建实例，要么反之亦然。这些实例可以通过使用StandaloneDeriving扩展轻松创建，例如：

deriving instance (ExpectationM Text m) => ExpectationM Text (ProjectServiceREST m)

然而，如果可以避免这种情况就好了，因为我正在向DSL的任何一个实现泄露一些信息。上面的问题可以克服吗？

Answer 1

monad堆栈的具体构造函数不必直接对应于mtl-style类型的类。This article and Reddit discussion是相关的。mtl类MonadState s m在StateT中有一个通用的哑巴实现，但是您也可以为MonadState实例化ReaderT (IORef s) IO或CPS变体。最终，对于如何处理效果，您仍然是抽象的，您只需要处理它。

假设你写了两个抽象的monad转换器：

newtype ProdT m a = ProdT { runProdT :: ... }
  deriving (Functor, Applicative, Monad, MonadTrans, ...)
newtype TestT m a = TestT { runTestT :: ... }
  deriving (Functor, Applicative, Monad, MonadTrans, ...)

然后定义所需的实例。您可以直接编写所需的实例，而不需要编写所有的直通实例。

顺便说一句，如果类型类是其他类的简单组合，我建议不要定义它们。的类/实例定义

class (MonadError e m, Monad m) => ExpectationM e m | m -> e where
    shouldContain :: (Show a, Eq a) => [a] -> a -> m ()

工作起来就像

shouldContain :: (MonadError e m, Show a, Eq a) => [a] -> a -> m ()

你已经有能力改变基础单子了，只要它有MonadError。一个测试实现可能是

newtype ExpectationT m e a = ExpectationT { runExpectation :: WriterT [e] m a }

instance Monad m => MonadError (ExpectationT m e) e where
    throwError = ExpectationT . tell
    -- etc..