Friday, June 28, 2013

The Resource Monad

Edit: tomejaguar points out on /r/haskell that there is a Monad instance for this type. The original version of this post said that Resource was only an Applicative. See the discussion here.

I'm writing this post to briefly share a neat trick to manage acquisition and release of multiple resources using Monads. I haven't seen this trick in the wild, so I thought it was worth mentioning.


Resources


A Resource is like a handle with built-in allocation and deallocation logic. The type of a Resource is simple:
newtype Resource a = Resource { acquire :: IO (a, IO ()) }
A Resource is an IO action which acquires some resource of type a and also returns a finalizer of type IO () that releases the resource. You can think of the a as a Handle, but it can really be anything which can be acquired or released, like a Socket or AMQP Connection.

We can also provide an exception-safe way to access a Resource using bracket:
runResource :: Resource a -> (a -> IO ()) -> IO ()
runResource resource k = bracket (acquire resource)
                                 (\(_, release) -> release)
                                 (\(a, _) -> k a)
This ensures every acquisition is paired with a release.


Theory


Resource is both a Functor and Applicative, using the following two instances:
instance Functor Resource where
    fmap f resource = Resource $ do
        (a, release) <- acquire resource
        return (f a, release)

instance Applicative Resource where
    pure a = Resource (pure (a, pure ()))
    resource1 <*> resource2 = Resource $ do
        (f, release1) <- acquire resource1
        (x, release2) <- acquire resource2 `onException` release1
        return (f x, release2 >> release1)

instance Monad Resource where
    return a = Resource (return (a, return ()))
    m >>= f = Resource $ do
        (m', release1) <- acquire m
        (x , release2) <- acquire (f m') `onException` release1
        return (x, release2 >> release1)
These two instances satisfy the Functor, Applicative, and Monad laws, assuming only that IO satisfies the Monad laws.

Examples


The classic example of a managed resource is a file:
import Resource  -- The above code
import System.IO

file :: IOMode -> FilePath -> Resource Handle
file mode path = Resource $ do
    handle <- openFile path mode
    return (handle, hClose handle)
Using the Applicative instance we can easily combine an input and output file into a single resource:
import Control.Applicative

inAndOut :: Resource (Handle, Handle)
inAndOut = (,) <$> file ReadMode "file1.txt"
               <*> file WriteMode "out.txt"
... and acquire both handles in one step using runResource:
main = runResource inAndOut $ \(hIn, hOut) -> do
    str <- hGetContents hIn
    hPutStr hOut str
The above program will copy the contents of file1.txt to out.txt:
$ cat file1.txt
Line 1
Line 2
Line 3
$ ./example
$ cat out.txt
Line 1
Line 2
Line 3
$
Even cooler, we can allocate an entire list of Handles in one fell swoop, using traverse from Data.Traversable:
import qualified Data.Traversable as T
import Control.Monad
import System.Environment

main = do
    filePaths <- getArgs
    let files :: Resource [Handle]
        files = T.traverse (file ReadMode) filePaths
    runResource files $ \hs -> do
        forM_ hs $ \h -> do
            str <- hGetContents h
            putStr str

The above program behaves like cat, concatenating the contents of all the files passed on the command line:
$ cat file1.txt
Line 1
Line 2
Line 3
$ cat file2.txt
Line 4
Line 5
Line 6
$ ./example file1.txt file2.txt file1.txt
Line 1
Line 2
Line 3
Line 4
Line 5
Line 6
Line 1
Line 2
Line 3
$
The above example is gratuitous because we could have acquired just one handle at a time. However, you will appreciate how useful this is if you ever need to acquire multiple managed resources in an exception-safe way without using Resource.


Conclusion


I haven't seen this in any library on Hackage, so if there is any interest in this abstraction I can package it up into a small library. I can see this being used when you can't predict in advance how many resources you will need to acquire or as a convenient way to bundle multiple managed resources into a single data type.


Appendix


I've included code listings for the above examples so people can experiment with them:
-- Resource.hs

module Resource where

import Control.Applicative (Applicative(pure, (<*>)))
import Control.Exception (bracket, onException)

newtype Resource a = Resource { acquire :: IO (a, IO ()) }

instance Functor Resource where
    fmap f resource = Resource $ do
        (a, release) <- acquire resource
        return (f a, release)

instance Applicative Resource where
    pure a = Resource (pure (a, pure ()))
    resource1 <*> resource2 = Resource $ do
        (f, release1) <- acquire resource1
        (x, release2) <- acquire resource2 `onException` release1
        return (f x, release2 >> release1)

instance Monad Resource where
    return a = Resource (return (a, return ()))
    m >>= f = Resource $ do
        (m', release1) <- acquire m
        (x , release2) <- acquire (f m') `onException` release1
        return (x, release2 >> release1

runResource :: Resource a -> (a -> IO ()) -> IO ()
runResource resource k = bracket (acquire resource)
                                 (\(_, release) -> release)
                                 (\(a, _) -> k a)
-- example.hs

import Control.Applicative
import Control.Monad
import qualified Data.Traversable as T
import Resource
import System.Environment
import System.IO

file :: IOMode -> FilePath -> Resource Handle
file mode path = Resource $ do
    handle <- openFile path mode
    return (handle, hClose handle)

inAndOut :: Resource (Handle, Handle)
inAndOut =
    (,) <$> file ReadMode "file1.txt"
        <*> file WriteMode "out.txt"

main = runResource inAndOut $ \(hIn, hOut) -> do
    str <- hGetContents hIn
    hPutStr hOut str

{-
main = do
    filePaths <- getArgs
    let files :: Resource [Handle]
        files = T.traverse (file ReadMode) filePaths
    runResource files $ \hs -> do
        forM_ hs $ \h -> do
            str <- hGetContents h
            putStr str
-}

No comments:

Post a Comment