regions 0.1 → 0.1.0.1
raw patch · 2 files changed
+137/−37 lines, 2 filesdep +base-unicode-symbolsdep −unicode-symbolsdep ~base
Dependencies added: base-unicode-symbols
Dependencies removed: unicode-symbols
Dependency ranges changed: base
Files
- Control/Monad/Trans/Region/Internal.hs +133/−33
- regions.cabal +4/−4
Control/Monad/Trans/Region/Internal.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -9,6 +10,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE NamedFieldPuns #-} ------------------------------------------------------------------------------- -- |@@ -79,10 +81,18 @@ -------------------------------------------------------------------------------- -- from base:+import Prelude ( succ, pred, fromInteger ) import Control.Concurrent ( forkIO, ThreadId ) import Control.Applicative ( Applicative, Alternative )-import Control.Monad ( when, liftM2, MonadPlus )+import Control.Monad ( Monad, return, (>>=), fail+ , (>>), when, liftM2, mapM_+ , Functor+ , MonadPlus+ ) import Control.Monad.Fix ( MonadFix )+import System.IO ( IO )+import Data.Function ( ($) )+import Data.Int ( Int ) import Data.IORef ( IORef, newIORef , readIORef, modifyIORef, atomicModifyIORef )@@ -97,8 +107,9 @@ , ask , runReaderT, mapReaderT )--- from unicode-symbols:-import Prelude.Unicode ( (∘), (≡) )+-- from base-unicode-symbols:+import Data.Eq.Unicode ( (≡) )+import Data.Function.Unicode ( (∘) ) --------------------------------------------------------------------------------@@ -145,15 +156,35 @@ , 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'.++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.+-} data Opened resource = Opened { openedHandle ∷ Handle resource , 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. 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@. increment ∷ IORef Int → IO () increment ioRef = atomicModifyIORef ioRef $ \refCnt → (succ refCnt, ())@@ -236,26 +267,52 @@ -- ^ A regional computation that executes the given region in a -- new thread and returns the @ThreadId@ of this new thread. forkTopRegion m = RegionT $ do+ -- Get the list of currently opened resources in this region: openedResourcesIORef ← ask liftIO $ do openedResources ← readIORef openedResourcesIORef- block $ do mapM_ (increment ∘ refCntIORef) openedResources- forkIO $ runRegionWith openedResources m + 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:+ mapM_ (increment ∘ refCntIORef) openedResources++ -- 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++-- | 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 α → pr α runRegionWith openedResources m =- bracket (liftIO $ newIORef openedResources)- (\openedResourcesIORef → liftIO $ readIORef openedResourcesIORef >>=- mapM_ closeOpenedResource)- (runReaderT $ unRegionT m)+ bracket+ -- Create a new IORef containing the initial opened resources:+ (liftIO $ newIORef openedResources)++ -- 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)++ (runReaderT $ unRegionT m) where- closeOpenedResource ∷ Opened resource → IO ()- closeOpenedResource openedResource = do- refCnt ← decrement $ refCntIORef openedResource- when (refCnt ≡ 0) $ closeResource $ openedHandle $ openedResource+ end (Opened {openedHandle, refCntIORef}) = do+ refCnt ← decrement refCntIORef+ when (refCnt ≡ 0) $ closeResource openedHandle --------------------------------------------------------------------------------@@ -269,8 +326,18 @@ {-| Get the internal handle from the regional handle. -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 end-users because it allows+them to close the handle manually!++/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@@ -282,8 +349,8 @@ region. And it also allows operations on regional handles to be executed in a child region of the region in which the regional handle was created. -Note that if you wish to return a regional handle from the region in which it-was created you have to duplicate the handle by applying 'dup' to it.+Note that if you /do/ wish to return a regional handle from the region in which+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.@@ -291,13 +358,26 @@ (RegionalHandle resource (RegionT resource s pr)) -- ^ A regional computation that returns a regional handle to the given -- opened resource parameterized by the region itself.-open resource =- RegionT $ block $ do- openedResource ← liftIO $ liftM2 Opened (openResource resource)- (newIORef 1)- registerOpenedResource openedResource- return $ RegionalHandle openedResource+open resource = block $ do+ -- Create a new opened resource by actually opening the resource and+ -- intializing the reference count to 1:+ openedResource ← liftIO $ liftM2 Opened (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 openedResource++ -- Return a regional handle containing the just opened resource. The type of+ -- the regional handle will be parameterized by this region:+ return $ RegionalHandle openedResource+ {-| A convenience function which opens the given resource, applies the given continuation function to the resulting regional handle and runs the resulting region.@@ -314,10 +394,12 @@ -- resulting regional handle. with resource f = runRegionT $ open resource >>= f -registerOpenedResource ∷ (Resource resource, MonadIO pr1)- ⇒ Opened resource- → ReaderT (IORef [Opened resource]) pr1 ()-registerOpenedResource openedResource = do+-- | 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 ()+register openedResource = RegionT $ do openedResourcesIORef ← ask liftIO $ modifyIORef openedResourcesIORef (openedResource:) @@ -372,15 +454,33 @@ -} 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))+ -- ^ 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.+ (α (RegionT resource 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- dup (RegionalHandle openedResource) = RegionT $- block $ do liftIO $ increment $ refCntIORef openedResource- lift $ RegionT $ registerOpenedResource openedResource- return $ RegionalHandle openedResource+ 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:+ liftIO $ increment $ refCntIORef openedResource++ -- The following registers the opened resource in the parent region 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+ -- 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++ -- 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 --------------------------------------------------------------------------------
regions.cabal view
@@ -1,5 +1,5 @@ name: regions-version: 0.1+version: 0.1.0.1 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -8,7 +8,7 @@ author: Bas van Dijk maintainer: Bas van Dijk <v.dijk.bas@gmail.com> stability: experimental-category: Control+category: Control, Monadic Regions synopsis: Provides the region monad for safely opening and working with scarce resources. description:@@ -59,8 +59,8 @@ Library GHC-Options: -O2 -Wall- build-depends: base >= 4 && < 4.2- , unicode-symbols == 0.1.*+ 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.* exposed-modules: Control.Monad.Trans.Region