diff --git a/Control/Monad/Trans/Region/Internal.hs b/Control/Monad/Trans/Region/Internal.hs --- a/Control/Monad/Trans/Region/Internal.hs +++ b/Control/Monad/Trans/Region/Internal.hs @@ -70,17 +70,17 @@ -------------------------------------------------------------------------------- -- from base: -import Prelude ( succ, pred, fromInteger ) +import Prelude ( (+), (-), seq, fromInteger ) import Control.Concurrent ( forkIO, ThreadId ) -import Control.Applicative ( Applicative, Alternative ) +import Control.Applicative ( Applicative, Alternative, (<*>) ) import Control.Monad ( Monad, return, (>>=), fail - , (>>), when, liftM2, mapM_, forM_ - , Functor + , (>>), when, forM_ , MonadPlus ) import Control.Monad.Fix ( MonadFix ) import System.IO ( IO ) -import Data.Function ( ($) ) +import Data.Function ( ($), flip ) +import Data.Functor ( Functor, (<$>) ) import Data.Int ( Int ) import Data.IORef ( IORef, newIORef , readIORef, modifyIORef, atomicModifyIORef @@ -89,7 +89,8 @@ import Control.Monad.CatchIO ( MonadCatchIO, block, bracket ) -- from transformers: -import Control.Monad.Trans ( MonadTrans, lift, MonadIO, liftIO ) +import Control.Monad.Trans.Class ( MonadTrans, lift ) +import Control.Monad.IO.Class ( MonadIO, liftIO ) import qualified Control.Monad.Trans.Reader as R ( liftCallCC, liftCatch ) import Control.Monad.Trans.Reader ( ReaderT @@ -101,11 +102,8 @@ import Data.Function.Unicode ( (∘) ) -- from ourselves: -import Control.Resource ( Resource - , Handle - , openResource - , closeResource - ) +import Control.Resource ( Resource, Handle ) +import qualified Control.Resource as Resource ( open, close ) -------------------------------------------------------------------------------- @@ -194,22 +192,7 @@ , refCntIORef ∷ IORef Int } -{-| Internally used function that atomically decrements the reference count that -is stored in the given @IORef@. The function returns the decremented reference -count. --} -decrement ∷ IORef Int → IO Int -decrement ioRef = atomicModifyIORef ioRef $ \refCnt → - let predRefCnt = pred refCnt - in (predRefCnt, predRefCnt) --- | Internally used function that atomically increments the reference count that --- is stored in the given @IORef@. -increment ∷ IORef Int → IO () -increment ioRef = atomicModifyIORef ioRef $ \refCnt → - (succ refCnt, ()) - - -------------------------------------------------------------------------------- -- * Running regions -------------------------------------------------------------------------------- @@ -276,49 +259,44 @@ -} forkTopRegion ∷ MonadIO pr ⇒ TopRegion s () → RegionT s pr ThreadId forkTopRegion m = RegionT $ do - anyRegionalHandlesIORef ← ask + rhsIORef ← ask liftIO $ do - anyRegionalHandles ← readIORef anyRegionalHandlesIORef + rhs ← readIORef rhsIORef block $ do - -- Increment the reference count of each opened resource so that - -- when the current region terminates the resources will stay - -- open in the, to be created, thread: - forM_ anyRegionalHandles $ \(Any (RegionalHandle {refCntIORef})) → - increment refCntIORef - - -- Fork a new thread that will concurrently run the given region - -- on the opened resources of the current region: - - -- (Note that if asynchronous exceptions weren't blocked and an - -- exception is asynchronously thrown to this thread at this - -- point after incrementing the opened resource's reference - -- count but before forking of a new thread that will run the - -- given region on the opened resources, all the opened - -- resources will never get closed, because their reference - -- count will never reach 0!) - forkIO $ runRegionWith anyRegionalHandles m + forM_ rhs $ \(Any (RegionalHandle {refCntIORef})) → increment refCntIORef + forkIO $ runRegionWith rhs m -- | Internally used function that actually runs the region on the given list of -- opened resources. runRegionWith ∷ ∀ s pr α. MonadCatchIO pr ⇒ [AnyRegionalHandle] → RegionT s pr α → pr α -runRegionWith anyRegionalHandles m = - bracket - -- Create a new IORef containing the initial opened resources: - (liftIO $ newIORef anyRegionalHandles) +runRegionWith rhs = bracket (liftIO before) (liftIO ∘ after) + ∘ runReaderT ∘ unRegionT + where + before = newIORef rhs + after rhsIORef = do + rhs' ← readIORef rhsIORef + forM_ rhs' $ \(Any (RegionalHandle { internalHandle + , refCntIORef + })) → do + refCnt ← decrement refCntIORef + when (refCnt ≡ 0) $ Resource.close internalHandle - -- When the computation terminates the IORef contains a list of all - -- resources which have been opened or duplicated to this region. We - -- should decrement the reference count of each opened resource and - -- actually close the resource when it reaches 0: - (\anyRegionalHandlesIORef → liftIO - $ readIORef anyRegionalHandlesIORef >>= mapM_ end) +-- | Internally used function that atomically decrements the reference count +-- that is stored in the given @IORef@. The function returns the decremented +-- reference count. +decrement ∷ IORef Int → IO Int +decrement ioRef = do atomicModifyIORef ioRef $ \refCnt → + let refCnt' = refCnt - 1 + in (refCnt', refCnt') - (runReaderT $ unRegionT m) - where - end (Any (RegionalHandle {internalHandle, refCntIORef})) = do - refCnt ← decrement refCntIORef - when (refCnt ≡ 0) $ closeResource internalHandle +-- | Internally used function that atomically increments the reference count that +-- is stored in the given @IORef@. +increment ∷ IORef Int → IO () +increment ioRef = do refCnt' ← atomicModifyIORef ioRef $ \refCnt → + let refCnt' = refCnt + 1 + in (refCnt', refCnt') + refCnt' `seq` return () -------------------------------------------------------------------------------- @@ -340,24 +318,16 @@ → RegionT s pr (RegionalHandle resource (RegionT s pr)) open resource = block $ do - -- Create a new regional handle by actually opening the resource and - -- intializing the reference count to 1: - regionalHandle ← liftIO $ liftM2 RegionalHandle (openResource resource) - (newIORef 1) - - -- The following registers the just opened resource so that it will get closed - -- eventually: - - -- (Note that if asynchronous exceptions weren't blocked and an exception is - -- asynchronously thrown to this thread at this point after opening the - -- resource and initializing its reference count to 1 but before registering - -- the resource, the opened resource will never get closed, because its - -- reference count will never reach 0!) - register regionalHandle + rh ← liftIO $ RegionalHandle <$> Resource.open resource <*> newIORef 1 + register rh + return rh - -- Return the regional handle of which the type will be parameterized by this - -- region: - return regionalHandle +-- | Internally used function to /register/ the given opened resource by +-- /consing/ it to the list of opened resources of the region. +register ∷ (Resource resource, MonadIO pr) + ⇒ RegionalHandle resource (RegionT s pr) + → RegionT s pr () +register rh = RegionT $ ask >>= liftIO ∘ flip modifyIORef (Any rh:) {-| A convenience function which opens the given resource, applies the given continuation function to the resulting regional handle and runs the resulting @@ -371,16 +341,7 @@ → pr α with resource f = runRegionT $ open resource >>= f --- | Internally used function to /register/ the given opened resource by --- /consing/ it to the list of opened resources of the region. -register ∷ (Resource resource, MonadIO pr) - ⇒ RegionalHandle resource (RegionT s pr) - → RegionT s pr () -register regionalHandle = RegionT $ do - anyRegionalHandlesIORef ← ask - liftIO $ modifyIORef anyRegionalHandlesIORef (Any regionalHandle:) - -------------------------------------------------------------------------------- -- * Duplication -------------------------------------------------------------------------------- @@ -437,26 +398,10 @@ instance Resource resource ⇒ Dup (RegionalHandle resource) where dup (RegionalHandle {internalHandle, refCntIORef}) = block $ do - -- Increment the reference count of the given opened resource so that it - -- won't get closed when the current region terminates: liftIO $ increment refCntIORef - - -- The following registers the opened resource in the parent region so - -- that it will get closed eventually: - - let duppedRegionalHandle = RegionalHandle internalHandle refCntIORef - - -- (Note that if asynchronous exceptions weren't blocked and an exception - -- is asynchronously thrown to this thread at this point after - -- incrementing the opened resource's reference count but before - -- registering it in the parent, the opened resource will never get - -- closed, because its reference count will never reach 0!) - lift $ register duppedRegionalHandle - - -- Return a new regional handle containing the given opened resource. The - -- type of the regional handle will be parameterized by the parent of this - -- region. - return duppedRegionalHandle + let rh = RegionalHandle internalHandle refCntIORef + lift $ register rh + return rh -------------------------------------------------------------------------------- diff --git a/Control/Resource.hs b/Control/Resource.hs --- a/Control/Resource.hs +++ b/Control/Resource.hs @@ -7,17 +7,19 @@ -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk -- --- Unsafely opening and closing of scarce resources. +-- /Unsafely/ opening and closing of scarce resources. -- -------------------------------------------------------------------------------- module Control.Resource ( Resource , Handle - , openResource - , closeResource + , open + , close ) where + +-- from base: import System.IO ( IO ) {-| Class of /scarce/ resources. A scarce resource is a resource that only one @@ -31,17 +33,19 @@ class Resource resource where data Handle resource ∷ * - -- | Yield an @IO@ computation that opens the given resource and returns a - -- @Handle@ on it. - -- - -- Think of a handle as your private session with the resource. As long as - -- you have it, other users can't use the resource. So don't forget to close - -- this session with the resource as soon as you're done with it. - openResource ∷ resource → IO (Handle resource) + {-| Yield an @IO@ computation that opens the given resource and returns a + @Handle@ on it. - -- | Yield an @IO@ computation that closes the resource identified by the - -- given @Handle@. - -- - -- /Warning/: Using the @Handle@ after the resource has been closed will - -- usually throw an exception or result in a program crash! - closeResource ∷ Handle resource → IO () + Think of a handle as your private session with the resource. As long as + you have it, other users can't use the resource. So don't forget to close + this session with the resource as soon as you're done with it. + -} + open ∷ resource → IO (Handle resource) + + {-| Yield an @IO@ computation that closes the resource identified by the + given @Handle@. + + /Warning/: Using the @Handle@ after the resource has been closed will + usually throw an exception or result in a program crash! + -} + close ∷ Handle resource → IO () diff --git a/Data/RegionRef.hs b/Data/RegionRef.hs --- a/Data/RegionRef.hs +++ b/Data/RegionRef.hs @@ -41,7 +41,7 @@ import Data.Function.Unicode ( (∘) ) -- from transformers: -import Control.Monad.Trans ( MonadIO, liftIO ) +import Control.Monad.IO.Class ( MonadIO, liftIO ) -- from ourselves: import Control.Monad.Trans.Region ( RegionT, ParentOf ) diff --git a/regions.cabal b/regions.cabal --- a/regions.cabal +++ b/regions.cabal @@ -1,5 +1,5 @@ name: regions -version: 0.4 +version: 0.5 cabal-version: >=1.6 build-type: Simple license: BSD3 @@ -12,35 +12,24 @@ synopsis: Provides the region monad for safely opening and working with scarce resources. description: - This package provides the region monad transformer. Scarce resources like files, memory pointers or USB devices for example can be opened in a region. When the region terminates, all opened resources will be automatically closed. The main advantage of regions is that the opened resources can not be returned from the region which ensures no I/O with closed resources is possible. - . - The primary technique used in this package is called \"Lightweight monadic regions\" which was invented by Oleg Kiselyov and Chung-chieh Shan. See: - . - - . - Also see the @regions-monadsfd@ and @regions-monadstf@ packages which provide instances for the classes in the respected monads packages. - . - For an example on how to use this library see the @safer-file-handles@, @usb-safe@ or @regional-pointers@ packages. - . - Note that if you want to open /your/ type of scarce resource in a region, the only thing you have to do is define an instance for the @Resource@ class (which you can find in: @Control.Resource@). @@ -52,9 +41,9 @@ Library GHC-Options: -Wall build-depends: base >= 4 && < 4.3 - , base-unicode-symbols >= 0.1.1 && < 0.2 - , transformers >= 0.1.4 && < 0.2 - , MonadCatchIO-transformers >= 0.0.2.0 && < 0.1 + , base-unicode-symbols >= 0.1.1 && < 0.3 + , transformers >= 0.2 && < 0.3 + , MonadCatchIO-transformers >= 0.2 && < 0.3 exposed-modules: Control.Resource Control.Monad.Trans.Region Control.Monad.Trans.Region.Unsafe