Dependency injection in Haskell: solving the task idiomatically [closed]

Question

I think the proper answer here is, and I will probably receive a few downvotes just for saying this: forget the term dependency injection. Just forget it. It's a trendy buzzword from the OO world, but nothing more.

Let's solve the real problem. Keep in mind that you are solving a problem, and that problem is the particular programming task at hand. Don't make your problem "implementing dependency injection".

We'll take the example of a logger, because that's a basic piece of functionality many programs will want to have, and there are lots of different types of loggers: One that logs to stderr, one that logs to a file, a database, and one that simply does nothing. To unify all them you want a type:

type Logger m = String -> m ()

You could also choose a fancier type to save some keystrokes:

class PrettyPrint a where
    pretty :: a -> String

type Logger m = forall a. (PrettyPrint a) => a -> m ()

Now let's define a few loggers using the latter variant:

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

You can see how this builds a graph of dependencies. The acidLogger depends on a database connection for the MyDB database layout. Passing arguments to functions is about the most natural way to express dependencies in a program. After all a function is just a value that depends on another value. That is also true for actions. If your action depends on a logger, then naturally it is a function of loggers:

printFile :: (MonadIO m) => Logger m -> FilePath -> m ()
printFile log fp = do
    log ("Printing file: " ++ fp)
    liftIO (readFile fp >>= putStr)
    log "Done printing."

See how easy this is? At some point this makes you realize how much easier your life will be, when you just forget all the nonsense that OO has taught you.

Use pipes. I won't say it is idiomatic because the library is still relatively new, but I think it exactly solves your problem.

For example, let's say that you want to wrap an interface to some database:

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

We can then model one interface to the database:

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

You connect them like so:

runProxy $ database >-> user

This will then allow the user to interact with the database from the prompt.

We can then switch out the database with a mock database:

mockDatabase :: (Proxy p) => QueryString -> Server p QueryString Result IO r
mockDatabase = runIdentityK $ foreverK $ \query -> respond "42"

Now we can switch out the database for the mock one very easily:

runProxy $ mockDatabase >-> user

Or we can switch out the database client. For example, if we noticed a particular client session triggered some weird bug, we could reproduce it like so:

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"

... then hook it up like so:

runProxy $ database >-> reproduce

pipes lets you split out streaming or interactive behaviors into modular components so you can mix and match them however you please, which is the essence of dependency injection.

To learn more about pipes, just read the tutorial at Control.Proxy.Tutorial.

To build on ertes's answer, I think the desired signature for printFile is printFile :: (MonadIO m, MonadLogger m) => FilePath -> m (), which I read as "I will print the given file. To do so, I need to do some IO and some logging."

I am no expert, but here's my attempt at this solution. I will be grateful for comments and suggestions on how to improve this.

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

Another option is to use existentially quantified data types. Let's take XMonad as an example. There is an (frobby) interface for layouts – 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

    ...

and existential data type 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)

that can wrap any (foo or bar) instance of LayoutClass interface. It is itself a layout:

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

Now it is possible to use Layout data type generically with only LayoutClass interface methods. Appropriate layout which implements LayoutClass interface will be selected at run-time, there is a bunch of them in XMonad.Layout and in xmonad-contrib. And, of course, it is possible to switch between different layouts dynamically:

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