resource-simple 0.1 → 0.2

raw patch · 3 files changed

+110/−124 lines, 3 filesdep +mtl-evil-instancesdep −mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl-evil-instances

Dependencies removed: mtl

API changes (from Hackage documentation)

Files

• CONTRIBUTORS +1/−1
• resource-simple.cabal +9/−5
• src/Control/Monad/Resource.hs +100/−118

@@ -1,2 +1,2 @@ Michael Snoyman <michael@snoyman.com>-Robin Banks <anarchomorphism@seomraspraoi.org>+Shane O'Brien <shane@duairc.com>

@@ -1,13 +1,13 @@ name:                resource-simple-version:             0.1+version:             0.2 synopsis:            Allocate resources which are guaranteed to be released. license:             BSD3 license-file:        LICENSE-author:              Robin Banks-maintainer:          anarchomorphism@seomraspraoi.org+author:              Shane O'Brien+maintainer:          shane@duairc.com stability:           Experimental category:            Control-cabal-version:       >= 1.2+cabal-version:       >= 1.6 build-type:          Simple description:   This is a simplified, standalone version of the @ResourceT@ transformer that@@ -43,6 +43,10 @@     containers < 1,     monad-control > 0.3 && < 0.4,     monad-fork < 0.2,-    mtl > 2 && < 3,+    mtl-evil-instances < 0.2,     transformers > 0.2 && < 0.3,     transformers-base < 0.5++source-repository head+  type:     git+  location: git://github.com/duairc/resource-simple.git

@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -14,42 +15,29 @@ -}  module Control.Monad.Resource-    (  -- * Data types+    (  -- * The @ResourceT@ monad transformer       ResourceT-    , ReleaseKey-      -- * Run+      -- ** Running     , runResourceT-      -- * Resource allocation-    , with-    , register-    , release-      -- * Monad transformation-    , transResourceT+      -- ** Monad transformation+    , mapResourceT+      -- * The @MonadResource@ type class+    , MonadResource (..)+    , ReleaseKey     ) where  import           Data.IntMap (IntMap) import qualified Data.IntMap as IntMap-import           Data.IORef-                     ( IORef-                     , newIORef-                     , readIORef-                     , writeIORef-                     , atomicModifyIORef-                     )+import           Data.IORef (IORef, newIORef, writeIORef, atomicModifyIORef) import           Data.Word (Word)-import           Control.Applicative (Applicative (..))+import           Control.Applicative (Applicative (..), Alternative (..)) import           Control.Exception (SomeException, mask, mask_, try, finally)-import           Control.Monad (liftM, when)+import           Control.Monad (MonadPlus (..), ap, liftM, when) import           Control.Monad.Base (MonadBase (..))-import           Control.Monad.Cont.Class (MonadCont(..))-import           Control.Monad.Error.Class (MonadError (..)) import           Control.Monad.Fork.Class (MonadFork (..))-import           Control.Monad.IO.Class (MonadIO (..))-import           Control.Monad.Reader.Class (MonadReader (..))-import           Control.Monad.RWS.Class (MonadRWS (..))-import           Control.Monad.State.Class (MonadState (..))-import           Control.Monad.Writer.Class (MonadWriter (..))+import           Control.Monad.Instances.Evil ()+import           Control.Monad.IO.Class (MonadIO) import           Control.Monad.Trans.Class (MonadTrans (..)) import           Control.Monad.Trans.Control                      ( MonadBaseControl (..)@@ -72,12 +60,16 @@ -- | The Resource transformer. This transformer keeps track of all registered -- actions, and calls them upon exit (via 'runResourceT'). Actions may be -- registered via 'register', or resources may be allocated atomically via--- 'with'. The with function corresponds closely to @bracket@.+-- 'with'. The 'with' function corresponds closely to @bracket@. These+-- functions are provided by 'ResourceT'\'s 'MonadResource' instance. -- -- Releasing may be performed before exit via the 'release' function. This is -- a highly recommended optimization, as it will ensure that scarce resources -- are freed early. Note that calling @release@ will deregister the action, so -- that a release action will only ever be called once.+--+-- Pass-through instances for the @mtl@ type classes are provided+-- automatically by the @mtl-evil-instances@ package. newtype ResourceT m a = ResourceT (IORef ReleaseMap -> m a)  @@ -94,17 +86,23 @@   -------------------------------------------------------------------------------instance Functor m => Functor (ResourceT m) where-    fmap f (ResourceT m) = ResourceT $ \r -> fmap f (m r)+instance Monad m => Functor (ResourceT m) where+    fmap = liftM   -------------------------------------------------------------------------------instance Applicative m => Applicative (ResourceT m) where-    pure = ResourceT . const . pure-    ResourceT mf <*> ResourceT ma = ResourceT $ \r -> mf r <*> ma r+instance Monad m => Applicative (ResourceT m) where+    pure = return+    (<*>) = ap   ------------------------------------------------------------------------------+instance MonadPlus m => Alternative (ResourceT m) where+    empty = mzero+    (<|>) = mplus+++------------------------------------------------------------------------------ instance Monad m => Monad (ResourceT m) where     return = ResourceT . const . return     ResourceT m >>= f = ResourceT $ \r -> m r >>= \a ->@@ -112,13 +110,9 @@   -------------------------------------------------------------------------------instance MonadIO m => MonadIO (ResourceT m) where-    liftIO = lift . liftIO----------------------------------------------------------------------------------instance MonadBase b m => MonadBase b (ResourceT m) where-    liftBase = lift . liftBase+instance MonadPlus m => MonadPlus (ResourceT m) where+    mzero = ResourceT $ const mzero+    mplus (ResourceT m) (ResourceT m') = ResourceT $ \r -> mplus (m r) (m' r)   ------------------------------------------------------------------------------@@ -140,74 +134,56 @@   -------------------------------------------------------------------------------instance MonadCont m => MonadCont (ResourceT m) where-    callCC = liftCallCC callCC-      where-        liftCallCC ccc f = ResourceT $ \r -> ccc $ \ c ->-            let ResourceT m = f (ResourceT . const . c) in m r-    ---------------------------------------------------------------------------------instance MonadError e m => MonadError e (ResourceT m) where-    throwError = lift . throwError-    catchError = liftCatch catchError-      where-        liftCatch f (ResourceT m) h = ResourceT $ \r ->-            f (m r) (\e -> let ResourceT m' = h e in m' r)----------------------------------------------------------------------------------instance MonadReader r m => MonadReader r (ResourceT m) where-    ask = lift ask-    local f (ResourceT m) = ResourceT $ local f . m----------------------------------------------------------------------------------instance MonadRWS r w s m => MonadRWS r w s (ResourceT m)+-- | Transform the monad a @ResourceT@ lives in. This is most often used to+-- strip or add new transformers to a stack, e.g. to run a @ReaderT@.+mapResourceT :: (m a -> n b) -> ResourceT m a -> ResourceT n b+mapResourceT f (ResourceT m) = ResourceT $ f . m   -------------------------------------------------------------------------------instance MonadState s m => MonadState s (ResourceT m) where-    get = lift get-    put s = lift $ put s+-- | Unwrap a 'ResourceT' transformer, and call all registered release+-- actions.+--+-- Note that there is some reference counting involved due to the+-- implementation of 'fork' used in the 'MonadFork' instance. If multiple+-- threads are sharing the same collection of resources, only the last call+-- to @runResourceT@ will deallocate the resources.+runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a+runResourceT (ResourceT r) = do+    istate <- liftBase $ newIORef $ ReleaseMap 0 0 IntMap.empty+    control $ \run -> mask $ \unmask -> do+        stateAlloc istate+        unmask (run $ r istate) `finally` stateCleanup istate   -------------------------------------------------------------------------------instance MonadWriter w m => MonadWriter w (ResourceT m) where-    tell w = lift $ tell w-    listen = transResourceT listen-    pass = transResourceT pass+stateAlloc :: IORef ReleaseMap -> IO ()+stateAlloc istate = atomicModifyIORef istate $ \(ReleaseMap key ref im) ->+    (ReleaseMap key (ref + 1) im, ())   --------------------------------------------------------------------------------- | Perform some allocation, and automatically register a cleanup action.-with :: MonadBase IO m-     => IO a -- ^ allocate-     -> (a -> IO ()) -- ^ free resource-     -> ResourceT m (ReleaseKey, a)-with acquire m = ResourceT $ \istate -> liftBase $ mask $ \unmask -> do-    a <- unmask acquire-    key <- register' istate $ m a-    return (key, a)+stateCleanup :: IORef ReleaseMap -> IO ()+stateCleanup istate = mask_ $ do+    (ref, im) <- atomicModifyIORef istate $ \(ReleaseMap key ref im) ->+        (ReleaseMap key (ref - 1) im, (ref - 1, im))+    when (ref == 0) $ do+        mapM_ (\x -> try' x >> return ()) $ IntMap.elems im+        writeIORef istate $ error "Control.Monad.Resource.stateCleanup: There\+            \ is a bug in the implementation. The mutable state is being\+            \ accessed after cleanup. Please contact the maintainers."+  where+    try' = try :: IO a -> IO (Either SomeException a)   --------------------------------------------------------------------------------- | Register some action that will be called precisely once, either when--- 'runResourceT' is called, or when the 'ReleaseKey' is passed to 'release'.-register :: MonadBase IO m => IO () -> ResourceT m ReleaseKey-register m = ResourceT $ \istate -> liftBase $ register' istate m- register' :: IORef ReleaseMap -> IO () -> IO ReleaseKey register' istate m = atomicModifyIORef istate $ \(ReleaseMap key ref im) ->     (ReleaseMap (key + 1) ref (IntMap.insert key m im), ReleaseKey key)   --------------------------------------------------------------------------------- | Call a release action early, and deregister it from the list of cleanup--- actions to be performed.-release :: MonadBase IO m => ReleaseKey -> ResourceT m ()-release key = ResourceT $ \istate -> liftBase $ release' istate key-+release' :: IORef ReleaseMap -> ReleaseKey -> IO () release' istate (ReleaseKey key) = mask $ \unmask -> do     atomicModifyIORef istate lookupAction >>= maybe (return ()) unmask   where@@ -218,42 +194,48 @@   --------------------------------------------------------------------------------- | Transform the monad a @ResourceT@ lives in. This is most often used to--- strip or add new transformers to a stack, e.g. to run a @ReaderT@.-transResourceT :: (m a -> n b) -> ResourceT m a -> ResourceT n b-transResourceT f (ResourceT mx) = ResourceT (\r -> f (mx r))+-- | The 'MonadResource' type class. This provides the 'with', 'register' and+-- 'release' functions, which are the main functionality of this package. The+-- main instance of this class is 'ResourceT'.+--+-- The others instances are overlapping instances (in the spirit of+-- @mtl-evil-instances@), which provide automatic pass-through instances for+-- 'MonadResource' for every monad transformer. This means that you don't have+-- to provide a pass-through instance of 'MonadResource' for every monad+-- transformer you write.+class MonadIO m => MonadResource m where+    -- | Perform some allocation, and automatically register a cleanup action.+    with :: IO a -> (a -> IO ()) -> m (ReleaseKey, a) +    -- | Register some action that will be run precisely once, either when+    -- 'runResourceT' is called, or when the 'ReleaseKey' is passed to+    -- 'release'.+    register :: IO () -> m ReleaseKey +    -- | Call a release action early, and deregister it from the list of+    -- cleanup actions to be performed.+    release :: ReleaseKey -> m ()++ --------------------------------------------------------------------------------- | Unwrap a 'ResourceT' transformer, and call all registered release--- actions.------ Note that there is some reference counting involved due to the 'MonadFork'--- instance. If multiple threads are sharing the same collection of resources,--- only the last call to @runResourceT@ will deallocate the resources.-runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a-runResourceT (ResourceT r) = do-    istate <- liftBase $ newIORef $ ReleaseMap 0 0 IntMap.empty-    control $ \run -> mask $ \unmask -> do-        stateAlloc istate-        unmask (run $ r istate) `finally` stateCleanup istate+instance MonadBaseControl IO m => MonadResource (ResourceT m) where+    with acquire m = ResourceT $ \istate -> liftBase . mask $ \unmask -> do+        a <- unmask acquire+        key <- register' istate $ m a+        return (key, a)+    register m = ResourceT $ \istate -> liftBase $ register' istate m+    release key = ResourceT $ \istate -> liftBase $ release' istate key   -------------------------------------------------------------------------------stateAlloc :: IORef ReleaseMap -> IO ()-stateAlloc istate = atomicModifyIORef istate $ \(ReleaseMap key ref im) ->-    (ReleaseMap key (ref + 1) im, ())+instance (MonadTrans t, Monad (t m), MonadResource m) => MonadResource (t m) where+    with = (lift .) . with+    register = lift . register+    release = lift . release   -------------------------------------------------------------------------------stateCleanup :: IORef ReleaseMap -> IO ()-stateCleanup istate = mask_ $ do-    (ref, im) <- atomicModifyIORef istate $ \(ReleaseMap key ref im) ->-        (ReleaseMap key (ref - 1) im, (ref - 1, im))-    when (ref == 0) $ do-        mapM_ (\x -> try' x >> return ()) $ IntMap.elems im-        writeIORef istate $ error "Control.Monad.Resource.Trans.stateCleanup:\-            \ There is a bug in the implementation. The mutable state is\-            \ being accessed after cleanup. Please contact the maintainers."-  where-    try' = try :: IO a -> IO (Either SomeException a)+instance (MonadBase b m, MonadResource b) => MonadResource m where+    with = (liftBase .) . with+    register = liftBase . register+    release = liftBase . release