regions 0.2 → 0.3
raw patch · 4 files changed
+129/−123 lines, 4 files
Files
- Control/Monad/Trans/Region.hs +4/−0
- Control/Monad/Trans/Region/Internal.hs +118/−110
- Control/Monad/Trans/Region/Unsafe.hs +5/−11
- regions.cabal +2/−2
Control/Monad/Trans/Region.hs view
@@ -31,7 +31,11 @@ , with -- * Duplication+ , Dup , dup++ -- * Parent/child relationship between regions.+ , ParentOf -- * Handy functions for writing monadic instances , mapRegionT
Control/Monad/Trans/Region/Internal.hs view
@@ -1,17 +1,19 @@-{-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverlappingInstances #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE UnicodeSyntax+ , NoImplicitPrelude+ , GeneralizedNewtypeDeriving+ , RankNTypes+ , ScopedTypeVariables+ , KindSignatures+ , TypeFamilies+ , MultiParamTypeClasses+ , FunctionalDependencies+ , UndecidableInstances+ , FlexibleInstances+ , OverlappingInstances+ , NamedFieldPuns+ , ExistentialQuantification+ , ViewPatterns+ #-} ------------------------------------------------------------------------------- -- |@@ -45,13 +47,16 @@ , TopRegion , runTopRegion+ , forkTopRegion -- * Opening resources , RegionalHandle+ , internalHandle- , open+ , mapInternalHandle + , open , with -- * Duplication@@ -135,7 +140,7 @@ 'TopRegion' the parent region will be 'IO'. -} newtype RegionT s (pr ∷ * → *) α = RegionT- { unRegionT ∷ ReaderT (IORef [SomeOpenedResource]) pr α }+ { unRegionT ∷ ReaderT (IORef [AnyRegionalHandle]) pr α } deriving ( Functor , Applicative@@ -148,34 +153,62 @@ , MonadCatchIO ) --- | 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 internally used datatype which adds an existential wrapper around a+-- 'RegionalHandle' 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 types of resources to be opened in a+-- single region as long as they have an instance for 'Resource'.+data AnyRegionalHandle = ∀ resource (r ∷ * → *). Resource resource+ ⇒ Any (RegionalHandle resource r) -{-| 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'.+-- | A handle to an opened resource parameterized by the @resource@ and the+-- region @r@ in which it was created.+data RegionalHandle resource (r ∷ * → *) = RegionalHandle+ { {-| Get the internal handle from the given regional handle. -The reference count is:+ /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! - * Initialized at 1 in 'open'.+ /Tip:/ If you enable the @ViewPatterns@ language extension you can use+ @internalHandle@ as a view-pattern as in the following example from the+ @usb-safe@ package: - * Incremented in 'dup'.+ @+ resetDevice :: (pr \`ParentOf\` cr, MonadIO cr)+ -> RegionalHandle USB.Device pr -> cr ()+ resetDevice (internalHandle -> (DeviceHandle ...)) = ...+ @+ -}+ internalHandle ∷ Handle resource - * Decremented on termination of 'runRegionWith'- (which is called by 'runRegionT' and 'forkTopRegion').+ {-| Get the reference count from the given regional handle. -Only when the reference count reaches 0 will the resource actually be closed.--}-data Opened resource = Opened { openedHandle ∷ Handle resource- , refCntIORef ∷ IORef Int- }+ Handles are reference counted because they may be /duplicated/+ to a parent region using 'dup'. + The reference count is:++ * Initialized at 1 in 'open'.++ * Incremented in 'dup'.++ * Decremented on termination of 'runRegionWith'+ (which is called by 'runRegionT' and 'forkTopRegion').++ Only when the reference count reaches 0 will the resource actually be+ closed.+ -}+ , refCntIORef ∷ IORef Int+ }++-- | Modify the internal handle from the given regional handle.+mapInternalHandle ∷ (Handle resource1 → Handle resource2)+ → (RegionalHandle resource1 r → RegionalHandle resource2 r)+mapInternalHandle f rh = rh { internalHandle = f $ internalHandle rh }+ {-| Internally used function that atomically decrements the reference count that is stored in the given @IORef@. The function returns the decremented reference count.@@ -258,82 +291,55 @@ -} 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- liftIO $ do openedResources ← readIORef openedResourcesIORef-- 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_ openedResources $ \(Some openedResource) →- increment $ refCntIORef $ openedResource+ anyRegionalHandlesIORef ← ask+ liftIO $ do+ anyRegionalHandles ← readIORef anyRegionalHandlesIORef+ 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:+ -- 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 openedResources m+ -- (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 -- | 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 =+ ⇒ [AnyRegionalHandle] → RegionT s pr α → pr α+runRegionWith anyRegionalHandles m = bracket -- Create a new IORef containing the initial opened resources:- (liftIO $ newIORef openedResources)+ (liftIO $ newIORef anyRegionalHandles) -- 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:- (\openedResourcesIORef → liftIO- $ readIORef openedResourcesIORef >>= mapM_ end)+ (\anyRegionalHandlesIORef → liftIO+ $ readIORef anyRegionalHandlesIORef >>= mapM_ end) (runReaderT $ unRegionT m) where- end (Some (Opened {openedHandle, refCntIORef})) = do+ end (Any (RegionalHandle {internalHandle, refCntIORef})) = do refCnt ← decrement refCntIORef- when (refCnt ≡ 0) $ closeResource openedHandle+ when (refCnt ≡ 0) $ closeResource internalHandle -------------------------------------------------------------------------------- -- * Opening resources -------------------------------------------------------------------------------- --- | A handle to an opened resource parameterized by the @resource@ and the--- region @r@ in which it was created.-newtype RegionalHandle resource (r ∷ * → *) = RegionalHandle- { unRegionalHandle ∷ Opened resource }--{-| Get the internal handle from the regional handle.--/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-@usb-safe@ package:--@-resetDevice :: (pr \`ParentOf\` cr, MonadIO cr)- -> RegionalHandle USB.Device pr -> cr ()-resetDevice (internalHandle -> (DeviceHandle ...)) = ...-@--}-internalHandle ∷ RegionalHandle resource r → Handle resource-internalHandle = openedHandle ∘ unRegionalHandle- {-| Open the given resource in a region yielding a regional handle to it. Note that the returned regional handle is parameterized by the region in which@@ -349,10 +355,10 @@ → RegionT s pr (RegionalHandle resource (RegionT s pr)) open resource = block $ do- -- Create a new opened resource by actually opening the resource and+ -- Create a new regional handle by actually opening the resource and -- intializing the reference count to 1:- openedResource ← liftIO $ liftM2 Opened (openResource resource)- (newIORef 1)+ regionalHandle ← liftIO $ liftM2 RegionalHandle (openResource resource)+ (newIORef 1) -- The following registers the just opened resource so that it will get closed -- eventually:@@ -362,17 +368,17 @@ -- 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 openedResource+ register regionalHandle - -- Return a regional handle containing the just opened resource. The type of- -- the regional handle will be parameterized by this region:- return $ RegionalHandle openedResource+ -- Return the regional handle of which the type will be parameterized by this+ -- region:+ return regionalHandle {-| A convenience function which opens the given resource, applies the given continuation function to the resulting regional handle and runs the resulting region. -Note that: @with dev f = @'runRegionT'@ (@'open'@ dev @'>>='@ f)@+Note that: @with resource f = 'runRegionT' ('open' resource '>>=' f)@. -} with ∷ (Resource resource, MonadCatchIO pr) ⇒ resource@@ -380,12 +386,14 @@ → 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) ⇒ Opened resource → RegionT s pr ()-register openedResource = RegionT $ do- openedResourcesIORef ← ask- liftIO $ modifyIORef openedResourcesIORef (Some openedResource:)+-- | 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:) --------------------------------------------------------------------------------@@ -441,29 +449,29 @@ ⇒ α (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) where- dup (RegionalHandle openedResource) = block $ do+ 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 openedResource+ 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 openedResource+ 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 $ RegionalHandle openedResource+ return duppedRegionalHandle --------------------------------------------------------------------------------
Control/Monad/Trans/Region/Unsafe.hs view
@@ -13,9 +13,9 @@ -- 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.+-- To create a module or library that allows your users to open your resources+-- in a region, the only thing you have to do 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@@ -27,18 +27,12 @@ ( -- * Scarce resources Resource , Handle+ , openResource , closeResource - -- * Accessing the internal handle of a resource. , internalHandle-- -- * Duplication- , Dup- , dup-- -- * Parent/child relationship between regions.- , ParentOf+ , mapInternalHandle ) where import Control.Monad.Trans.Region.Internal
regions.cabal view
@@ -1,5 +1,5 @@ name: regions-version: 0.2+version: 0.3 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -59,7 +59,7 @@ Location: http://code.haskell.org/~basvandijk/code/regions Library- GHC-Options: -O2 -Wall+ GHC-Options: -Wall build-depends: base >= 4 && < 4.3 , base-unicode-symbols >= 0.1.1 && < 0.2 , transformers >= 0.1.4 && < 0.2