haskell - 使用 MTL 在 DSL 中分离关注点

Question

我正在按照提出的想法使用 monad-transformers 编写一个小型 DSL这里here .为了illustration 我在这里展示了一小部分。

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来写期望。下面给出了一个片段:

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 中有一个通用的哑实现，但您可以为 实例化 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 ()

你已经拥有改 rebase 础 monad 的能力，只要它有 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..