Rationale

I came across the following scenario: Given a list of resources, initialize all these resources, and give me a list of initialized handles. Think of a list of files. You want to open all the files at once, and run a handler:

main = do
  let logAndOpen fn = do
        putStrLn $ "opening " <> pack fn
        openFile fn ReadMode
      logAndClose handle = do
        putStrLn "closing handle"
  bracketList ["/tmp/foo.txt", "/tmp/baz.txt", "/tmp/bar.txt"] logAndOpen logAndClose \fileList -> do
    putStrLn "opened files"
    line <- hGetLine (head fileList)
    putStrLn $ "first line, first file: " <> pack line

Here, we open three files, /tmp/foo.txt, /tmp/baz.txt, /tmp/bar.txt, and just read a line from the first handle we get.

The function bracketList is assumed to already exist, taking a list of input values, an acquire function (in our case logAndOpen), a release function (logAndClose) as well as a function that processes the initialized list. This mimicks the bracket function in Control.Exception. I was a bit confused that the function I was seeking didn’t seem to already exist. I’m sure I missed it, but since I had a bit of time, I decided to write one myself.

First attempt

We’re after the following function:

bracketList :: [a] -> (a -> IO b) -> (b -> IO c) -> ([b] -> IO d) -> IO d
bracketList inputList acquire release withList = undefined

Ideally, we’d like to use the existing bracket:

bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c

Let’s first try with foldl':

-- foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b

bracketList inputList acquire release withList = foldl' folder [] inputList

Where

folder :: [b] -> a -> [b]

But this doesn’t work. We have to execute acquire, which is of type a -> IO b, so we have to account for IO. So maybe foldM from Control.Monad?

foldM :: (Foldable t) => (b -> a -> IO b) -> b -> t a -> IO b

Let’s try:

bracketList inputList acquire release withList = foldM folder [] inputList >>= withList

with

folder :: [b] -> a -> IO [b]
folder alreadyInited newElement =
  bracket
    (acquire newElement)
    release
    (\acquiredElement -> pure (acquiredElement : alreadyInited))

This compiles and even runs. But it doesn’t do the right thing. This will acquire the resources, release them, and then give them to the callback. Think of file handles again: we get the file handle list, close the file handles, and then call the callback to do something on the list? Doesn’t make sense. In the example code, we simply get:

/tmp/bar.txt: hGetLine: illegal operation (handle is closed)

Second, and final attempt

So, instead of using bracket, we do the bracketing ourselves:

bracketList :: forall a b c d. [a] -> (a -> IO b) -> (b -> IO c) -> ([b] -> IO d) -> IO d
bracketList inputList acquire release withList =
  let folder :: Either IOException [b] -> a -> IO (Either IOException [b])
      folder (Left e) _ = pure (Left e)
      folder (Right alreadyInited) newElement = do
        (acquire newElement >>= \newElt -> pure (Right (newElt : alreadyInited))) `catch` \e -> do
          traverse_ release alreadyInited
          pure (Left e)
   in do
        resultListOrError <- foldM folder (Right []) inputList
        case resultListOrError of
          Left e -> throw e
          Right resultList -> finally (withList (reverse resultList)) (traverse_ release resultList)

As you can see, we still use foldM, but this time short-circuiting if we encounter an error (meaning, no further elements are processed), returning either the first error that occurred, or a list of initialize values.

If we receive an error during initialization, we catch it and recover by cleaning up and returning the error as pure (Left e).

Note that this assumes the release function not to throw.

Does it work? Let’s test, assuming /tmp/baz.txt doesn’t exist, and the other two files do:

main = do
  let logAndOpen fn = do
        putStrLn $ "opening " <> pack fn
        openFile fn ReadMode
      logAndClose handle = do
        putStrLn "closing handle"
  bracketList ["/tmp/foo.txt", "/tmp/baz.txt", "/tmp/bar.txt"] logAndOpen logAndClose \fileList -> do
    putStrLn "opened files"
    line <- hGetLine (head fileList)
    putStrLn $ "first line, first file: " <> pack line

This outputs:

opening /tmp/foo.txt
opening /tmp/baz.txt
closing handle
main: /tmp/baz.txt: openFile: does not exist (No such file or directory)

which is just what we wanted.