diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013, 2014 Gabriel Gonzalez +Copyright (c) 2013, 2014 Gabriella Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification, @@ -8,7 +8,7 @@ * 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. - * Neither the name of Gabriel Gonzalez nor the names of other contributors + * Neither the name of Gabriella Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ -# Pipes-Safe v2.2.9 +# Pipes-Safe `pipes-safe` builds upon -[the `pipes` library](https://github.com/Gabriel439/Haskell-Pipes-Library) to +[the `pipes` library](https://github.com/Gabriella439/Haskell-Pipes-Library) to provide exception safety and resource management. ## Quick start @@ -55,7 +55,7 @@ ## License (BSD 3-clause) -Copyright (c) 2013 Gabriel Gonzalez +Copyright (c) 2013 Gabriella Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification, @@ -68,7 +68,7 @@ list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. -* Neither the name of Gabriel Gonzalez nor the names of other contributors may +* Neither the name of Gabriella Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,38 @@ +# Version + +* Export `SafeT` constructor + +# Version 2.3.1 + +* Remove `MonadFail` constraints introduced in version 2.3.0 +* Implement `MonadFail` for `SafeT` + +# Version 2.3.0 + +* BREAKING CHANGE: Support GHC 8.6.1 + * This requires adding a `MonadFail` constraints to certain utilities + +# Version 2.2.9 + +* Fix build against older versions of `exceptions` + +# Version 2.2.8 + +* Increase upper bound on `exceptions` + +# Version 2.2.7 + +* Increase upper bound on `exceptions` + +# Version 2.2.6 + +* Add `PrimMonad` instance for `SafeT` + +# Version 2.2.5 + +* Add `tryP` and `catchP` +* `MonadThrow` and `MonadCatch` instances for `Proxy` upstreamed to `pipes` + # Version 2.2.4 * Increase upper bound on `pipes` diff --git a/pipes-safe.cabal b/pipes-safe.cabal --- a/pipes-safe.cabal +++ b/pipes-safe.cabal @@ -1,15 +1,15 @@ Name: pipes-safe -Version: 2.2.9 -Cabal-Version: >=1.8.0.2 +Version: 2.3.5 +Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 License-File: LICENSE Extra-Source-Files: README.md changelog.md -Copyright: 2013, 2014 Gabriel Gonzalez -Author: Gabriel Gonzalez -Maintainer: Gabriel439@gmail.com -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 +Copyright: 2013, 2014 Gabriella Gonzalez +Author: Gabriella Gonzalez +Maintainer: GenuineGabriella@gmail.com +Tested-With: GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.1 +Bug-Reports: https://github.com/Gabriella439/Haskell-Pipes-Safe-Library/issues Synopsis: Safety for the pipes ecosystem Description: This package adds resource management and exception handling to the @pipes@ @@ -32,21 +32,22 @@ Category: Control, Pipes, Error Handling Source-Repository head Type: git - Location: https://github.com/Gabriel439/Haskell-Pipes-Safe-Library + Location: https://github.com/Gabriella439/Haskell-Pipes-Safe-Library Library Build-Depends: - base >= 4 && < 5 , - containers >= 0.3.0.0 && < 0.6 , - exceptions >= 0.6 && < 0.11, - mtl >= 2.1 && < 2.3 , - transformers >= 0.2.0.0 && < 0.6 , + base >= 4.14 && < 4.19, + containers >= 0.6.2.1 && < 0.7 , + exceptions >= 0.10.4 && < 0.11, + mtl >= 2.2.2 && < 2.4 , + transformers >= 0.5.6.2 && < 0.7 , transformers-base >= 0.4.4 && < 0.5 , monad-control >= 1.0.0.4 && < 1.1 , - primitive >= 0.6.2.0 && < 0.7 , - pipes >= 4.3.0 && < 4.4 + primitive >= 0.7.0.0 && < 0.9 , + pipes >= 4.3.10 && < 4.4 Exposed-Modules: Pipes.Safe, Pipes.Safe.Prelude HS-Source-Dirs: src GHC-Options: -O2 -Wall + Default-Language: Haskell2010 diff --git a/src/Pipes/Safe.hs b/src/Pipes/Safe.hs --- a/src/Pipes/Safe.hs +++ b/src/Pipes/Safe.hs @@ -1,15 +1,14 @@ {-# LANGUAGE RankNTypes, TypeFamilies, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, - GeneralizedNewtypeDeriving, CPP, Trustworthy #-} + GeneralizedNewtypeDeriving, Trustworthy #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -{-| This module provides an orphan 'MonadCatch' instance for 'Proxy' of the +{-| This module provides an orphan 'MonadMask' instance for 'Proxy' of the form: -> instance (MonadCatch m, MonadIO m) => MonadCatch (Proxy a' a b' b m) where +> instance (MonadMask m, MonadIO m) => MonadMask (Proxy a' a b' b m) where - ... so you can throw and catch exceptions within pipes using all - 'MonadCatch' operations. + Which is needed to implement the instance for MonadSafe for Proxy. This module also provides generalized versions of some 'MonadCatch' operations so that you can also protect against premature termination of @@ -63,7 +62,7 @@ module Pipes.Safe ( -- * SafeT - SafeT + SafeT(SafeT) , runSafeT , runSafeP @@ -81,22 +80,23 @@ , bracket_ , bracketOnError + -- * Internals + , Env + -- * Re-exports -- $reexports , module Control.Monad.Catch , module Control.Exception ) where -import Control.Applicative (Applicative, Alternative) +import Control.Applicative (Alternative) import Control.Exception(Exception(..), SomeException(..)) import qualified Control.Monad.Catch as C import Control.Monad.Catch ( MonadCatch(..) , MonadThrow(..) , MonadMask(..) -#if MIN_VERSION_exceptions(0,10,0) , ExitCase(..) -#endif , mask_ , uninterruptibleMask_ , catchAll @@ -134,13 +134,9 @@ 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 Data.Kind (Type) import qualified Data.Map as M -import Data.Monoid (Monoid) import Pipes (Proxy, Effect, Effect', runEffect) import Pipes.Internal (Proxy(..)) @@ -171,7 +167,9 @@ unmask (Respond b fb') = Respond b (unmask . fb') unmask (M m) = M $ do -- retrieve base's unmask and apply to merged action - Masked unmaskVariant <- liftIO $ readIORef ioref + unmaskVariant <- liftIO $ do + Masked unmaskVariant <- readIORef ioref + return unmaskVariant unmaskVariant (m >>= chunk >>= return . unmask) unmask (Pure q) = Pure q @@ -187,7 +185,6 @@ uninterruptibleMask = liftMask uninterruptibleMask -#if MIN_VERSION_exceptions(0,10,0) generalBracket acquire release_ use = mask $ \unmasked -> do a <- acquire let action = do @@ -202,41 +199,64 @@ -- | This is to avoid an unnecessary partial pattern match in `generalBracket` data ExitCase_ a = ExitCaseSuccess_ a | ExitCaseException_ SomeException -#endif data Finalizers m = Finalizers { _nextKey :: !Integer , _finalizers :: !(M.Map Integer (m ())) } +-- | Internal 'SafeT' read-write environment. Exported only so that it can be +-- passed around unmodified by users of the v'SafeT' constructor. +-- +-- Warning: Using the 'Env' outside the corresponding 'SafeT' scope will +-- result in undefined behavior. +newtype Env m = Env (IORef (Maybe (Finalizers m))) + {-| 'SafeT' is a monad transformer that extends the base monad with the ability to 'register' and 'release' finalizers. All unreleased finalizers are called at the end of the 'SafeT' block, even 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, MonadFix, - EC.MonadError e, SC.MonadState s, WC.MonadWriter w, CC.MonadCont, - MonadThrow, MonadCatch, MonadMask, MonadIO, B.MonadBase b) +newtype SafeT m r + = -- | Constructor exported in case it's necessary for integrating 'SafeT' + -- with other libraries. For example, implementing @mtl@-like + -- Monad/Something/ instances will often require access to the 'SafeT' + -- constructor. + -- + -- Warning: Using the 'Env' outside the corresponding 'SafeT' scope will + -- result in undefined behavior. + SafeT (R.ReaderT (Env m) m r) + deriving + ( Functor + , Applicative + , Alternative + , Monad +-- The derived instance for `MonadFail` requires a `MonadFail` instance for +-- `ReaderT` which is first available in `transformers-0.5.0.0` + , MonadFail + , MonadPlus + , MonadFix + , EC.MonadError e + , SC.MonadState s + , WC.MonadWriter w + , CC.MonadCont + , MonadThrow + , MonadCatch + , MonadMask + , MonadIO + , B.MonadBase b + ) instance MonadTrans SafeT where lift m = SafeT (lift m) instance MonadBaseControl b m => MonadBaseControl b (SafeT m) where -#if MIN_VERSION_monad_control(1,0,0) type StM (SafeT m) a = StM m a liftBaseWith f = SafeT $ R.ReaderT $ \reader' -> liftBaseWith $ \runInBase -> f $ runInBase . (\(SafeT r) -> R.runReaderT r reader' ) restoreM = SafeT . R.ReaderT . const . restoreM -#else - newtype StM (SafeT m) a = StMT (StM m a) - liftBaseWith f = SafeT $ R.ReaderT $ \reader' -> - liftBaseWith $ \runInBase -> - f $ liftM StMT . runInBase . \(SafeT r) -> R.runReaderT r reader' - restoreM (StMT base) = SafeT $ R.ReaderT $ const $ restoreM base -#endif instance Prim.PrimMonad m => Prim.PrimMonad (SafeT m) where type PrimState (SafeT m) = Prim.PrimState m @@ -247,19 +267,15 @@ the end of the computation -} runSafeT :: (MonadMask m, MonadIO m) => SafeT m r -> m r -runSafeT m = C.bracket +runSafeT (SafeT 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" Just (Finalizers _ fs) -> mapM snd (M.toDescList fs) ) - (R.runReaderT (unSafeT m)) + (R.runReaderT m . Env) {-# INLINABLE runSafeT #-} {-| Run 'SafeT' in the base monad, executing all unreleased finalizers at the @@ -269,7 +285,7 @@ finalization without exiting the 'Proxy' monad. -} runSafeP :: (MonadMask m, MonadIO m) => Effect (SafeT m) r -> Effect' m r -runSafeP = lift . runSafeT . runEffect +runSafeP e = lift . runSafeT . runEffect $ e {-# INLINABLE runSafeP #-} -- | Token used to 'release' a previously 'register'ed finalizer @@ -282,7 +298,7 @@ {-| The monad used to run resource management actions, corresponding to the monad directly beneath 'SafeT' -} - type Base (m :: * -> *) :: * -> * + type Base (m :: Type -> Type) :: Type -> Type -- | Lift an action from the 'Base' monad liftBase :: Base m r -> m r @@ -306,13 +322,9 @@ liftBase = lift register io = do - ioref <- SafeT R.ask + Env 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) -> @@ -320,18 +332,14 @@ return (ReleaseKey n) release key = do - ioref <- SafeT R.ask -#if MIN_VERSION_base(4,6,0) + Env ioref <- SafeT R.ask liftIO $ atomicModifyIORef' ioref $ \val -> -#else - liftIO $ atomicModifyIORef ioref $ \val -> -#endif case val of Nothing -> error "release: SafeT block is closed" Just (Finalizers n fs) -> (Just $! Finalizers n (M.delete (unlock key) fs), ()) -instance (MonadSafe m) => MonadSafe (Proxy a' a b' b m) where +instance MonadSafe m => MonadSafe (Proxy a' a b' b m) where type Base (Proxy a' a b' b m) = Base m liftBase = lift . liftBase register = lift . register diff --git a/src/Pipes/Safe/Prelude.hs b/src/Pipes/Safe/Prelude.hs --- a/src/Pipes/Safe/Prelude.hs +++ b/src/Pipes/Safe/Prelude.hs @@ -5,25 +5,64 @@ module Pipes.Safe.Prelude ( -- * Handle management withFile, + withBinaryFile, + openFile, + openBinaryFile, -- * String I/O -- $strings readFile, - writeFile + writeFile, + + -- * Registering/releasing + allocate, + allocate_ ) where +import Control.Monad.Catch (mask_) import Control.Monad.IO.Class (MonadIO(liftIO)) import Pipes (Producer', Consumer') -import Pipes.Safe (bracket, MonadSafe) +import Pipes.Safe (bracket, liftBase, register, Base, MonadSafe, ReleaseKey) import qualified Pipes.Prelude as P import qualified System.IO as IO import Prelude hiding (readFile, writeFile) --- | Acquire a 'IO.Handle' within 'MonadSafe' -withFile :: (MonadSafe m) => FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r +{- | Acquire a 'IO.Handle' within 'MonadSafe' + + The file is opened in text mode. See also: 'withBinaryFile' +-} +withFile :: MonadSafe m => FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r withFile file ioMode = bracket (liftIO $ IO.openFile file ioMode) (liftIO . IO.hClose) {-# INLINABLE withFile #-} +{- | Like 'withFile', but open the file in binary mode + + See 'System.IO.hSetBinaryMode' for the differences between binary and text mode. +-} +withBinaryFile :: MonadSafe m => FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r +withBinaryFile file ioMode = bracket (liftIO $ IO.openBinaryFile file ioMode) (liftIO . IO.hClose) +{-# INLINABLE withBinaryFile #-} + +{- | Acquire a 'IO.Handle' within 'MonadSafe' + + The 'ReleaseKey' can be used to close the handle with 'Pipes.Safe.release'; + otherwise the handle will be closed automatically at the conclusion of the + 'MonadSafe' block. + + The file is opened in text mode. See also: 'openBinaryFile' +-} +openFile :: MonadSafe m => FilePath -> IO.IOMode -> m (ReleaseKey, IO.Handle) +openFile file ioMode = allocate (liftIO $ IO.openFile file ioMode) (liftIO . IO.hClose) +{-# INLINABLE openFile #-} + +{- | Like 'openFile', but open the file in binary mode + + See 'System.IO.hSetBinaryMode' for the differences between binary and text mode. +-} +openBinaryFile :: MonadSafe m => FilePath -> IO.IOMode -> m (ReleaseKey, IO.Handle) +openBinaryFile file ioMode = allocate (liftIO $ IO.openBinaryFile file ioMode) (liftIO . IO.hClose) +{-# INLINABLE openBinaryFile #-} + {- $strings Note that 'String's are very inefficient, and I will release future separate packages with 'Data.ByteString.ByteString' and 'Data.Text.Text' operations. @@ -34,13 +73,41 @@ {-| Read lines from a file, automatically opening and closing the file as necessary -} -readFile :: (MonadSafe m) => FilePath -> Producer' String m () +readFile :: MonadSafe m => FilePath -> Producer' String m () readFile file = withFile file IO.ReadMode P.fromHandle {-# INLINABLE readFile #-} {-| Write lines to a file, automatically opening and closing the file as necessary -} -writeFile :: (MonadSafe m) => FilePath -> Consumer' String m r -writeFile file = withFile file IO.WriteMode P.toHandle +writeFile :: MonadSafe m => FilePath -> Consumer' String m r +writeFile file = withFile file IO.WriteMode $ \h -> P.toHandle h {-# INLINABLE writeFile #-} + +{- | Acquire some resource with a guarantee that it will eventually be released + + The 'ReleaseKey' can be passed to 'Pipes.Safe.release' to + release the resource manually. If this has not been done by the end + of the 'MonadSafe' block, the resource will be released automatically. +-} +allocate :: MonadSafe m => + Base m a -- ^ Acquire + -> (a -> Base m ()) -- ^ Release + -> m (ReleaseKey, a) +allocate acq rel = mask_ $ do + a <- liftBase acq + key <- register (rel a) + return (key, a) + +{- | Like 'allocate', but for when the resource itself is not needed + + The acquire action runs immediately. The 'ReleaseKey' can be passed + to 'Pipes.Safe.release' to run the release action. If this has not been + done by the end of the 'MonadSafe' block, the release action will be + run automatically. +-} +allocate_ :: MonadSafe m => + Base m a -- ^ Acquire + -> (Base m ()) -- ^ Release + -> m ReleaseKey +allocate_ acq rel = fmap fst (allocate acq (const rel))