Инъекция зависимостей в Haskell: решение задачи идиоматически

использовать 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, просто прочитайте учебник по адресу управление.Полномочие.Учебник.

построить на ответ эртес, я думаю, что нужные подписи для printFile и printFile :: (MonadIO m, MonadLogger m) => FilePath -> m (), который я читаю как "я буду печатать данный файл. Для этого мне нужно сделать некоторые IO и некоторые журналы."

Я не эксперт, но вот моя попытка этого решения. Я буду признателен за комментарии и предложения о том, как это улучшить.

{-# 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"

другой вариант-использовать экзистенциально количественно типов данных. Давайте возьмем XMonad в качестве примера. Существует () для макетов – LayoutClass typeclass:

-- | 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

    ...

и экзистенциальный тип данных планировка:

-- | 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.Макет и 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 } } }