regions (empty) → 0.1

raw patch · 5 files changed

+592/−0 lines, 5 filesdep +MonadCatchIO-transformersdep +basedep +transformerssetup-changed

Dependencies added: MonadCatchIO-transformers, base, transformers, unicode-symbols

Files

• Control/Monad/Trans/Region.hs +37/−0
• Control/Monad/Trans/Region/Internal.hs +454/−0
• LICENSE +31/−0
• Setup.hs +3/−0
• regions.cabal +67/−0

@@ -0,0 +1,37 @@++-------------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.Region+-- Copyright   :  (c) 2009 Bas van Dijk+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com>+--+-- This modules implements a technique called /"Lightweight monadic regions"/+-- invented by Oleg Kiselyov and Chung-chieh Shan+--+-- See: <http://okmij.org/ftp/Haskell/regions.html#light-weight>+--+--------------------------------------------------------------------------------++module Control.Monad.Trans.Region+    ( -- * Regions+      RegionT++      -- * Running regions+    , runRegionT++    , TopRegion+    , runTopRegion+    , forkTopRegion++      -- * Opening resources+    , RegionalHandle+    , open++    , with++      -- * Duplication+    , dup+    ) where++import Control.Monad.Trans.Region.Internal

@@ -0,0 +1,454 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}++-------------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.Region.Internal+-- Copyright   :  (c) 2009 Bas van Dijk+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com>+--+-- This modules implements a technique called /"Lightweight monadic regions"/+-- invented by Oleg Kiselyov and Chung-chieh Shan+--+-- See: <http://okmij.org/ftp/Haskell/regions.html#light-weight>+--+-- 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.+--+--------------------------------------------------------------------------------++module Control.Monad.Trans.Region.Internal+    ( -- * Scarce resources+      Resource+    , Handle+    , openResource+    , closeResource++      -- * Regions+    , RegionT++      -- * Running regions+    , runRegionT++    , TopRegion+    , runTopRegion+    , forkTopRegion++      -- * Opening resources+    , RegionalHandle+    , internalHandle+    , open++    , with++      -- * Duplication+    , Dup+    , dup++      -- * Handy functions for writing monadic instances+    , mapRegionT+    , liftCatch+      -- | /TODO: define and export: /@liftCallCC@++      -- * Parent/child relationship between regions.+    , ParentOf+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Control.Concurrent  ( forkIO, ThreadId )+import Control.Applicative ( Applicative, Alternative )+import Control.Monad       ( when, liftM2, MonadPlus )+import Control.Monad.Fix   ( MonadFix )+import Data.IORef          ( IORef, newIORef+                           , readIORef, modifyIORef, atomicModifyIORef+                           )+-- from MonadCatchIO-transformers:+import Control.Monad.CatchIO ( MonadCatchIO, block, bracket )++-- from transformers:+import Control.Monad.Trans   ( MonadTrans, lift, MonadIO, liftIO )++import qualified Control.Monad.Trans.Reader as Reader ( liftCatch )+import           Control.Monad.Trans.Reader ( ReaderT+                                            , ask+                                            , runReaderT, mapReaderT+                                            )+-- from unicode-symbols:+import Prelude.Unicode ( (∘), (≡) )+++--------------------------------------------------------------------------------+-- * Scarce resources+--------------------------------------------------------------------------------++{-| 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 ∷ *++    openResource  ∷ resource → IO (Handle resource)+    closeResource ∷ Handle resource → IO ()+++--------------------------------------------------------------------------------+-- * Regions+--------------------------------------------------------------------------------++{-| A monad transformer in which resources of type @resource@ 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 α }++    deriving ( Functor+             , Applicative+             , Alternative+             , Monad+             , MonadPlus+             , MonadFix+             , MonadTrans+             , MonadIO+             , MonadCatchIO+             )++data Opened resource = Opened { openedHandle ∷ Handle resource+                              , refCntIORef  ∷ IORef Int+                              }++decrement ∷ IORef Int → IO Int+decrement ioRef = atomicModifyIORef ioRef $ \refCnt →+                  let predRefCnt = pred refCnt+                  in (predRefCnt, predRefCnt)++increment ∷ IORef Int → IO ()+increment ioRef = atomicModifyIORef ioRef $ \refCnt →+                  (succ refCnt, ())+++--------------------------------------------------------------------------------+-- * Running regions+--------------------------------------------------------------------------------++{-| 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.++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.++Note the type variable @s@ of the region wich is only quantified over the region+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 ∷ (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 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 'forkTopRegion'.+-}+type TopRegion resource s = RegionT resource 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 = runRegionT++{-| Return a region which executes the given /top-level/ 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+region (like 'RegionalHandle's for example) can also be referenced in the forked+region.++For example the following is allowed:++@+runRegionT $ do+  regionalHndl <- open resource+  threadId <- forkTopRegion $ doSomethingWith regionalHndl+  doSomethingElseWith regionalHndl+@++Note that the @regionalHndl@ and all other resources opened in the current+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 m = RegionT $ do+  openedResourcesIORef ← ask+  liftIO $ do openedResources ← readIORef openedResourcesIORef+              block $ do mapM_ (increment ∘ refCntIORef) openedResources+                         forkIO $ runRegionWith openedResources m++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)+    where+      closeOpenedResource ∷ Opened resource → IO ()+      closeOpenedResource openedResource = do+        refCnt ← decrement $ refCntIORef openedResource+        when (refCnt ≡ 0) $ closeResource $ openedHandle $ openedResource+++--------------------------------------------------------------------------------+-- * 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.++This function should not be exported to end-users because it allows them to+close the handle manually!+-}+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+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 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.+     → 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.+open resource =+    RegionT $ block $ do+      openedResource ← liftIO $ liftM2 Opened (openResource resource)+                                              (newIORef 1)+      registerOpenedResource openedResource+      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.++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.+with resource f = runRegionT $ open resource >>= f++registerOpenedResource ∷ (Resource resource, MonadIO pr1)+                       ⇒ Opened resource+                       → ReaderT (IORef [Opened resource]) pr1 ()+registerOpenedResource openedResource = do+  openedResourcesIORef ← ask+  liftIO $ modifyIORef openedResourcesIORef (openedResource:)+++--------------------------------------------------------------------------------+-- * Duplication+--------------------------------------------------------------------------------++{-| Duplicate an @&#945;@ in the parent region. This @&#945;@ will usually be a+@(@'RegionalHandle'@ resource)@ but it can be any value \"derived\" from this+regional handle.++For example, suppose you run the following region:++@+runRegionT $ do+@++Inside this region you run a nested /child/ region like:++@+    r1hDup <- runRegionT $ do+@++Now in this child region you open the resource @r1@:++@+        r1h <- open r1+@++...yielding the regional handle @r1h@. Note that:++@r1h :: RegionalHandle resource (RegionT resource cs (RegionT resource 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+region. You can't simply @return r1h@ because then the type variable @cs@,+escapes the inner region.++However, if you duplicate the regional handle you can safely return it.++@+        r1hDup <- dup r1h+        return r1hDup+@++Note that @r1hDup :: RegionalHandle resource (RegionT resource 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.++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+++--------------------------------------------------------------------------------+-- * Handy functions for writing monadic instances+--------------------------------------------------------------------------------++-- TODO:+-- -- | Lift a @callCC@ operation to the new monad.+-- liftCallCC ∷ (((α → pr β) → pr α) → pr α)        -- ^ @callCC@ on the argument monad.+--            → ((α → RegionT s pr β) → RegionT s pr α)+--            → RegionT s pr α+-- liftCallCC callCC f = RegionT $ ???++-- | Transform the computation inside a region.+mapRegionT ∷ (m α → n β) → RegionT resource s m α → RegionT resource 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 f m h = RegionT $ Reader.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 resource ps pr  \`ParentOf\`  RegionT resource 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)))+@+-}+class (Monad pr, Monad cr) ⇒ pr `ParentOf` cr++instance Monad r ⇒ ParentOf r r++instance ( Monad cr+         , cr `TypeCast2` RegionT resource 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 ---------------------------------------------------------------------

