jeudi 19 janvier 2017

Separating concerns in a DSL using MTL

I'm writing a small DSL using monad-transformers following the ideas presented here here. For the sake of illustration I present a small subset 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 ()

The idea of this DSL is to be able to write API-level tests. To this end, all these actions createProject, getProjects, deleteProject will be implemented by REST calls to a web-service.

I also wrote an DSL to write expectations. An snippet is given below:

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

And you could imagine that more DSL's can be added to the mix for logging, and performance metrics see the gist linked above.

With these DSL is possible to write some simple tests like the following:

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

Two interpreters are shown below:

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)

Now to run the scenario createProjectCreates the monad transformers can be stacked in different ways. One way I found it makes sense is:

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

Which requires:

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

The problem with this is that either the instances of ProjectSeviceM have to know about ExpectationM and create instances for it, or vice-versa. These instances can be readily created by using the StandaloneDeriving extension, e.g.:

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

However it'd be nice if this could be avoided, since I'm leaking some information to either implementations of the DSL's. Can the problem above be overcome?

Aucun commentaire:

Enregistrer un commentaire