diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,105 @@ +4.3.0 + +* BREAKING CHANGE: Remove `Alternative`/`MonadPlus` instances for `Proxy` + * See commit 08e7302f43dbf2a40bd367c5ee73ee3367e17768 which explains why +* Add `Traversable` instance for `ListT` +* New `MonadThrow`/`MonadCatch`/`MMonad`/`Semigroup`/`MonadZip` instances for + `ListT` +* New `MonadThrow`/`MonadCatch` instances for `Proxy` +* Fix lower bound on `mtl` +* Increase upper bound on `optparse-applicative` + +4.2.0 + +* BREAKING CHANGE: Switch from `ErrorT` to `ExceptT` +* Add `Foldable` instance for `ListT` +* Fix all warnings +* Enable foldr/build fusion for `toList` + +4.1.9 + +* Increase lower bound on `criterion` +* Increase upper bound on `transformers` for tests/benchmarks +* Optimize code by delaying `INLINABLE` annotations + +4.1.8 + +* Increase upper bound on `transformers` +* Prepare for MRP (Monad of no Return Proposal) + +4.1.7 + +* Increase lower bound on `deepseq` +* Add `unfoldr` +* Add `loop` +* Add `toListM'` +* Improve efficiency of `drop` +* License tutorial under Creative Commons license + +4.1.6 + +* Increase lower bound on `base` +* Add diagrams to `Pipes.Core` documentation +* Add `mapM_` +* Add `takeWhile'` +* Add `seq` +* Improve efficiency of `toListM` + +4.1.5 + +* Increase upper bound on `criterion` + +4.1.4 + +* Increase upper bound on `criterion` +* Add `Monoid` instance for `Proxy` + +4.1.3 + +* Increase lower bound on `mtl` +* Re-export `void` +* Add `fold'` +* Add `foldM'` + +4.1.2 + +* Increase upper bounds on `transformers` and `mtl` + +4.1.1 + +* Add `runListT` +* Add `MMonad` instance for `Proxy` +* Add `repeatM` +* Add laws to documentation of `Pipes.Prelude` utilities + +4.1.0 + +* Remove Haskell98 support +* Use internal `X` type instead of `Data.Void` +* Document `Pipes.Lift` module:w +* Add `drain` +* Add `sequence` + +4.0.2 + +* Improve performance of `each` +* Add tutorial appendix explaining how to work around quadratic time complexity + +4.0.1 + +* Remove `WriterT` and `RWST` benchmarks +* Add `Enumerable` instance for `ErrorT` +* Add cabal flag for Haskell98 compilation +* Add several rewrite rules +* Add `mtl` instances for `ListT` +* Fix implementation of `pass`, which did not satisfy `Writer` laws +* Implement `fail` for `ListT` +* Add type synonym table to tutorial appendix +* Add QuickCheck tests for `pipes` laws +* Add `mapFoldable` +* Add `Monoid` instance for `ListT` +* Add manual proofs of `pipes` laws in `laws.md` + +4.0.0 + +Major upgrade of `pipes` to no longer use `Proxy` type class diff --git a/pipes.cabal b/pipes.cabal --- a/pipes.cabal +++ b/pipes.cabal @@ -1,5 +1,5 @@ Name: pipes -Version: 4.2.0 +Version: 4.3.0 Cabal-Version: >= 1.10 Build-Type: Simple Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 @@ -35,6 +35,8 @@ . Read "Pipes.Tutorial" for an extensive tutorial. Category: Control, Pipes +Extra-Source-Files: + CHANGELOG.md Source-Repository head Type: git Location: https://github.com/Gabriel439/Haskell-Pipes-Library @@ -46,8 +48,9 @@ Build-Depends: base >= 4.4 && < 5 , transformers >= 0.2.0.0 && < 0.6, + exceptions >= 0.4 && < 0.9, mmorph >= 1.0.0 && < 1.1, - mtl >= 2.1 && < 2.3 + mtl >= 2.2.1 && < 2.3 Exposed-Modules: Pipes, @@ -69,7 +72,7 @@ Build-Depends: base >= 4.4 && < 5 , criterion >= 1.1.1.0 && < 1.2, - optparse-applicative >= 0.12 && < 0.13, + optparse-applicative >= 0.12 && < 0.14, mtl >= 2.1 && < 2.3, pipes @@ -100,7 +103,7 @@ Build-Depends: base >= 4.4 && < 5 , criterion >= 1.1.1.0 && < 1.2 , - optparse-applicative >= 0.12 && < 0.13, + optparse-applicative >= 0.12 && < 0.14, mtl >= 2.1 && < 2.3 , pipes , transformers >= 0.2.0.0 && < 0.6 diff --git a/src/Pipes.hs b/src/Pipes.hs --- a/src/Pipes.hs +++ b/src/Pipes.hs @@ -64,6 +64,7 @@ ) where import Control.Monad (void) +import Control.Monad.Catch (MonadThrow(..), MonadCatch(..), MonadMask(..)) import Control.Monad.Except (MonadError(..)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad (MonadPlus(mzero, mplus)) @@ -74,6 +75,7 @@ import Control.Monad.Trans.Identity (IdentityT(runIdentityT)) import Control.Monad.Trans.Maybe (MaybeT(runMaybeT)) import Control.Monad.Writer (MonadWriter(..)) +import Control.Monad.Zip (MonadZip(..)) import Pipes.Core import Pipes.Internal (Proxy(..)) import qualified Data.Foldable as F @@ -83,11 +85,12 @@ #else import Control.Applicative import Data.Foldable (Foldable) +import Data.Traversable (Traversable(..)) import Data.Monoid #endif -- Re-exports -import Control.Monad.Morph (MFunctor(hoist)) +import Control.Monad.Morph (MFunctor(hoist), MMonad(embed)) infixl 4 <~ infixr 4 ~> @@ -404,22 +407,27 @@ -} newtype ListT m a = Select { enumerate :: Producer a m () } -instance (Monad m) => Functor (ListT m) where +instance Monad m => Functor (ListT m) where fmap f p = Select (for (enumerate p) (\a -> yield (f a))) + {-# INLINE fmap #-} -instance (Monad m) => Applicative (ListT m) where +instance Monad m => Applicative (ListT m) where pure a = Select (yield a) + {-# INLINE pure #-} mf <*> mx = Select ( for (enumerate mf) (\f -> for (enumerate mx) (\x -> yield (f x) ) ) ) -instance (Monad m) => Monad (ListT m) where +instance Monad m => Monad (ListT m) where return = pure + {-# INLINE return #-} m >>= f = Select (for (enumerate m) (\a -> enumerate (f a))) + {-# INLINE (>>=) #-} fail _ = mzero + {-# INLINE fail #-} -instance (Foldable m) => Foldable (ListT m) where +instance Foldable m => Foldable (ListT m) where foldMap f = go . enumerate where go p = case p of @@ -429,6 +437,16 @@ Pure _ -> mempty {-# INLINE foldMap #-} +instance (Monad m, Traversable m) => Traversable (ListT m) where + traverse k (Select p) = fmap Select (traverse_ p) + where + traverse_ (Request v _ ) = closed v + traverse_ (Respond a fu) = _Respond <$> k a <*> traverse_ (fu ()) + where + _Respond a_ a' = Respond a_ (\_ -> a') + traverse_ (M m ) = fmap M (traverse traverse_ m) + traverse_ (Pure r ) = pure (Pure r) + instance MonadTrans ListT where lift m = Select (do a <- lift m @@ -436,35 +454,51 @@ instance (MonadIO m) => MonadIO (ListT m) where liftIO m = lift (liftIO m) + {-# INLINE liftIO #-} instance (Monad m) => Alternative (ListT m) where empty = Select (return ()) + {-# INLINE empty #-} p1 <|> p2 = Select (do enumerate p1 enumerate p2 ) instance (Monad m) => MonadPlus (ListT m) where mzero = empty + {-# INLINE mzero #-} mplus = (<|>) + {-# INLINE mplus #-} instance MFunctor ListT where hoist morph = Select . hoist morph . enumerate + {-# INLINE hoist #-} +instance MMonad ListT where + embed f m = Select (enumerate (embed f m)) + {-# INLINE embed #-} + instance (Monad m) => Monoid (ListT m a) where mempty = empty + {-# INLINE mempty #-} mappend = (<|>) + {-# INLINE mappend #-} instance (MonadState s m) => MonadState s (ListT m) where get = lift get + {-# INLINE get #-} put s = lift (put s) + {-# INLINE put #-} state f = lift (state f) + {-# INLINE state #-} instance (MonadWriter w m) => MonadWriter w (ListT m) where writer = lift . writer + {-# INLINE writer #-} tell w = lift (tell w) + {-# INLINE tell #-} listen l = Select (go (enumerate l) mempty) where @@ -489,15 +523,43 @@ instance (MonadReader i m) => MonadReader i (ListT m) where ask = lift ask + {-# INLINE ask #-} local f l = Select (local f (enumerate l)) + {-# INLINE local #-} reader f = lift (reader f) + {-# INLINE reader #-} instance (MonadError e m) => MonadError e (ListT m) where throwError e = lift (throwError e) + {-# INLINE throwError #-} catchError l k = Select (catchError (enumerate l) (\e -> enumerate (k e))) + {-# INLINE catchError #-} + +instance MonadThrow m => MonadThrow (ListT m) where + throwM = Select . throwM + {-# INLINE throwM #-} + +instance MonadCatch m => MonadCatch (ListT m) where + catch l k = Select (catch (enumerate l) (\e -> enumerate (k e))) + {-# INLINE catch #-} + +instance Monad m => MonadZip (ListT m) where + mzipWith f = go + where + go xs ys = Select $ do + xres <- lift $ next (enumerate xs) + case xres of + Left r -> return r + Right (x, xnext) -> do + yres <- lift $ next (enumerate ys) + case yres of + Left r -> return r + Right (y, ynext) -> do + yield (f x y) + enumerate (go (Select xnext) (Select ynext)) -- | Run a self-contained `ListT` computation runListT :: Monad m => ListT m a -> m () diff --git a/src/Pipes/Internal.hs b/src/Pipes/Internal.hs --- a/src/Pipes/Internal.hs +++ b/src/Pipes/Internal.hs @@ -34,11 +34,11 @@ , closed ) where -import Control.Monad (MonadPlus(..)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift)) import Control.Monad.Morph (MFunctor(hoist), MMonad(embed)) import Control.Monad.Except (MonadError(..)) +import Control.Monad.Catch (MonadThrow(..), MonadCatch(..), MonadMask(..)) import Control.Monad.Reader (MonadReader(..)) import Control.Monad.State (MonadState(..)) import Control.Monad.Writer (MonadWriter(..)) @@ -219,13 +219,12 @@ p' <- m return (go p') ) `catchError` (\e -> return (f e)) ) -instance MonadPlus m => Alternative (Proxy a' a b' b m) where - empty = mzero - (<|>) = mplus +instance MonadThrow m => MonadThrow (Proxy a' a b' b m) where + throwM = lift . throwM + {-# INLINE throwM #-} -instance MonadPlus m => MonadPlus (Proxy a' a b' b m) where - mzero = lift mzero - mplus p0 p1 = go p0 +instance MonadCatch m => MonadCatch (Proxy a' a b' b m) where + catch p0 f = go p0 where go p = case p of Request a' fa -> Request a' (\a -> go (fa a )) @@ -233,7 +232,7 @@ Pure r -> Pure r M m -> M ((do p' <- m - return (go p') ) `mplus` return p1 ) + return (go p') ) `catch` (\e -> return (f e)) ) {-| The monad transformer laws are correct when viewed through the 'observe' function: diff --git a/src/Pipes/Prelude.hs b/src/Pipes/Prelude.hs --- a/src/Pipes/Prelude.hs +++ b/src/Pipes/Prelude.hs @@ -613,7 +613,7 @@ Use these to fold the output of a 'Producer'. Many of these folds will stop drawing elements if they can compute their result early, like 'any': ->>> P.any null P.stdinLn +>>> P.any Prelude.null P.stdinLn Test ABC