regions 0.7.0.1 → 0.8
raw patch · 7 files changed
+236/−214 lines, 7 filesdep +monad-peeldep −MonadCatchIO-transformersdep ~base
Dependencies added: monad-peel
Dependencies removed: MonadCatchIO-transformers
Dependency ranges changed: base
Files
- Control/Monad/Trans/Region.hs +4/−11
- Control/Monad/Trans/Region/Concurrent.hs +33/−0
- Control/Monad/Trans/Region/Internal.hs +184/−118
- Control/Monad/Trans/Region/OnExit.hs +4/−4
- Control/Monad/Trans/Region/ParentOf.hs +0/−70
- Data/RegionRef.hs +5/−5
- regions.cabal +6/−6
Control/Monad/Trans/Region.hs view
@@ -21,19 +21,12 @@ -- * Running regions , runRegionT - , TopRegion- , runTopRegion-- -- ** Forking /top-level/ regions- , forkIOTopRegion- , forkOSTopRegion-#ifdef __GLASGOW_HASKELL__- , forkOnIOTopRegion-#endif -- * Duplication , Dup(dup) - , module Control.Monad.Trans.Region.ParentOf+ -- * Ancestor relation between regions+ , AncestorRegion+ , RootRegion -- * Handy functions for writing monadic instances , liftCallCC@@ -42,4 +35,4 @@ ) where import Control.Monad.Trans.Region.Internal-import Control.Monad.Trans.Region.ParentOf+
+ Control/Monad/Trans/Region/Concurrent.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}++-------------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Trans.Region.Concurrent+-- Copyright : (c) 2009-2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-- Concurrently executing regions.+--+-- This module exports functions with equivalent names from @Control.Concurrent@+-- and @GHC.Conc@. May I suggest you import this module qualified as in:+--+-- @import qualified Control.Monad.Trans.Region.Concurrent as Region@+--+--------------------------------------------------------------------------------++module Control.Monad.Trans.Region.Concurrent+ ( forkIO+ , forkOS+#ifdef __GLASGOW_HASKELL__+ , forkOnIO+#endif+ ) where++import Control.Monad.Trans.Region.Internal+ ( forkIO+ , forkOS+#ifdef __GLASGOW_HASKELL__+ , forkOnIO+#endif+ )
Control/Monad/Trans/Region/Internal.hs view
@@ -1,9 +1,14 @@-{-# LANGUAGE CPP- , UnicodeSyntax- , NoImplicitPrelude- , GeneralizedNewtypeDeriving- , RankNTypes- , KindSignatures+{-# LANGUAGE CPP -- For portability.+ , UnicodeSyntax -- Makes it look so nice.+ , NoImplicitPrelude -- I like to be fully explicit.+ , GeneralizedNewtypeDeriving -- I'm lazy.+ , RankNTypes -- Provides the essential type-safety.+ , KindSignatures -- To help the type-checker.+ , EmptyDataDecls -- For the RootRegion type.+ , MultiParamTypeClasses -- For the AncestorRegion class.+ , UndecidableInstances -- )+ , FlexibleInstances -- ) For the AncestorRegion instances.+ , OverlappingInstances -- ) #-} -------------------------------------------------------------------------------@@ -27,27 +32,28 @@ ( -- * Regions RegionT - -- * Close handles- , CloseAction- , CloseHandle+ -- * Registering finalizers+ , Finalizer+ , FinalizerHandle , onExit -- * Running regions , runRegionT - , TopRegion- , runTopRegion-- -- ** Forking /top-level/ regions- , forkIOTopRegion- , forkOSTopRegion+ -- ** Forking regions+ , forkIO+ , forkOS #ifdef __GLASGOW_HASKELL__- , forkOnIOTopRegion+ , forkOnIO #endif -- * Duplication , Dup(dup) + -- * Ancestor relation between regions+ , AncestorRegion+ , RootRegion+ -- * Handy functions for writing monadic instances , liftCallCC , mapRegionT@@ -60,54 +66,62 @@ -------------------------------------------------------------------------------- -- from base:-import Prelude ( (+), (-), seq, fromInteger )+import Prelude ( (+), (-), seq ) import Control.Applicative ( Applicative, Alternative )-import Control.Monad ( Monad, return, (>>=), fail- , (>>), when, forM_- , MonadPlus- )+import Control.Monad ( Monad, return, when, forM_ , MonadPlus ) import Control.Monad.Fix ( MonadFix ) import System.IO ( IO ) import Data.Function ( ($) ) import Data.Functor ( Functor ) import Data.Int ( Int )-import Data.IORef ( IORef, newIORef- , readIORef, modifyIORef, atomicModifyIORef- )-import Control.Concurrent ( forkIO, forkOS, ThreadId )+import Data.IORef ( IORef, newIORef, readIORef, modifyIORef, atomicModifyIORef )+import Control.Concurrent ( ThreadId )+import qualified Control.Concurrent ( forkIO, forkOS ) #ifdef __GLASGOW_HASKELL__-import GHC.Conc ( forkOnIO )+import qualified GHC.Conc ( forkOnIO ) #endif --- from MonadCatchIO-transformers:-import Control.Monad.CatchIO ( MonadCatchIO, block, bracket )+#if __GLASGOW_HASKELL__ < 701+import Prelude ( fromInteger )+import Control.Monad ( (>>=), (>>), fail )+#endif +-- from monad-peel:+import Control.Monad.IO.Peel ( MonadPeelIO )+import Control.Exception.Peel ( bracket )+ -- from transformers: 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(ReaderT)- , runReaderT, mapReaderT- )+import Control.Monad.Trans.Reader ( ReaderT(ReaderT), runReaderT, mapReaderT )+ -- from base-unicode-symbols: import Data.Eq.Unicode ( (≡) ) import Data.Function.Unicode ( (∘) ) +-- Handling the new asynchronous exceptions API in base-4.3:+#if MIN_VERSION_base(4,3,0)+import Control.Exception ( mask_ )+#else+import Control.Exception ( block )+mask_ ∷ IO α → IO α+mask_ = block+#endif + -------------------------------------------------------------------------------- -- * Regions -------------------------------------------------------------------------------- -{-| 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'.+{-| A monad transformer in which scarce resources can be opened. When the region+terminates, all opened resources will be closed automatically. It's a type error+to return an opened resource from the region. The latter ensures no I/O with+closed resources is possible. -} newtype RegionT s (pr ∷ * → *) α = RegionT- { unRegionT ∷ ReaderT (IORef [Handle]) pr α }+ { unRegionT ∷ ReaderT (IORef [RefCountedFinalizer]) pr α } deriving ( Functor , Applicative@@ -117,37 +131,59 @@ , MonadFix , MonadTrans , MonadIO- , MonadCatchIO+ , MonadPeelIO ) -data Handle = Handle !CloseAction !(IORef RefCnt)+-- | A 'Finalizer' paired with its reference count which defines how many times+-- it has been registered in some region.+data RefCountedFinalizer = RefCountedFinalizer !Finalizer !(IORef RefCnt) -- | An 'IO' computation that closes or finalizes a resource. For example -- @hClose@ or @free@.-type CloseAction = IO ()+type Finalizer = IO () type RefCnt = Int ----------------------------------------------------------------------------------- * Close handles+-- * Registering finalizers -------------------------------------------------------------------------------- --- | A handle to a 'CloseAction' that allows you to duplicate the action to a--- parent region using 'dup'.-newtype CloseHandle (r ∷ * → *) = CloseHandle Handle+-- | A handle to a 'Finalizer' that allows you to duplicate it to a parent+-- region using 'dup'.+--+-- Duplicating a finalizer means that instead of it being performed when the+-- current region terminates it is performed when the parent region terminates.+newtype FinalizerHandle (r ∷ * → *) = FinalizerHandle RefCountedFinalizer --- | 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+{-| Register the 'Finalizer' in the region. When the region terminates all+registered finalizers will be perfomed if they're not duplicated to a parent+region. +Note that finalizers are run in LIFO order (Last In First Out). So executing the following: +@+runRegionT $ do+ _ <- onExit $ putStrLn \"finalizer 1\"+ _ <- onExit $ putStrLn \"finalizer 2\"+ return ()+@++yields:++@+finalizer 2+finalizer 1+@+-}+onExit ∷ MonadIO pr ⇒ Finalizer → RegionT s pr (FinalizerHandle (RegionT s pr))+onExit finalizer = RegionT $ ReaderT $ \hsIORef → liftIO $ do+ refCntIORef ← newIORef 1+ let h = RefCountedFinalizer finalizer refCntIORef+ modifyIORef hsIORef (h:)+ return $ FinalizerHandle h++ -------------------------------------------------------------------------------- -- * Running regions --------------------------------------------------------------------------------@@ -167,30 +203,32 @@ Note that it is possible to run a region inside another region. -}-runRegionT ∷ MonadCatchIO pr ⇒ (∀ s. RegionT s pr α) → pr α+runRegionT ∷ MonadPeelIO pr ⇒ (∀ s. RegionT s pr α) → pr α runRegionT m = runRegionWith [] m -{-| A region which has 'IO' as its parent region which enables it to be:-- * directly executed in 'IO' by 'runTopRegion',-- * concurrently executed in a new thread by 'forkIOTopRegion'.--}-type TopRegion s = RegionT s IO--{-| Convenience funtion for running a /top-level/ region in 'IO'.--Note that: @runTopRegion = 'runRegionT'@--}-runTopRegion ∷ (∀ s. TopRegion s α) → IO α-runTopRegion = runRegionT+runRegionWith ∷ ∀ s pr α. MonadPeelIO pr+ ⇒ [RefCountedFinalizer] → RegionT s pr α → pr α+runRegionWith hs r = bracket (liftIO $ newIORef hs)+ (liftIO ∘ after)+ (runReaderT $ unRegionT r)+ where+ after hsIORef = do+ hs' ← readIORef hsIORef+ forM_ hs' $ \(RefCountedFinalizer finalizer refCntIORef) → do+ refCnt ← decrement refCntIORef+ when (refCnt ≡ 0) finalizer+ where+ decrement ∷ IORef RefCnt → IO RefCnt+ decrement ioRef = atomicModifyIORef ioRef $ \refCnt →+ let refCnt' = refCnt - 1+ in (refCnt', refCnt') ----------------------------------------------------------------------------------- ** Forking /top-level/ regions+-- ** Forking regions -------------------------------------------------------------------------------- -{-| Return a region which executes the given /top-level/ region in a new thread.+{-| Return a region which executes the given region in a new thread. 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@@ -201,7 +239,7 @@ @ 'runRegionT' $ do regionalHndl <- open resource- threadId <- 'forkIOTopRegion' $ doSomethingWith regionalHndl+ threadId <- Region.'forkIO' $ doSomethingWith regionalHndl doSomethingElseWith regionalHndl @ @@ -209,56 +247,29 @@ thread are closed only when the current thread or the forked thread terminates whichever comes /last/. -}-forkIOTopRegion ∷ MonadIO pr ⇒ TopRegion s () → RegionT s pr ThreadId-forkIOTopRegion = forkTopRegion forkIO+forkIO ∷ MonadIO pr ⇒ RegionT s IO () → RegionT s pr ThreadId+forkIO = fork Control.Concurrent.forkIO --- | Like 'forkIOTopRegion' but internally uses 'forkOS'.-forkOSTopRegion ∷ MonadIO pr ⇒ TopRegion s () → RegionT s pr ThreadId-forkOSTopRegion = forkTopRegion forkOS+-- | Like 'forkIO' but internally uses @Control.Concurrent.'Control.Concurrent.forkOS'@.+forkOS ∷ MonadIO pr ⇒ RegionT s IO () → RegionT s pr ThreadId+forkOS = fork Control.Concurrent.forkOS #ifdef __GLASGOW_HASKELL__--- | Like 'forkIOTopRegion' but internally uses 'forkOnIO'.-forkOnIOTopRegion ∷ MonadIO pr ⇒ Int → TopRegion s () → RegionT s pr ThreadId-forkOnIOTopRegion = forkTopRegion ∘ forkOnIO+-- | Like 'forkIO' but internally uses @GHC.Conc.'GHC.Conc.forkOnIO'@.+forkOnIO ∷ MonadIO pr ⇒ Int → RegionT s IO () → RegionT s pr ThreadId+forkOnIO = fork ∘ GHC.Conc.forkOnIO #endif -forkTopRegion ∷ MonadIO pr- ⇒ (IO () → IO ThreadId)- → (TopRegion s () → RegionT s pr ThreadId)-forkTopRegion doFork = \m →+fork ∷ MonadIO pr+ ⇒ (IO () → IO ThreadId)+ → (RegionT s IO () → RegionT s pr ThreadId)+fork doFork = \m → RegionT $ ReaderT $ \hsIORef → liftIO $ do hs ← readIORef hsIORef- block $ do- forM_ hs $ \(Handle _ refCntIORef) → increment refCntIORef+ mask_ $ do+ forM_ hs $ \(RefCountedFinalizer _ refCntIORef) → increment refCntIORef doFork $ runRegionWith hs m ------------------------------------------------------------------------------------- | Internally used function that actually runs the region on the given list of--- opened resources.-runRegionWith ∷ ∀ s pr α. MonadCatchIO pr- ⇒ [Handle] → RegionT s pr α → pr α-runRegionWith hs r = bracket (liftIO before)- (liftIO ∘ after)- (runReaderT $ unRegionT r)- where- before = newIORef hs- after hsIORef = do- hs' ← readIORef hsIORef- forM_ hs' $ \(Handle closeAction refCntIORef) → do- refCnt ← decrement refCntIORef- 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 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 RefCnt → IO () increment ioRef = do refCnt' ← atomicModifyIORef ioRef $ \refCnt → let refCnt' = refCnt + 1@@ -314,17 +325,72 @@ Back in the parent region you can safely operate on @r1hDup@. -} class Dup α where- dup ∷ MonadCatchIO ppr+ dup ∷ MonadIO ppr ⇒ α (RegionT cs (RegionT ps ppr)) → RegionT cs (RegionT ps ppr) (α (RegionT ps ppr)) -instance Dup CloseHandle where- dup (CloseHandle h@(Handle _ refCntIORef)) =- lift $ RegionT $ ReaderT $ \hsIORef → liftIO $ block $ do+instance Dup FinalizerHandle where+ dup (FinalizerHandle h@(RefCountedFinalizer _ refCntIORef)) =+ lift $ RegionT $ ReaderT $ \hsIORef → liftIO $ mask_ $ do increment refCntIORef modifyIORef hsIORef (h:)- return $ CloseHandle h+ return $ FinalizerHandle h+++--------------------------------------------------------------------------------+-- * Ancestor relation between regions+--------------------------------------------------------------------------------++{-| The @AncestorRegion@ class is used to relate the region in which a resource+was opened to the region in which it is used. Take the following operation from+the @safer-file-handles@ package as an example:++@hFileSize :: (pr \`AncestorRegion\` cr, MonadIO cr) => RegionalFileHandle ioMode pr -> cr Integer@++The @AncestorRegion@ class defines the parent / child relationship between regions.+The constraint++@+ pr \`AncestorRegion\` cr+@++is satisfied if and only if @cr@ is a sequence of zero or more \"@'RegionT' s@\"+(with varying @s@) applied to @pr@, in other words, if @cr@ is an (improper)+nested subregion of @pr@.++The class constraint @InternalAncestorRegion pr cr@ serves two purposes. First, the+instances of @InternalAncestorRegion@ do the type-level recursion that implements+the relation specified above. Second, since it is not exported, user code cannot+add new instances of 'AncestorRegion' (as these would have to be made instances of+@InternalAncestorRegion@, too), effectively turning it into a /closed class/.+-}++-- The implementation uses type-level recursion, so it is no surprise we need+-- UndecidableInstances.++class (InternalAncestorRegion pr cr) ⇒ AncestorRegion pr cr++instance (InternalAncestorRegion pr cr) ⇒ AncestorRegion pr cr++class InternalAncestorRegion (pr ∷ * → *) (cr ∷ * → *)++instance InternalAncestorRegion (RegionT s m) (RegionT s m)+instance (InternalAncestorRegion pr cr) ⇒ InternalAncestorRegion pr (RegionT s cr)++--------------------------------------------------------------------------------++-- | The @RootRegion@ is the ancestor of any region.+--+-- It's primary purpose is to tag regional handles which don't have an+-- associated finalizer. For example the standard file handles @stdin@, @stdout@+-- and @stderr@ which are opened on program startup and which shouldn't be+-- closed when a region terminates. Another example is the @nullPtr@ which is a+-- memory pointer which doesn't point to any allocated memory so doesn't need to+-- be freed.+data RootRegion α++instance InternalAncestorRegion RootRegion (RegionT s m) --------------------------------------------------------------------------------
Control/Monad/Trans/Region/OnExit.hs view
@@ -12,12 +12,12 @@ -- -------------------------------------------------------------------------------- -module Control.Monad.Trans.Region.OnExit ( CloseAction- , CloseHandle+module Control.Monad.Trans.Region.OnExit ( Finalizer+ , FinalizerHandle , onExit ) where -import Control.Monad.Trans.Region.Internal ( CloseAction- , CloseHandle+import Control.Monad.Trans.Region.Internal ( Finalizer+ , FinalizerHandle , onExit )
− Control/Monad/Trans/Region/ParentOf.hs
@@ -1,70 +0,0 @@-{-# 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 ---------------------------------------------------------------------
Data/RegionRef.hs view
@@ -44,7 +44,7 @@ import Control.Monad.IO.Class ( MonadIO, liftIO ) -- from ourselves:-import Control.Monad.Trans.Region ( RegionT, ParentOf )+import Control.Monad.Trans.Region ( RegionT, AncestorRegion ) --------------------------------------------------------------------------------@@ -75,18 +75,18 @@ newRegionRef = liftM RegionRef ∘ liftIO ∘ newIORef -- | Read the value of the given regional reference.-readRegionRef ∷ (pr `ParentOf` cr, MonadIO cr)+readRegionRef ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionRef pr α → cr α readRegionRef = liftIO ∘ readIORef ∘ unRegionRef -- | Write a new value into the given regional reference.-writeRegionRef ∷ (pr `ParentOf` cr, MonadIO cr)+writeRegionRef ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionRef pr α → α → cr () writeRegionRef ref x = liftIO $ writeIORef (unRegionRef ref) x -- | Mutate the contents of the given regional reference using the given -- function.-modifyRegionRef ∷ (pr `ParentOf` cr, MonadIO cr)+modifyRegionRef ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionRef pr α → (α → α) → cr () modifyRegionRef ref f = liftIO $ modifyIORef (unRegionRef ref) f @@ -97,7 +97,7 @@ multithreaded program. If you only have one regional reference, then using @atomicModifyRegionRef@ to access and modify it will prevent race conditions. -}-atomicModifyRegionRef ∷ (pr `ParentOf` cr, MonadIO cr)+atomicModifyRegionRef ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionRef pr α → (α → (α, β)) → cr β atomicModifyRegionRef ref f = liftIO $ atomicModifyIORef (unRegionRef ref) f
regions.cabal view
@@ -1,5 +1,5 @@ name: regions-version: 0.7.0.1+version: 0.8 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -36,12 +36,12 @@ Library GHC-Options: -Wall- build-depends: base >= 4 && < 4.3- , base-unicode-symbols >= 0.1.1 && < 0.3- , transformers >= 0.2 && < 0.3- , MonadCatchIO-transformers >= 0.2 && < 0.3+ build-depends: base >= 4 && < 4.4+ , base-unicode-symbols >= 0.1.1 && < 0.3+ , transformers >= 0.2 && < 0.3+ , monad-peel >= 0.1 && < 0.2 exposed-modules: Control.Monad.Trans.Region- Control.Monad.Trans.Region.ParentOf+ Control.Monad.Trans.Region.Concurrent Control.Monad.Trans.Region.OnExit Data.RegionRef other-modules: Control.Monad.Trans.Region.Internal