Eff中的多个IO效果(或其他可组合效果的方式)

Question

我想尽可能地限制我的程序中的函数的效果,以便例如,如果我有一个应该查询数据库的函数我知道它不会打印删除我的文件的东西.

举一个具体的例子,假设我有一个带有"users"表的数据库.

有些函数只读取此表,有些函数是读写的.

使用mtl和变换器我可以尝试这样的事情:

data User = User { username :: String }
  deriving (Show)

class Monad m => ReadDb m where
  getUsers      :: m [User]
  getUserByName :: String -> m (Maybe User)

class Monad m => WriteDb m where
  addUser    :: String -> m ()
  removeUser :: String -> m Bool

然而,如果不是不可能的话,实现我需要的实例是棘手的.为了能够访问数据库,我需要一个SqlBackend和IO:

data SqlBackend

instance (MonadReader SqlBackend m, MonadIO m, Monad m) => ReadDb m where
  getUsers = undefined
  getUserByName = undefined

instance (MonadReader SqlBackend m, MonadIO m, Monad m) => WriteDb m where
  addUser = undefined
  removeUser = undefined

有了UndecidableInstances这工作正常.但是,假设我还需要日志记录,不,我不会收集日志[String]或类似内容.记录器应该有效地记录,并且记录消息应该实时显示.

所以我可能会这样做:

class Monad m => Log m where
  log :: String -> m ()

记录需要a Logger,所以我可以定义一个像这样的实例

data Logger

instance (MonadReader Logger m, MonadIO m, Monad m) => Log m where
  log = undefined

现在,读取db和logs的函数如下所示:

logUsers :: (ReadDb m, Log m) => m ()
logUsers = getUsers >>= log . show

但不幸的是我真的不能,因为我需要提供运行该 MonadReader SqlBackend m和MonadReader Logger m,这是因为功能依赖不可能的MonadReader r m | m -> r.

有一些解决方法(比如实现一个不同的类型类来获取 Logger和SqlBackend),但它们涉及太多的样板.

作为替代方案,我想尝试Oleg的可扩展效果库(Eff monad,在此处实现http://okmij.org/ftp/Haskell/extensible/Eff.hs).问题是,据我所知,IO中需要处理的多个效果无法以可组合的方式实现Eff.例如,Trace 库中的效果实现如下:

data Trace

runTrace :: Eff (Trace :> Void) w -> IO w

Void部分是这里的问题.在我的示例中,我想分别处理读取,写入和日志记录操作,并且函数应该能够具有允许这些效果的任何子集的细粒度类型.

这里有一件事是Free我想到的,但是我不确定如何为这些效果定义仿函数,然后组合它们以便例如日志能够调用另一个不记录但是具有相同功能的函数.效果.

所以我的问题是:如何在我的程序中获得细粒度的效果类型,以及实际构成的效果处理程序.效果处理程序应该能够在IO中运行.让我们说性能不是一个问题(所以Free等等是可以的).

Answer 1

我认为你的instance声明是错误的.

instance (MonadReader SqlBackend m, MonadIO m, Monad m) => ReadDb m

此实例将匹配所有类型构造函数m :: * -> *,如果有m问题不适合实例上下文,则稍后会失败.实例搜索中没有回溯.换句话说,您无法更改实例ReadDb(例如,如果您需要在测试期间模拟数据库).它还会导致重叠超类的问题.

最好将程序结构化为monad变换器堆栈,newtype像往常一样使用s.所以我要写下一个自定义monad变换器:

data SqlConfig = SqlConfig { connectionString :: String }

newtype DbT m a = DbT (ReaderT SqlConfig m a) deriving (
    Functor,
    Applicative,
    Alternative,
    Monad,
    MonadTrans,
    MonadPlus,
    MonadFix,
    MonadIO,
    MonadWriter w,
    MonadState s,
    MonadError e,
    MonadCont
    )
runDbT :: DbT m a -> SqlConfig -> m a
runDbT (DbT m) = runReaderT m

我正在使用GeneralizedNewtypeDeriving派生mtl类除了MonadReader.(这些实例也需要,UndecidableInstances因为它们无法覆盖条件.)我不想MonadReader从ReaderT内部提升实例DbT,我想从基础monad中提升它.DbT不是ReaderT,它恰好是使用实现ReaderT.

mapDbT :: (m a -> n b) -> DbT m a -> DbT n b
mapDbT f (DbT m) = DbT $ mapReaderT f m
instance MonadReader r m => MonadReader r (DbT m) where
    ask = lift ask
    local = mapDbT . local

DbT只要我们有权访问,我就可以使用以下方法实现您的课程IO:

instance MonadIO m => MonadReadDb (DbT m) where
    getUsers = DbT $ ask >>= (liftIO . query "select * from Users")
    getUserByName name = DbT $ ask >>= (liftIO . query "select * from Users where Name = @name")

instance MonadIO m => MonadWriteDb (DbT m) where
    addUser u = DbT $ ask >>= (liftIO . query "insert Users (Name) values @name")
    removeUser u = DbT $ ask >>= (liftIO . query "delete Users where Name = @name")

同样,我可以设置一个日志monad变换器:

data LoggingConfig = LoggingConfig { filePath :: String }

newtype LoggerT m a = LoggerT (ReaderT LoggingConfig m a) deriving (
    Functor,
    Applicative,
    Alternative,
    Monad,
    MonadTrans,
    MonadPlus,
    MonadFix,
    MonadIO,
    MonadWriter w,
    MonadState s,
    MonadError e,
    MonadCont
    )
runLoggerT :: LoggerT m a -> LoggingConfig -> m a
runLoggerT (LoggerT m) = runReaderT m

instance MonadIO m => MonadLogger (LoggerT m) where
    log msg = LoggerT $ do
        config <- ask
        liftIO $ writeFile (filePath config) msg

-- MonadReader instance omitted. It's identical to the DbT instance

令人讨厌 - 这是该mtl方法的主要缺点- 您必须编写O(n ^ 2)个实例以使这些类型组合得很好.

instance MonadLogger m => MonadLogger (DbT m) where
    log = lift . log

instance MonadReadDb m => MonadReadDb (LoggerT m) where
    getUsers = lift getUsers
    getUserByName = lift . getUserByName

instance MonadWriteDb m => MonadWriteDb (LoggerT m) where
    addUser = lift . addUser
    removeUser = lift . removeUser

-- and a bunch of identical instances for all the types in transformers

像往常一样,您可以使用三个类编写monadic程序:

myProgram :: (MonadLogger m, MonadReadDb m, MonadWriteDb m) => m ()
myProgram = do
    us <- getUsers
    log $ "removing " ++ show (length us) ++ " users"
    void $ traverse removeUser us

然后,在入口点到你的程序,当你建立并运行你的单子转换堆栈,你只要解开你LoggerT和DbTnewtypes并提供所需的配置.

runProgram :: LoggerT (DbT IO) a -> LoggingConfig -> SqlConfig -> IO a
runProgram m l s = runDbT (runLoggerT m l) s

ghci> :t runProgram myProgram
runProgram myProgram :: LoggingConfig -> SqlConfig -> IO ()