-------------------------------------------------------------------------------
-- |
-- Module       : System.IOR.Resource
-- Copyright    : (c) Ivan Tomac 2008
-- License      : BSD3
--
-- Maintainer   : tomac `at` pacific `dot` net `dot` au
-- Stability    : experimental
--
-- Resource management in the IOR monad.
--
-------------------------------------------------------------------------------

module System.IOR.Resource (
    Resource
  , getResource

  , manage
  , release
) where

import Control.Arrow
import Control.Monad.Trans

import Data.IORef
import Data.List

import System.IOR.Internal

-- | @'manage' a f@ will create a new 'Resource' wrapper around the
-- value of type @a@ in region @r@, given a finalizer @f@.
-- Each finalizer is guaranteed to automatically be called upon exit from
-- the region.
-- Finalizers are called in the last in, first out fashion. So the finalizer
-- of the very last resource allocated will be the first to get called.
--
-- Note that finalizers must not throw any errors. Failing to ensure that
-- all errors in a finalizer are handled may result in a resource leak.

manage :: a -> (a -> IO ()) -> IOR r rs (Resource r a)
manage a f = IOR (new . unIORTag)
    where
        new ref = do
            (c, rs) <- readIORef ref
            let r = Resource a c ref (f a)
            writeIORef ref (succ c, Resource' r : rs)
            return r

-- | @'release' res@ is used to force the resource @res@ to be
-- released immediately. Finalizer for @res@ will be called and removed
-- from the stack of finalizers in region @r'@.

release :: RElem r' rs => Resource r' a -> IOR r rs ()
release r = liftIO $ do
    readIORef ref >>= writeIORef ref . (id *** delete (Resource' r))
    finalizer r
    where
        ref = tagRef r