diff --git a/Control/Monad/Trans/Region.hs b/Control/Monad/Trans/Region.hs --- a/Control/Monad/Trans/Region.hs +++ b/Control/Monad/Trans/Region.hs @@ -32,6 +32,11 @@ -- * Duplication , dup + + -- * Handy functions for writing monadic instances + , mapRegionT + , liftCatch + -- | /TODO: define and export: /@liftCallCC@ ) where import Control.Monad.Trans.Region.Internal 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 @@ -11,6 +11,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ExistentialQuantification #-} ------------------------------------------------------------------------------- -- | @@ -24,17 +25,8 @@ -- -- See: -- --- This module should only be used by library authors wishing to allow their --- users to open their type of resources in a region. It should not be used by --- end-users directly! --- --- To create a module or library that allows your users to open your type of --- resources in a region is to define an instance for 'Resource' for your type --- of resource. --- --- Make sure not to re-export anything from this module. Either re-export things --- from @Control.Monad.Trans.Region@ or tell your users to import that module --- directly. +-- This is an internal module not intended to be exported. +-- Use @Control.Monad.Trans.Region@ or @Control.Monad.Trans.Region.Unsafe@. -- -------------------------------------------------------------------------------- @@ -85,7 +77,7 @@ import Control.Concurrent ( forkIO, ThreadId ) import Control.Applicative ( Applicative, Alternative ) import Control.Monad ( Monad, return, (>>=), fail - , (>>), when, liftM2, mapM_ + , (>>), when, liftM2, mapM_, forM_ , Functor , MonadPlus ) @@ -135,15 +127,15 @@ -- * Regions -------------------------------------------------------------------------------- -{-| A monad transformer in which resources of type @resource@ can be opened +{-| A monad transformer in which scarce resources can be opened which are automatically closed when the region terminates. Note that regions can be nested. @pr@ (for parent region) is a monad which is usually the region which is running this region. However when you are running a 'TopRegion' the parent region will be 'IO'. -} -newtype RegionT resource s (pr ∷ * → *) α = RegionT - { unRegionT :: ReaderT (IORef [Opened resource]) pr α } +newtype RegionT s (pr ∷ * → *) α = RegionT + { unRegionT ∷ ReaderT (IORef [SomeOpenedResource]) pr α } deriving ( Functor , Applicative @@ -156,10 +148,19 @@ , MonadCatchIO ) -{-| An @Opened resource@ is an internal data type which associates a handle to -the resource with a reference count. Handles are reference counted because they -may be /duplicated/ to a parent region using 'dup'. +-- | An internally used datatype which adds an existential wrapper around +-- 'OpenedResource' to hide the @resource@ type. If the @resource@ type is not +-- hidden, regions must be parameterized by it. This is undesirable because then +-- only one type of resource can be opened in a region. The following allows all +-- kinds of resources to be opened in a single region as long as they have an +-- instance for 'Resource'. +data SomeOpenedResource = ∀ resource. Resource resource + ⇒ Some (Opened resource) +{-| An @Opened resource@ is an internally used data type which associates a +handle to the resource with a reference count. Handles are reference counted +because they may be /duplicated/ to a parent region using 'dup'. + The reference count is: * Initialized at 1 in 'open'. @@ -175,16 +176,17 @@ , refCntIORef ∷ IORef Int } --- | Internal function that atomically decrements the reference count that is --- stored in the given @IORef@. The function returns the decremented reference --- count. +{-| 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) --- | Internal function that atomically increments the reference count that is --- stored in the given @IORef@. +-- | 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, ()) @@ -216,10 +218,7 @@ Note that it is possible to run a region inside another region. -} -runRegionT ∷ (Resource resource, MonadCatchIO pr) - ⇒ (∀ s. RegionT resource s pr α) -- ^ Region you wish to execute. - → pr α -- ^ Computation in the parent region which executes the given - -- region. +runRegionT ∷ MonadCatchIO pr ⇒ (∀ s. RegionT s pr α) → pr α runRegionT m = runRegionWith [] m {-| A region which has 'IO' as its parent region which enables it to be: @@ -228,16 +227,13 @@ * concurrently executed in a new thread by 'forkTopRegion'. -} -type TopRegion resource s = RegionT resource s IO +type TopRegion s = RegionT s IO {-| Convenience funtion for running a /top-level/ region in 'IO'. Note that: @runTopRegion = 'runRegionT'@ -} -runTopRegion ∷ Resource resource - ⇒ (∀ s. TopRegion resource s α) - -- ^ /Top-level/ region you wish to execute. - → IO α -- ^ An @IO@ computation which executes the given region. +runTopRegion ∷ (∀ s. TopRegion s α) → IO α runTopRegion = runRegionT {-| Return a region which executes the given /top-level/ region in a new thread. @@ -260,12 +256,7 @@ thread are closed only when the current thread or the forked thread terminates whichever comes /last/. -} -forkTopRegion ∷ (Resource resource, MonadIO pr) - ⇒ TopRegion resource s () -- ^ /Top-level/ region you wish to - -- execute in a new thread. - → RegionT resource s pr ThreadId - -- ^ A regional computation that executes the given region in a - -- new thread and returns the @ThreadId@ of this new thread. +forkTopRegion ∷ MonadIO pr ⇒ TopRegion s () → RegionT s pr ThreadId forkTopRegion m = RegionT $ do -- Get the list of currently opened resources in this region: openedResourcesIORef ← ask @@ -275,7 +266,8 @@ -- 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: - mapM_ (increment ∘ refCntIORef) openedResources + forM_ openedResources $ \(Some openedResource) → + increment $ refCntIORef $ openedResource -- Fork a new thread that will concurrently run the given region -- on the opened resources of the current region: @@ -289,12 +281,11 @@ -- count will never reach 0!) forkIO $ runRegionWith openedResources m --- | Internal function that actually runs the region on the given list of opened --- resources. -runRegionWith ∷ ∀ resource s pr α. - (MonadCatchIO pr, Resource resource) - ⇒ [Opened resource] - → RegionT resource s pr α +-- | Internally used function that actually runs the region on the given list of +-- opened resources. +runRegionWith ∷ ∀ s pr α. MonadCatchIO pr + ⇒ [SomeOpenedResource] + → RegionT s pr α → pr α runRegionWith openedResources m = bracket @@ -310,7 +301,7 @@ (runReaderT $ unRegionT m) where - end (Opened {openedHandle, refCntIORef}) = do + end (Some (Opened {openedHandle, refCntIORef})) = do refCnt ← decrement refCntIORef when (refCnt ≡ 0) $ closeResource openedHandle @@ -326,8 +317,9 @@ {-| Get the internal handle from the regional handle. -/Warning:/ This function should not be exported to end-users because it allows -them to close the handle manually! +/Warning:/ This function should not be exported to or used by end-users because +it allows them to close the handle manually, which will defeat the +safety-guarantees that this package provides! /Tip:/ If you enable the @ViewPatterns@ language extension you can use @internalHandle@ as a view-pattern as in the following example from the @@ -353,11 +345,9 @@ it was created you have to /duplicate/ the handle by applying 'dup' to it. -} open ∷ (Resource resource, MonadCatchIO pr) - ⇒ resource -- ^ The resource you wish to open. - → RegionT resource s pr - (RegionalHandle resource (RegionT resource s pr)) - -- ^ A regional computation that returns a regional handle to the given - -- opened resource parameterized by the region itself. + ⇒ resource + → RegionT s pr + (RegionalHandle resource (RegionT s pr)) open resource = block $ do -- Create a new opened resource by actually opening the resource and -- intializing the reference count to 1: @@ -385,23 +375,17 @@ Note that: @with dev f = @'runRegionT'@ (@'open'@ dev @'>>='@ f)@ -} with ∷ (Resource resource, MonadCatchIO pr) - ⇒ resource -- ^ The resource you wish to open. - → (∀ s. RegionalHandle resource (RegionT resource s pr) - → RegionT resource s pr α - ) -- ^ Continuation function. - → pr α -- ^ A computation which runs a child region which opens the given - -- resource and applies the given continuation function to the - -- resulting regional handle. + ⇒ resource + → (∀ s. RegionalHandle resource (RegionT s pr) → RegionT s pr α) + → pr α with resource f = runRegionT $ open resource >>= f --- | Internal function to /register/ the given opened resource by consing it to --- the list of opened resources of the region. -register ∷ (Resource resource, MonadIO pr) - ⇒ Opened resource - → RegionT resource s pr () +-- | 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) ⇒ Opened resource → RegionT s pr () register openedResource = RegionT $ do openedResourcesIORef ← ask - liftIO $ modifyIORef openedResourcesIORef (openedResource:) + liftIO $ modifyIORef openedResourcesIORef (Some openedResource:) -------------------------------------------------------------------------------- @@ -432,12 +416,12 @@ ...yielding the regional handle @r1h@. Note that: -@r1h :: RegionalHandle resource (RegionT resource cs (RegionT resource ps ppr))@ +@r1h :: RegionalHandle resource (RegionT cs (RegionT ps ppr))@ where @cs@ is bound by the inner (child) @runRegionT@ and @ps@ is bound by the outer (parent) @runRegionT@. -Suppose you want to use the resulting regional handle @r1h@ in the /parent/ device +Suppose you want to use the resulting regional handle @r1h@ in the /parent/ region. You can't simply @return r1h@ because then the type variable @cs@, escapes the inner region. @@ -448,20 +432,19 @@ return r1hDup @ -Note that @r1hDup :: RegionalHandle resource (RegionT resource ps ppr)@ +Note that @r1hDup :: RegionalHandle resource (RegionT ps ppr)@ Back in the parent region you can safely operate on @r1hDup@. -} -class Resource resource ⇒ Dup α resource where - dup ∷ (MonadCatchIO ppr) - ⇒ α (RegionT resource cs (RegionT resource ps ppr)) - -- ^ Something created in a child region. - → RegionT resource cs (RegionT resource ps ppr) - (α (RegionT resource ps ppr)) - -- ^ The child region which returns the thing which can now be used in - -- the parent region. +class Dup α where + dup ∷ MonadCatchIO ppr + ⇒ α (RegionT cs (RegionT ps ppr)) + → RegionT cs (RegionT ps ppr) + (α (RegionT ps ppr)) + -- The child region which returns the thing which can now be used in + -- the parent region. -instance Resource resource ⇒ Dup (RegionalHandle resource) resource where +instance Resource resource ⇒ Dup (RegionalHandle resource) where dup (RegionalHandle openedResource) = block $ do -- Increment the reference count of the given opened resource so that it -- won't get closed when the current region terminates: @@ -495,14 +478,14 @@ -- liftCallCC callCC f = RegionT $ ??? -- | Transform the computation inside a region. -mapRegionT ∷ (m α → n β) → RegionT resource s m α → RegionT resource s n β +mapRegionT ∷ (m α → n β) → RegionT s m α → RegionT s n β mapRegionT f = RegionT ∘ mapReaderT f ∘ unRegionT -- | Lift a 'catchError' operation to the new monad. -liftCatch ∷ (pr α → (e → pr α) → pr α) -- ^ @catch@ on the argument monad. - → RegionT resource s pr α -- ^ Computation to attempt. - → (e → RegionT resource s pr α) -- ^ Exception handler. - → RegionT resource s pr α +liftCatch ∷ (pr α → (e → pr α) → pr α) -- ^ @catch@ on the argument monad. + → RegionT s pr α -- ^ Computation to attempt. + → (e → RegionT s pr α) -- ^ Exception handler. + → RegionT s pr α liftCatch f m h = RegionT $ Reader.liftCatch f (unRegionT m) (unRegionT ∘ h) @@ -515,16 +498,16 @@ A region is the parent of another region if they're either equivalent like: @ -RegionT resource ps pr \`ParentOf\` RegionT resource ps pr +RegionT ps pr \`ParentOf\` RegionT ps pr @ or if it is the parent of the parent of the child like: @ -RegionT resource ps ppr \`ParentOf\` RegionT resource cs - (RegionT resource pcs - (RegionT resource ppcs - (RegionT resource ps ppr))) +RegionT ps ppr \`ParentOf\` RegionT cs + (RegionT pcs + (RegionT ppcs + (RegionT ps ppr))) @ -} class (Monad pr, Monad cr) ⇒ pr `ParentOf` cr @@ -532,7 +515,7 @@ instance Monad r ⇒ ParentOf r r instance ( Monad cr - , cr `TypeCast2` RegionT resource s pcr + , cr `TypeCast2` RegionT s pcr , pr `ParentOf` pcr ) ⇒ ParentOf pr cr diff --git a/Control/Monad/Trans/Region/Unsafe.hs b/Control/Monad/Trans/Region/Unsafe.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Trans/Region/Unsafe.hs @@ -0,0 +1,44 @@ +------------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Trans.Region.Unsafe +-- Copyright : (c) 2009 Bas van Dijk +-- License : BSD3 (see the file LICENSE) +-- Maintainer : Bas van Dijk +-- +-- /WARNING:/ This module should /not/ be used by end-users directly because it +-- allows access to the 'internalHandle' of a resource which enables them to +-- close the resource manually, which will defeat the safety-guarantees that +-- this package provides! +-- +-- This module should /only/ be used by library authors wishing to allow their +-- end-users to open their resources in a region. +-- +-- The only thing to do, to create a module or library that allows your users to +-- open your resources in a region, is to define an instance for 'Resource' for +-- your type of resource. +-- +-- Make sure not to re-export anything from this module. Either re-export things +-- from @Control.Monad.Trans.Region@ or tell your users to import that module +-- directly. +-- +-------------------------------------------------------------------------------- + +module Control.Monad.Trans.Region.Unsafe + ( -- * Scarce resources + Resource + , Handle + , openResource + , closeResource + + -- * Accessing the internal handle of a resource. + , internalHandle + + -- * Duplication + , Dup + , dup + + -- * Parent/child relationship between regions. + , ParentOf + ) where + +import Control.Monad.Trans.Region.Internal diff --git a/regions.cabal b/regions.cabal --- a/regions.cabal +++ b/regions.cabal @@ -1,5 +1,5 @@ name: regions -version: 0.1.0.1 +version: 0.2 cabal-version: >=1.6 build-type: Simple license: BSD3 @@ -35,9 +35,9 @@ . - * @Control.Monad.Trans.Region.Internal@ should only be used by library authors + * @Control.Monad.Trans.Region.Unsafe@ should only be used by library authors wishing to allow their users to open their type of resources in a region. It - should not be used by end-users directly! + should /not/ be used by end-users directly! . @@ -51,7 +51,8 @@ . - For an example of how to use this library see the @usb-safe@ package. + For an example of how to use this library see the @safer-file-handles@ or + @usb-safe@ packages. source-repository head Type: darcs @@ -64,4 +65,5 @@ , transformers >= 0.1.4 && < 0.2 , MonadCatchIO-transformers == 0.0.2.* exposed-modules: Control.Monad.Trans.Region - , Control.Monad.Trans.Region.Internal + , Control.Monad.Trans.Region.Unsafe + other-modules: Control.Monad.Trans.Region.Internal