regions 0.5 → 0.6
raw patch · 9 files changed
+173/−322 lines, 9 files
Files
- Control/Monad/Trans/Region.hs +4/−11
- Control/Monad/Trans/Region/Internal.hs +69/−225
- Control/Monad/Trans/Region/OnExit.hs +23/−0
- Control/Monad/Trans/Region/ParentOf.hs +70/−0
- Control/Monad/Trans/Region/Unsafe.hs +0/−28
- Control/Resource.hs +0/−51
- Data/RegionRef.hs +1/−1
- LICENSE +1/−1
- regions.cabal +5/−5
Control/Monad/Trans/Region.hs view
@@ -2,7 +2,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Region--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009-2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --@@ -24,18 +24,10 @@ , runTopRegion , forkTopRegion - -- * Opening resources- , RegionalHandle- , open-- , with- -- * Duplication- , Dup- , dup+ , Dup(dup) - -- * Parent/child relationship between regions.- , ParentOf+ , module Control.Monad.Trans.Region.ParentOf -- * Handy functions for writing monadic instances , liftCallCC@@ -44,3 +36,4 @@ ) where import Control.Monad.Trans.Region.Internal+import Control.Monad.Trans.Region.ParentOf
Control/Monad/Trans/Region/Internal.hs view
@@ -2,22 +2,13 @@ , NoImplicitPrelude , GeneralizedNewtypeDeriving , RankNTypes- , ScopedTypeVariables , KindSignatures- , MultiParamTypeClasses- , FunctionalDependencies- , UndecidableInstances- , FlexibleInstances- , OverlappingInstances- , NamedFieldPuns- , ExistentialQuantification- , ViewPatterns #-} ------------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Region.Internal--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009-2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --@@ -35,6 +26,11 @@ ( -- * Regions RegionT + -- * Close handles+ , CloseAction+ , CloseHandle+ , onExit+ -- * Running regions , runRegionT @@ -43,25 +39,13 @@ , forkTopRegion - -- * Opening resources- , RegionalHandle-- , internalHandle-- , open- , with- -- * Duplication- , Dup- , dup+ , Dup(dup) -- * Handy functions for writing monadic instances , liftCallCC , mapRegionT , liftCatch-- -- * Parent/child relationship between regions.- , ParentOf ) where @@ -72,15 +56,15 @@ -- from base: 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, forM_ , MonadPlus ) import Control.Monad.Fix ( MonadFix ) import System.IO ( IO )-import Data.Function ( ($), flip )-import Data.Functor ( Functor, (<$>) )+import Data.Function ( ($) )+import Data.Functor ( Functor ) import Data.Int ( Int ) import Data.IORef ( IORef, newIORef , readIORef, modifyIORef, atomicModifyIORef@@ -93,19 +77,14 @@ import Control.Monad.IO.Class ( MonadIO, liftIO ) import qualified Control.Monad.Trans.Reader as R ( liftCallCC, liftCatch )-import Control.Monad.Trans.Reader ( ReaderT- , ask+import Control.Monad.Trans.Reader ( ReaderT(ReaderT) , runReaderT, mapReaderT ) -- from base-unicode-symbols: import Data.Eq.Unicode ( (≡) ) import Data.Function.Unicode ( (∘) ) --- from ourselves:-import Control.Resource ( Resource, Handle )-import qualified Control.Resource as Resource ( open, close ) - -------------------------------------------------------------------------------- -- * Regions --------------------------------------------------------------------------------@@ -118,7 +97,7 @@ 'TopRegion' the parent region will be 'IO'. -} newtype RegionT s (pr ∷ * → *) α = RegionT- { unRegionT ∷ ReaderT (IORef [AnyRegionalHandle]) pr α }+ { unRegionT ∷ ReaderT (IORef [Handle]) pr α } deriving ( Functor , Applicative@@ -131,66 +110,32 @@ , MonadCatchIO ) --- | 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)+data Handle = Handle CloseAction (IORef RefCnt) --- | 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.+-- | An 'IO' computation that closes or finalizes a resource. For example+-- @hClose@ or @free@.+type CloseAction = IO () - /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!+type RefCnt = Int - /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 ∷ Handle resource-- {-| Get the reference count from the given regional handle.-- Normally a handle should be closed when its originating region- terminates. There are two exceptions to this rule:-- * When a handle is /duplicated/ to a parent region using 'dup'- it should only be closed when the parent region terminates.-- * When a region is executed in a new thread using 'forkTopRegion' all- handles that can be referenced in the originating region should also be- referenceable in the new forked region. Therefore those handles should only be- closed when the originating region or the new forked region terminates,- whichever comes /last/.-- To implement this behaviour, handles are reference counted.- The reference count is:-- * Initialized at 1 in 'open'.-- * Incremented in 'dup' and 'forkTopRegion'.+--------------------------------------------------------------------------------+-- * Close handles+-------------------------------------------------------------------------------- - * Decremented on termination of 'runRegionWith'- (which is called by 'runRegionT' and 'forkTopRegion').+-- | A handle to a 'CloseAction' that allows you to duplicate the action to a+-- parent region using 'dup'.+newtype CloseHandle (r ∷ * → *) = CloseHandle Handle - Only when the reference count reaches 0 will the resource actually be- closed.- -}- , refCntIORef ∷ IORef Int- }+-- | Register the 'CloseAction' in the region. When the region terminates all+-- registered close actions will be perfomed if they're not duplicated to a+-- parent region.+onExit ∷ MonadIO pr ⇒ CloseAction → RegionT s pr (CloseHandle (RegionT s pr))+onExit closeAction = RegionT $ ReaderT $ \hsIORef → liftIO $ do+ refCntIORef ← newIORef 1+ let h = Handle closeAction refCntIORef+ modifyIORef hsIORef (h:)+ return $ CloseHandle h --------------------------------------------------------------------------------@@ -199,9 +144,9 @@ {-| Execute a region inside its parent region @pr@. -All resources which have been opened in the given region using 'open', and which-haven't been duplicated using 'dup', will be closed on exit from this function-wether by normal termination or by raising an exception.+All resources which have been opened in the given region and which haven't been+duplicated using 'dup', will be closed on exit from this function wether by+normal termination or by raising an exception. Also all resources which have been duplicated to this region from a child region are closed on exit if they haven't been duplicated themselves.@@ -210,13 +155,6 @@ itself. This ensures that /all/ values, having a type containing @s@, can /not/ be returned from this function. (Note the similarity with the @ST@ monad.) -An example of such a value is a 'RegionalHandle'. Regional handles are created by-opening a resource in a region using 'open'. Regional handles are parameterized by-the region in which they were created. So regional handles have this @s@ in their-type. This ensures that these regional handles, which may have been closed on exit-from this function, can't be returned from this function. This ensures you can-never do any IO with a closed regional handle.- Note that it is possible to run a region inside another region. -} runRegionT ∷ MonadCatchIO pr ⇒ (∀ s. RegionT s pr α) → pr α@@ -241,8 +179,7 @@ Note that the forked region has the same type variable @s@ as the resulting region. This means that all values which can be referenced in the resulting-region (like 'RegionalHandle's for example) can also be referenced in the forked-region.+region can also be referenced in the forked region. For example the following is allowed: @@ -258,41 +195,38 @@ whichever comes /last/. -} forkTopRegion ∷ MonadIO pr ⇒ TopRegion s () → RegionT s pr ThreadId-forkTopRegion m = RegionT $ do- rhsIORef ← ask- liftIO $ do- rhs ← readIORef rhsIORef- block $ do- forM_ rhs $ \(Any (RegionalHandle {refCntIORef})) → increment refCntIORef- forkIO $ runRegionWith rhs m+forkTopRegion m = RegionT $ ReaderT $ \hsIORef → liftIO $ do+ hs ← readIORef hsIORef+ block $ do+ forM_ hs $ \(Handle _ refCntIORef) → increment refCntIORef+ forkIO $ runRegionWith hs 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 rhs = bracket (liftIO before) (liftIO ∘ after)- ∘ runReaderT ∘ unRegionT+ ⇒ [Handle] → RegionT s pr α → pr α+runRegionWith hs r = bracket (liftIO before)+ (liftIO ∘ after)+ (runReaderT $ unRegionT r) where- before = newIORef rhs- after rhsIORef = do- rhs' ← readIORef rhsIORef- forM_ rhs' $ \(Any (RegionalHandle { internalHandle- , refCntIORef- })) → do+ before = newIORef hs+ after hsIORef = do+ hs' ← readIORef hsIORef+ forM_ hs' $ \(Handle closeAction refCntIORef) → do refCnt ← decrement refCntIORef- when (refCnt ≡ 0) $ Resource.close internalHandle+ when (refCnt ≡ 0) closeAction -- | 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 RefCnt → IO RefCnt decrement ioRef = do atomicModifyIORef ioRef $ \refCnt → let refCnt' = refCnt - 1 in (refCnt', refCnt') -- | Internally used function that atomically increments the reference count that -- is stored in the given @IORef@.-increment ∷ IORef Int → IO ()+increment ∷ IORef RefCnt → IO () increment ioRef = do refCnt' ← atomicModifyIORef ioRef $ \refCnt → let refCnt' = refCnt + 1 in (refCnt', refCnt')@@ -300,55 +234,11 @@ ----------------------------------------------------------------------------------- * Opening resources-----------------------------------------------------------------------------------{-| 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-it was created. This ensures that regional handles can never escape their-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 /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- → RegionT s pr- (RegionalHandle resource (RegionT s pr))-open resource = block $ do- rh ← liftIO $ RegionalHandle <$> Resource.open resource <*> newIORef 1- register rh- return rh---- | 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-region.--Note that: @with resource f = 'runRegionT' ('open' resource '>>=' f)@.--}-with ∷ (Resource resource, MonadCatchIO pr)- ⇒ resource- → (∀ s. RegionalHandle resource (RegionT s pr) → RegionT s pr α)- → pr α-with resource f = runRegionT $ open resource >>= f----------------------------------------------------------------------------------- -- * Duplication -------------------------------------------------------------------------------- -{-| Duplicate an @α@ in the parent region. This @α@ will usually be a-@(@'RegionalHandle'@ resource)@ but it can be any value \"derived\" from this-regional handle.+{-| Duplicate an @α@ in the parent region. This @α@ will usually be+some type of regional handle. For example, suppose you run the following region: @@ -370,7 +260,7 @@ ...yielding the regional handle @r1h@. Note that: -@r1h :: RegionalHandle resource (RegionT cs (RegionT ps ppr))@+@r1h :: RegionalHandle (RegionT cs (RegionT ps ppr))@ where @cs@ is bound by the inner (child) @runRegionT@ and @ps@ is bound by the outer (parent) @runRegionT@.@@ -386,7 +276,7 @@ return r1hDup @ -Note that @r1hDup :: RegionalHandle resource (RegionT ps ppr)@+Note that @r1hDup :: RegionalHandle (RegionT ps ppr)@ Back in the parent region you can safely operate on @r1hDup@. -}@@ -396,12 +286,12 @@ → RegionT cs (RegionT ps ppr) (α (RegionT ps ppr)) -instance Resource resource ⇒ Dup (RegionalHandle resource) where- dup (RegionalHandle {internalHandle, refCntIORef}) = block $ do- liftIO $ increment refCntIORef- let rh = RegionalHandle internalHandle refCntIORef- lift $ register rh- return rh+instance Dup CloseHandle where+ dup (CloseHandle h@(Handle _ refCntIORef)) =+ lift $ RegionT $ ReaderT $ \hsIORef → liftIO $ block $ do+ increment refCntIORef+ modifyIORef hsIORef (h:)+ return $ CloseHandle h --------------------------------------------------------------------------------@@ -411,63 +301,17 @@ -- | Lift a @callCC@ operation to the new monad. liftCallCC ∷ (((α → pr β) → pr α) → pr α) → (((α → RegionT s pr β) → RegionT s pr α) → RegionT s pr α)-liftCallCC callCC f = RegionT $ R.liftCallCC callCC $ unRegionT ∘ f ∘ (RegionT ∘)+liftCallCC callCC = \f → RegionT $ R.liftCallCC callCC $ unRegionT ∘ f ∘ (RegionT ∘) -- | Transform the computation inside a region.-mapRegionT ∷ (m α → n β) → RegionT s m α → RegionT 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 s pr α -- ^ Computation to attempt.- → (e → RegionT s pr α) -- ^ Exception handler.- → RegionT s pr α-liftCatch f m h = RegionT $ R.liftCatch f (unRegionT m) (unRegionT ∘ h)-------------------------------------------------------------------------------------- * Parent/child relationship between regions.-----------------------------------------------------------------------------------{-| The @ParentOf@ class declares the parent/child relationship between regions.--A region is the parent of another region if they're either equivalent like:--@-RegionT ps pr \`ParentOf\` RegionT ps pr-@--or if it is the parent of the parent of the child like:--@-RegionT ps ppr \`ParentOf\` RegionT cs- (RegionT pcs- (RegionT ppcs- (RegionT ps ppr)))-@--}-class (Monad pr, Monad cr) ⇒ pr `ParentOf` cr--instance Monad r ⇒ ParentOf r r--instance ( Monad cr- , cr `TypeCast2` RegionT s pcr- , pr `ParentOf` pcr- )- ⇒ ParentOf pr cr-------------------------------------------------------------------------------------- Type casting-----------------------------------------------------------------------------------class TypeCast2 (a ∷ * → *) (b ∷ * → *) | a → b, b → a-class TypeCast2' t (a ∷ * → *) (b ∷ * → *) | t a → b, t b → a-class TypeCast2'' t (a ∷ * → *) (b ∷ * → *) | t a → b, t b → a--instance TypeCast2' () a b ⇒ TypeCast2 a b-instance TypeCast2'' t a b ⇒ TypeCast2' t a b-instance TypeCast2'' () a a+-- | Lift a @catchError@ operation to the new monad.+liftCatch ∷ (pr α → (e → pr α) → pr α)+ → (RegionT s pr α → (e → RegionT s pr α) → RegionT s pr α)+liftCatch f = \m h → RegionT $ R.liftCatch f (unRegionT m) (unRegionT ∘ h) -- The End ---------------------------------------------------------------------
+ Control/Monad/Trans/Region/OnExit.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE UnicodeSyntax #-}++-------------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Trans.Region.Unsafe+-- Copyright : (c) 2009-2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-- This module is not intended for end-users. It should only be used by library+-- authors wishing to extend this @regions@ library.+--+--------------------------------------------------------------------------------++module Control.Monad.Trans.Region.OnExit ( CloseAction+ , CloseHandle+ , onExit+ ) where++import Control.Monad.Trans.Region.Internal ( CloseAction+ , CloseHandle+ , onExit+ )
+ Control/Monad/Trans/Region/ParentOf.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE UnicodeSyntax+ , NoImplicitPrelude+ , KindSignatures+ , MultiParamTypeClasses+ , FunctionalDependencies+ , UndecidableInstances+ , FlexibleInstances+ , OverlappingInstances+ #-}++-------------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Trans.Region.ParentOf+-- Copyright : (c) 2009-2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+--------------------------------------------------------------------------------++module Control.Monad.Trans.Region.ParentOf ( ParentOf ) where++-- from base:+import Control.Monad ( Monad )++-- from regions:+import Control.Monad.Trans.Region.Internal ( RegionT )+++{-| The @ParentOf@ class declares the parent/child relationship between regions.++A region is the parent of another region if they're either equivalent like:++@+RegionT ps pr \`ParentOf\` RegionT ps pr+@++or if it is the parent of the parent of the child like:++@+RegionT ps ppr \`ParentOf\` RegionT cs+ (RegionT pcs+ (RegionT ppcs+ (RegionT ps ppr)))+@+-}+class (Monad pr, Monad cr) ⇒ pr `ParentOf` cr++instance Monad r ⇒ ParentOf r r++instance ( Monad cr+ , cr `TypeCast2` RegionT s pcr+ , pr `ParentOf` pcr+ )+ ⇒ ParentOf pr cr+++--------------------------------------------------------------------------------+-- Type casting+--------------------------------------------------------------------------------++class TypeCast2 (a ∷ * → *) (b ∷ * → *) | a → b, b → a+class TypeCast2' t (a ∷ * → *) (b ∷ * → *) | t a → b, t b → a+class TypeCast2'' t (a ∷ * → *) (b ∷ * → *) | t a → b, t b → a++instance TypeCast2' () a b ⇒ TypeCast2 a b+instance TypeCast2'' t a b ⇒ TypeCast2' t a b+instance TypeCast2'' () a a+++-- The End ---------------------------------------------------------------------
− Control/Monad/Trans/Region/Unsafe.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE UnicodeSyntax #-}------------------------------------------------------------------------------------ |--- Module : Control.Monad.Trans.Region.Unsafe--- Copyright : (c) 2009 Bas van Dijk--- License : BSD3 (see the file LICENSE)--- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>------ /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!--------------------------------------------------------------------------------------module Control.Monad.Trans.Region.Unsafe- ( internalHandle- , mapInternalHandle- ) where--import Control.Monad.Trans.Region.Internal ( RegionalHandle, internalHandle )-import Control.Resource ( Handle )---- | 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 }
− Control/Resource.hs
@@ -1,51 +0,0 @@-{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, TypeFamilies #-}------------------------------------------------------------------------------------ |--- Module : Control.Resource--- Copyright : (c) 2009 Bas van Dijk--- License : BSD3 (see the file LICENSE)--- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>------ /Unsafely/ opening and closing of scarce resources.--------------------------------------------------------------------------------------module Control.Resource- ( Resource- , Handle- , open- , close- ) where----- from base:-import System.IO ( IO )--{-| Class of /scarce/ resources. A scarce resource is a resource that only one-user can use at a time. (like a file, memory pointer or USB device for-example).--Because of the scarcity, these resources need to be /opened/ to grant temporary-sole access to the resource. When the resource is no longer needed it should be-/closed/ a.s.a.p to grant others access to the resource.--}-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.- -}- 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 ()
Data/RegionRef.hs view
@@ -3,7 +3,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Data.RegionRef--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009-2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009 Bas van Dijk+Copyright (c) 2009-2010 Bas van Dijk All rights reserved.
regions.cabal view
@@ -1,10 +1,10 @@ name: regions-version: 0.5+version: 0.6 cabal-version: >=1.6 build-type: Simple license: BSD3 license-file: LICENSE-copyright: 2010 Bas van Dijk+copyright: 2009-2010 Bas van Dijk author: Bas van Dijk maintainer: Bas van Dijk <v.dijk.bas@gmail.com> stability: experimental@@ -44,8 +44,8 @@ , 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+ exposed-modules: Control.Monad.Trans.Region+ Control.Monad.Trans.Region.ParentOf+ Control.Monad.Trans.Region.OnExit Data.RegionRef other-modules: Control.Monad.Trans.Region.Internal