依赖注入的惯用Haskell解决方案是什么?
例如,假设您有一个接口frobby
,并且您需要传递符合frobby
的实例(这些实例可能有多种类型,例如foo
,以及bar
)。
典型的操作是:
取值X
并返回值Y
的函数。例如,这可能是一个数据库访问器,采用SQL查询&连接器并返回数据集。您可能需要实现postgres,mysql和模拟测试系统。
带有一些值Z
并返回与Z
相关的闭包的函数,专门用于在运行时选择的给定foo
或bar
样式。 / p>
一个人解决了这个问题如下:
http://mikehadlow.blogspot.com/2011/05/dependency-injection-haskell-style.html
但我不知道这是否是管理此任务的规范方法。
答案 0 :(得分:105)
我认为这里的答案是正确的,我可能只会因为这样说而收到一些downvotes:忘记术语依赖注入。把它忘了吧。这是OO世界的时尚流行语,但仅此而已。
让我们解决真正的问题。请记住,您正在解决问题,而该问题是手头的特定编程任务。不要让你的问题“实现依赖注入”。
我们将以记录器为例,因为这是许多程序想要拥有的基本功能,并且有许多不同类型的记录器:一个记录到stderr,一个记录到文件,一个数据库,一个什么都不做的。要统一所有这些,你需要一个类型:
type Logger m = String -> m ()
你也可以选择一个发烧友类型来保存一些击键:
class PrettyPrint a where
pretty :: a -> String
type Logger m = forall a. (PrettyPrint a) => a -> m ()
现在让我们使用后一种变体定义一些记录器:
noLogger :: (Monad m) => Logger m
noLogger _ = return ()
stderrLogger :: (MonadIO m) => Logger m
stderrLogger x = liftIO . hPutStrLn stderr $ pretty x
fileLogger :: (MonadIO m) => FilePath -> Logger m
fileLogger logF x =
liftIO . withFile logF AppendMode $ \h ->
hPutStrLn h (pretty x)
acidLogger :: (MonadIO m) => AcidState MyDB -> Logger m
acidLogger db x = update' db . AddLogLine $ pretty x
您可以看到这是如何构建依赖关系图的。 acidLogger
取决于MyDB
数据库布局的数据库连接。将参数传递给函数是在程序中表达依赖关系的最自然的方式。毕竟函数只是一个依赖于另一个值的值。行动也是如此。如果您的操作依赖于记录器,那么它自然就是记录器的功能:
printFile :: (MonadIO m) => Logger m -> FilePath -> m ()
printFile log fp = do
log ("Printing file: " ++ fp)
liftIO (readFile fp >>= putStr)
log "Done printing."
看看这有多容易?在某些时候,当你忘记OO教给你的所有废话时,这会让你意识到你的生活会变得多么轻松。
答案 1 :(得分:12)
使用pipes
。我不会说它是惯用的,因为图书馆仍然相对较新,但我认为它确实解决了你的问题。
例如,假设您要将接口包装到某个数据库:
import Control.Proxy
-- This is just some pseudo-code. I'm being lazy here
type QueryString = String
type Result = String
query :: QueryString -> IO Result
database :: (Proxy p) => QueryString -> Server p QueryString Result IO r
database = runIdentityK $ foreverK $ \queryString -> do
result <- lift $ query queryString
respond result
然后我们可以为数据库建模一个接口:
user :: (Proxy p) => () -> Client p QueryString Result IO r
user () = forever $ do
lift $ putStrLn "Enter a query"
queryString <- lift getLine
result <- request queryString
lift $ putStrLn $ "Result: " ++ result
你这样连接它们:
runProxy $ database >-> user
然后,这将允许用户从提示符与数据库进行交互。
然后我们可以使用模拟数据库切换出数据库:
mockDatabase :: (Proxy p) => QueryString -> Server p QueryString Result IO r
mockDatabase = runIdentityK $ foreverK $ \query -> respond "42"
现在我们可以非常轻松地为模拟数据库切换出数据库:
runProxy $ mockDatabase >-> user
或者我们可以切换出数据库客户端。例如,如果我们注意到特定的客户端会话触发了一些奇怪的错误,我们可以像这样重现它:
reproduce :: (Proxy p) => () -> Client p QueryString Result IO ()
reproduce () = do
request "SELECT * FROM WHATEVER"
request "CREATE TABLE BUGGED"
request "I DON'T REALLY KNOW SQL"
...然后把它连接起来:
runProxy $ database >-> reproduce
pipes
允许您将流式或交互式行为拆分为模块化组件,以便您可以随意混合和匹配它们,这是依赖注入的本质。
要详细了解pipes
,请阅读Control.Proxy.Tutorial上的教程。
答案 2 :(得分:4)
根据ertes的回答,我认为printFile
所需的签名是printFile :: (MonadIO m, MonadLogger m) => FilePath -> m ()
,我将其视为&#34;我将打印给定的文件。为此,我需要做一些IO和一些日志记录。&#34;
我不是专家,但这是我尝试这个解决方案。我将很感激有关如何改进这一点的意见和建议。
{-# LANGUAGE FlexibleInstances #-}
module DependencyInjection where
import Prelude hiding (log)
import Control.Monad.IO.Class
import Control.Monad.Identity
import System.IO
import Control.Monad.State
-- |Any function that can turn a string into an action is considered a Logger.
type Logger m = String -> m ()
-- |Logger that does nothing, for testing.
noLogger :: (Monad m) => Logger m
noLogger _ = return ()
-- |Logger that prints to STDERR.
stderrLogger :: (MonadIO m) => Logger m
stderrLogger x = liftIO $ hPutStrLn stderr x
-- |Logger that appends messages to a given file.
fileLogger :: (MonadIO m) => FilePath -> Logger m
fileLogger filePath value = liftIO logToFile
where
logToFile :: IO ()
logToFile = withFile filePath AppendMode $ flip hPutStrLn value
-- |Programs have to provide a way to the get the logger to use.
class (Monad m) => MonadLogger m where
getLogger :: m (Logger m)
-- |Logs a given string using the logger obtained from the environment.
log :: (MonadLogger m) => String -> m ()
log value = do logger <- getLogger
logger value
-- |Example function that we want to run in different contexts, like
-- skip logging during testing.
printFile :: (MonadIO m, MonadLogger m) => FilePath -> m ()
printFile fp = do
log ("Printing file: " ++ fp)
liftIO (readFile fp >>= putStr)
log "Done printing."
-- |Let's say this is the real program: it keeps the log file name using StateT.
type RealProgram = StateT String IO
-- |To get the logger, build the right fileLogger.
instance MonadLogger RealProgram where
getLogger = do filePath <- get
return $ fileLogger filePath
-- |And this is how you run printFile "for real".
realMain :: IO ()
realMain = evalStateT (printFile "file-to-print.txt") "log.out"
-- |This is a fake program for testing: it will not do any logging.
type FakeProgramForTesting = IO
-- |Use noLogger.
instance MonadLogger FakeProgramForTesting where
getLogger = return noLogger
-- |The program doesn't do any logging, but still does IO.
fakeMain :: IO ()
fakeMain = printFile "file-to-print.txt"
答案 3 :(得分:3)
另一种选择是使用existentially quantified data types。我们以XMonad为例。布局有一个(frobby
)接口 - LayoutClass
类型类:
-- | Every layout must be an instance of 'LayoutClass', which defines
-- the basic layout operations along with a sensible default for each.
--
-- ...
--
class Show (layout a) => LayoutClass layout a where
...
和存在数据类型Layout:
-- | An existential type that can hold any object that is in 'Read'
-- and 'LayoutClass'.
data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)
可以包装foo
接口的任何(bar
或LayoutClass
)实例。它本身就是一个布局:
instance LayoutClass Layout Window where
runLayout (Workspace i (Layout l) ms) r = fmap (fmap Layout) `fmap` runLayout (Workspace i l ms) r
doLayout (Layout l) r s = fmap (fmap Layout) `fmap` doLayout l r s
emptyLayout (Layout l) r = fmap (fmap Layout) `fmap` emptyLayout l r
handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l
description (Layout l) = description l
现在可以通常只使用Layout
接口方法使用LayoutClass
数据类型。将在运行时选择实现LayoutClass
接口的适当布局,其中包含XMonad.Layout和xmonad-contrib中的一组。当然,可以动态地在不同的布局之间切换:
-- | Set the layout of the currently viewed workspace
setLayout :: Layout Window -> X ()
setLayout l = do
ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset
handleMessage (W.layout ws) (SomeMessage ReleaseResources)
windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }