pipes-safe 2.2.4 → 2.2.5
raw patch · 3 files changed
+51/−13 lines, 3 filesdep ~basedep ~pipes
Dependency ranges changed: base, pipes
Files
- README.md +1/−1
- pipes-safe.cabal +3/−3
- src/Pipes/Safe.hs +47/−9
README.md view
@@ -1,4 +1,4 @@-# Pipes-Safe v2.2.4+# Pipes-Safe v2.2.5 `pipes-safe` builds upon [the `pipes` library](https://github.com/Gabriel439/Haskell-Pipes-Library) to
pipes-safe.cabal view
@@ -1,5 +1,5 @@ Name: pipes-safe-Version: 2.2.4+Version: 2.2.5 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -8,7 +8,7 @@ Copyright: 2013, 2014 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: Gabriel439@gmail.com-Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1+Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Safe-Library/issues Synopsis: Safety for the pipes ecosystem Description:@@ -43,7 +43,7 @@ transformers >= 0.2.0.0 && < 0.6, transformers-base >= 0.4.4 && < 0.5, monad-control >= 1.0.0.4 && < 1.1,- pipes >= 4.0.0 && < 4.3+ pipes >= 4.3.0 && < 4.4 Exposed-Modules: Pipes.Safe, Pipes.Safe.Prelude
src/Pipes/Safe.hs view
@@ -74,6 +74,8 @@ -- * Utilities -- $utilities , onException+ , tryP+ , catchP , finally , bracket , bracket_@@ -105,12 +107,12 @@ , handleIOError , handleJust , handleIf- , try , tryJust , Exception(..) , SomeException )-import Control.Monad (MonadPlus)+import Control.Monad (MonadPlus, liftM)+import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.Class (MonadTrans(lift))@@ -128,7 +130,11 @@ import qualified Control.Monad.Trans.Writer.Lazy as W import qualified Control.Monad.Trans.Writer.Strict as W' import qualified Control.Monad.Writer.Class as WC+#if MIN_VERSION_base(4,6,0) import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef')+#else+import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef)+#endif import qualified Data.Map as M import Data.Monoid (Monoid) import Pipes (Proxy, Effect, Effect', runEffect)@@ -173,12 +179,6 @@ loop $ k unmask -instance (MonadThrow m) => MonadThrow (Proxy a' a b' b m) where- throwM = lift . throwM--instance (MonadCatch m) => MonadCatch (Proxy a' a b' b m) where- catch = liftCatchError C.catch- instance (MonadMask m, MonadIO m) => MonadMask (Proxy a' a b' b m) where mask = liftMask mask uninterruptibleMask = liftMask uninterruptibleMask@@ -195,7 +195,7 @@ in the event of exceptions. -} newtype SafeT m r = SafeT { unSafeT :: R.ReaderT (IORef (Maybe (Finalizers m))) m r }- deriving (Functor, Applicative, Alternative, Monad, MonadPlus,+ deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadFix, EC.MonadError e, SC.MonadState s, WC.MonadWriter w, CC.MonadCont, MonadThrow, MonadCatch, MonadMask, MonadIO, B.MonadBase b) @@ -224,7 +224,11 @@ runSafeT m = C.bracket (liftIO $ newIORef $! Just $! Finalizers 0 M.empty) (\ioref -> do+#if MIN_VERSION_base(4,6,0) mres <- liftIO $ atomicModifyIORef' ioref $ \val ->+#else+ mres <- liftIO $ atomicModifyIORef ioref $ \val ->+#endif (Nothing, val) case mres of Nothing -> error "runSafeT's resources were freed by another"@@ -278,7 +282,11 @@ register io = do ioref <- SafeT R.ask liftIO $ do+#if MIN_VERSION_base(4,6,0) n <- atomicModifyIORef' ioref $ \val ->+#else+ n <- atomicModifyIORef ioref $ \val ->+#endif case val of Nothing -> error "register: SafeT block is closed" Just (Finalizers n fs) ->@@ -287,7 +295,11 @@ release key = do ioref <- SafeT R.ask+#if MIN_VERSION_base(4,6,0) liftIO $ atomicModifyIORef' ioref $ \val ->+#else+ liftIO $ atomicModifyIORef ioref $ \val ->+#endif case val of Nothing -> error "release: SafeT block is closed" Just (Finalizers n fs) ->@@ -432,3 +444,29 @@ @Control.Exception@ re-exports 'Exception' and 'SomeException'. -}++{- | Transform a 'Proxy' into one that catches any exceptions caused by its+ effects, and returns the resulting exception.+-}+tryP :: (MonadSafe m, Exception e)+ => Proxy a' a b' b m r -> Proxy a' a b' b m (Either e r)+tryP p = case p of+ Request a' fa -> Request a' (\a -> tryP (fa a))+ Respond b fb' -> Respond b (\b' -> tryP (fb' b'))+ M m -> M $ C.try m >>= \eres -> return $ case eres of+ Left e -> Pure (Left e)+ Right a -> tryP a+ Pure r -> Pure (Right r)++{- | Allows direct handling of exceptions raised by the effects in a 'Proxy'.+-}+catchP :: (MonadSafe m, Exception e)+ => Proxy a' a b' b m r -> (e -> Proxy a' a b' b m r)+ -> Proxy a' a b' b m r+catchP p0 f = go p0+ where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> M $ C.catch (liftM go m) (return . f)+ Pure r -> Pure r