使用 MTL 在 DSL 中分离关注点

Question

我正在按照提出的想法使用 monad-transformers 编写一个小型 DSL 这里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 来写期望。下面给出了一个 sn-p：

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

您可以想象，可以将更多的 DSL 添加到日志记录的组合中，并且 性能指标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 样式的类型类。 This article and Reddit discussion 是相关的。 mtl 类 MonadState s m 在 StateT 中有一个通用的哑实现，但您也可以为 ReaderT (IORef s) IO 或 CPS 变体实例化 MonadState。最终，您对如何处理效果保持抽象，您只需要处理它。

假设您编写了两个抽象的 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..