@@ -0,0 +1,31 @@+Copyright (c) 2009 Bas van Dijk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The name of Bas van Dijk and the names of contributors may NOT+      be used to endorse or promote products derived from this+      software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,67 @@+name:          regions+version:       0.1+cabal-version: >=1.6+build-type:    Simple+license:       BSD3+license-file:  LICENSE+copyright:     2009 Bas van Dijk+author:        Bas van Dijk+maintainer:    Bas van Dijk <v.dijk.bas@gmail.com>+stability:     experimental+category:      Control+synopsis:      Provides the region monad for safely opening and working with+               scarce resources.+description:++  This package provides the region monad transformer. Scarce resources like+  files, memory pointers or USB devices for example can be opened in a+  region. When the region terminates, all opened resources will be automatically+  closed. The main advantage of regions is that the opened resources can not be+  returned from the region which ensures no I/O with closed resources is+  possible.++  .++  The primary technique used in this package is called \"Lightweight monadic+  regions\" which was invented by Oleg Kiselyov and Chung-chieh Shan.  See:++  .++  <http://okmij.org/ftp/Haskell/regions.html#light-weight>++  .++  This package provides two modules:++  .++  * @Control.Monad.Trans.Region.Internal@ 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!++  .++  * @Control.Monad.Trans.Region@ provides the public and safe interface to+    regions which can be used by end-users.++  .++  Also see the @regions-monadsfd@ and @regions-monadstf@ packages which provide+  instances for the classes in the respected monads packages.++  .++  For an example of how to use this library see the @usb-safe@ package.++source-repository head+  Type:     darcs+  Location: http://code.haskell.org/~basvandijk/code/regions++Library+  GHC-Options: -O2 -Wall+  build-depends: base                      >= 4 && < 4.2+               , unicode-symbols           == 0.1.*+               , transformers              >= 0.1.4 && < 0.2+               , MonadCatchIO-transformers == 0.0.2.*+  exposed-modules: Control.Monad.Trans.Region+                 , Control.Monad.Trans.Region.Internal