Hello community, here is the log from the commit of package ghc-pipes for openSUSE:Factory checked in at 2017-03-14 10:05:45 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-pipes (Old) and /work/SRC/openSUSE:Factory/.ghc-pipes.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-pipes" Tue Mar 14 10:05:45 2017 rev:6 rq:461671 version:4.3.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-pipes/ghc-pipes.changes 2016-07-21 08:16:38.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-pipes.new/ghc-pipes.changes 2017-03-14 10:05:46.194979465 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:09:22 UTC 2017 - [email protected] + +- Update to version 4.3.2 with cabal2obs. + +------------------------------------------------------------------- Old: ---- pipes-4.1.9.tar.gz New: ---- pipes-4.3.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-pipes.spec ++++++ --- /var/tmp/diff_new_pack.uEeou2/_old 2017-03-14 10:05:46.762899047 +0100 +++ /var/tmp/diff_new_pack.uEeou2/_new 2017-03-14 10:05:46.766898481 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-pipes # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,15 +19,15 @@ %global pkg_name pipes %bcond_with tests Name: ghc-%{pkg_name} -Version: 4.1.9 +Version: 4.3.2 Release: 0 Summary: Compositional pipelines License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: +BuildRequires: ghc-exceptions-devel BuildRequires: ghc-mmorph-devel BuildRequires: ghc-mtl-devel BuildRequires: ghc-rpm-macros @@ -38,7 +38,6 @@ BuildRequires: ghc-test-framework-devel BuildRequires: ghc-test-framework-quickcheck2-devel %endif -# End cabal-rpm deps %description `pipes` is a clean and powerful stream processing library that lets you build @@ -79,20 +78,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache @@ -106,5 +99,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc CHANGELOG.md %changelog ++++++ pipes-4.1.9.tar.gz -> pipes-4.3.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/CHANGELOG.md new/pipes-4.3.2/CHANGELOG.md --- old/pipes-4.1.9/CHANGELOG.md 1970-01-01 01:00:00.000000000 +0100 +++ new/pipes-4.3.2/CHANGELOG.md 2016-12-20 19:53:21.000000000 +0100 @@ -0,0 +1,114 @@ +4.3.2 + +* BUG FIX: Fix `MMonad` instance for `ListT` + * The old instance was an infinite loop + +4.3.1 + +* Support building against `ghc-7.4` + +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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/LICENSE new/pipes-4.3.2/LICENSE --- old/pipes-4.1.9/LICENSE 2014-01-24 03:06:07.000000000 +0100 +++ new/pipes-4.3.2/LICENSE 2016-12-20 19:53:21.000000000 +0100 @@ -1,4 +1,4 @@ -Copyright (c) 2012-2014 Gabriel Gonzalez +Copyright (c) 2012-2016 Gabriel Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/benchmarks/Common.hs new/pipes-4.3.2/benchmarks/Common.hs --- old/pipes-4.1.9/benchmarks/Common.hs 2016-05-07 19:09:03.000000000 +0200 +++ new/pipes-4.3.2/benchmarks/Common.hs 2016-12-20 19:53:21.000000000 +0100 @@ -3,6 +3,7 @@ import Criterion.Main (Benchmark, runMode) import Criterion.Main.Options as Criterion import Data.Maybe (fromMaybe) +import Data.Monoid import Options.Applicative commonMain :: Int -- ^ default maximum data size diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/benchmarks/LiftBench.hs new/pipes-4.3.2/benchmarks/LiftBench.hs --- old/pipes-4.1.9/benchmarks/LiftBench.hs 2015-10-18 04:06:47.000000000 +0200 +++ new/pipes-4.3.2/benchmarks/LiftBench.hs 2016-12-20 19:53:21.000000000 +0100 @@ -2,7 +2,6 @@ module Main (main) where import Common (commonMain) -import Control.DeepSeq import Control.Monad.Identity import qualified Control.Monad.Trans.Reader as R import qualified Control.Monad.Trans.State.Strict as S diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/pipes.cabal new/pipes-4.3.2/pipes.cabal --- old/pipes-4.1.9/pipes.cabal 2016-05-07 19:10:17.000000000 +0200 +++ new/pipes-4.3.2/pipes.cabal 2016-12-20 19:53:21.000000000 +0100 @@ -1,10 +1,11 @@ Name: pipes -Version: 4.1.9 +Version: 4.3.2 Cabal-Version: >= 1.10 Build-Type: Simple +Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 License: BSD3 License-File: LICENSE -Copyright: 2012-2014 Gabriel Gonzalez +Copyright: 2012-2016 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: [email protected] Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Library/issues @@ -34,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 @@ -45,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, @@ -68,9 +72,9 @@ 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 >= 4.0.0 && < 4.2 + pipes test-suite tests Default-Language: Haskell2010 @@ -81,7 +85,7 @@ Build-Depends: base >= 4.4 && < 5 , - pipes >= 4.0.0 && < 4.2 , + pipes , QuickCheck >= 2.4 && < 3 , mtl >= 2.1 && < 2.3 , test-framework >= 0.4 && < 1 , @@ -97,10 +101,9 @@ GHC-Options: -O2 -Wall -rtsopts -fno-warn-unused-do-bind Build-Depends: - base >= 4.4 && < 5 , - criterion >= 1.1.1.0 && < 1.2, - optparse-applicative >= 0.12 && < 0.13, - deepseq >= 1.4.0.0 , - mtl >= 2.1 && < 2.3, - pipes >= 4.0.0 && < 4.2, - transformers >= 0.2.0.0 && < 0.6 + base >= 4.4 && < 5 , + criterion >= 1.1.1.0 && < 1.2 , + optparse-applicative >= 0.12 && < 0.14, + mtl >= 2.1 && < 2.3 , + pipes , + transformers >= 0.2.0.0 && < 0.6 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/src/Pipes/Internal.hs new/pipes-4.3.2/src/Pipes/Internal.hs --- old/pipes-4.1.9/src/Pipes/Internal.hs 2016-02-08 06:07:59.000000000 +0100 +++ new/pipes-4.3.2/src/Pipes/Internal.hs 2016-12-20 19:53:21.000000000 +0100 @@ -18,13 +18,12 @@ any functions which can violate the monad transformer laws. -} -{-# LANGUAGE - FlexibleInstances - , MultiParamTypeClasses - , RankNTypes - , UndecidableInstances - , Trustworthy - #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Trustworthy #-} module Pipes.Internal ( -- * Internal @@ -35,17 +34,23 @@ , closed ) where -import Control.Applicative ( - Applicative(pure, (<*>), (*>)), Alternative(empty, (<|>)) ) -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.Error (MonadError(..)) +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(..)) -import Data.Monoid (Monoid(mempty,mappend)) + +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (Alternative(..)) +#else +import Control.Applicative +import Data.Monoid +#endif + +import qualified Control.Monad.Catch {-| A 'Proxy' is a monad transformer that receives and sends information on both an upstream and downstream interface. @@ -101,6 +106,7 @@ Respond b fb' -> Respond b (\b' -> go (fb' b')) M m -> M (m >>= \p' -> return (go p')) Pure r -> f r +{-# NOINLINE[1] _bind #-} {-# RULES "_bind (Request a' k) f" forall a' k f . @@ -215,13 +221,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 MonadPlus m => MonadPlus (Proxy a' a b' b m) where - mzero = lift mzero - mplus p0 p1 = go p0 +instance MonadThrow m => MonadThrow (Proxy a' a b' b m) where + throwM = lift . throwM + {-# INLINE throwM #-} + +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 )) @@ -229,7 +234,7 @@ Pure r -> Pure r M m -> M ((do p' <- m - return (go p') ) `mplus` return p1 ) + return (go p') ) `Control.Monad.Catch.catch` (\e -> return (f e)) ) {-| The monad transformer laws are correct when viewed through the 'observe' function: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/src/Pipes/Lift.hs new/pipes-4.3.2/src/Pipes/Lift.hs --- old/pipes-4.1.9/src/Pipes/Lift.hs 2014-01-31 09:13:11.000000000 +0100 +++ new/pipes-4.3.2/src/Pipes/Lift.hs 2016-12-20 19:53:21.000000000 +0100 @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Many actions in base monad transformers cannot be automatically 'Control.Monad.Trans.Class.lift'ed. These functions lift these remaining actions so that they work in the 'Proxy' monad transformer. @@ -10,9 +12,9 @@ -- * Utilities distribute - -- * ErrorT - , errorP - , runErrorP + -- * ExceptT + , exceptP + , runExceptP , catchError , liftCatchError @@ -47,17 +49,21 @@ ) where import Control.Monad.Trans.Class (lift, MonadTrans(..)) -import qualified Control.Monad.Trans.Error as E +import qualified Control.Monad.Trans.Except as E import qualified Control.Monad.Trans.Maybe as M import qualified Control.Monad.Trans.Reader as R import qualified Control.Monad.Trans.State.Strict as S import qualified Control.Monad.Trans.Writer.Strict as W import qualified Control.Monad.Trans.RWS.Strict as RWS -import Data.Monoid (Monoid) import Pipes.Internal (Proxy(..), unsafeHoist) import Control.Monad.Morph (hoist, MFunctor(..)) import Pipes.Core (runEffect, request, respond, (//>), (>\\)) +#if MIN_VERSION_base(4,8,0) +#else +import Data.Monoid +#endif + -- | Distribute 'Proxy' over a monad transformer distribute :: ( Monad m @@ -76,34 +82,34 @@ respond' = lift . lift . respond {-# INLINABLE distribute #-} --- | Wrap the base monad in 'E.ErrorT' -errorP - :: (Monad m, E.Error e) +-- | Wrap the base monad in 'E.ExceptT' +exceptP + :: Monad m => Proxy a' a b' b m (Either e r) - -> Proxy a' a b' b (E.ErrorT e m) r -errorP p = do + -> Proxy a' a b' b (E.ExceptT e m) r +exceptP p = do x <- unsafeHoist lift p - lift $ E.ErrorT (return x) -{-# INLINABLE errorP #-} + lift $ E.ExceptT (return x) +{-# INLINABLE exceptP #-} --- | Run 'E.ErrorT' in the base monad -runErrorP - :: (Monad m, E.Error e) - => Proxy a' a b' b (E.ErrorT e m) r +-- | Run 'E.ExceptT' in the base monad +runExceptP + :: Monad m + => Proxy a' a b' b (E.ExceptT e m) r -> Proxy a' a b' b m (Either e r) -runErrorP = E.runErrorT . distribute -{-# INLINABLE runErrorP #-} +runExceptP = E.runExceptT . distribute +{-# INLINABLE runExceptP #-} -- | Catch an error in the base monad catchError - :: (Monad m, E.Error e) - => Proxy a' a b' b (E.ErrorT e m) r + :: Monad m + => Proxy a' a b' b (E.ExceptT e m) r -- ^ - -> (e -> Proxy a' a b' b (E.ErrorT e m) r) + -> (e -> Proxy a' a b' b (E.ExceptT e m) r) -- ^ - -> Proxy a' a b' b (E.ErrorT e m) r -catchError e h = errorP . E.runErrorT $ - E.catchError (distribute e) (distribute . h) + -> Proxy a' a b' b (E.ExceptT e m) r +catchError e h = exceptP . E.runExceptT $ + E.catchE (distribute e) (distribute . h) {-# INLINABLE catchError #-} -- | Catch an error using a catch function for the base monad @@ -290,12 +296,12 @@ {- $tutorial Probably the most useful functionality in this module is lifted error handling. Suppose that you have a 'Pipes.Pipe' whose base monad can fail - using 'E.ErrorT': + using 'E.ExceptT': > import Control.Monad.Trans.Error > import Pipes > -> example :: Monad m => Pipe Int Int (ErrorT String m) r +> example :: Monad m => Pipe Int Int (ExceptT String m) r > example = for cat $ \n -> > if n == 0 > then lift $ throwError "Zero is forbidden" @@ -305,7 +311,7 @@ until after you compose and run the pipeline: >>> import qualified Pipes.Prelude as P ->>> runErrorT $ runEffect $ P.readLn >-> example >-> P.print +>>> runExceptT $ runEffect $ P.readLn >-> example >-> P.print 42<Enter> 42 1<Enter> @@ -319,7 +325,7 @@ > import qualified Pipes.Lift as Lift > -> caught :: Pipe Int Int (ErrorT String IO) r +> caught :: Pipe Int Int (ExceptT String IO) r > caught = example `Lift.catchError` \str -> do > liftIO (putStrLn str) > caught @@ -327,7 +333,7 @@ This lets you resume streaming in the face of errors raised within the base monad: ->>> runErrorT $ runEffect $ P.readLn >-> caught >-> P.print +>>> runExceptT $ runEffect $ P.readLn >-> caught >-> P.print 0<Enter> Zero is forbidden 42<Enter> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/src/Pipes/Prelude.hs new/pipes-4.3.2/src/Pipes/Prelude.hs --- old/pipes-4.1.9/src/Pipes/Prelude.hs 2016-05-07 19:09:03.000000000 +0200 +++ new/pipes-4.3.2/src/Pipes/Prelude.hs 2016-12-20 19:53:21.000000000 +0100 @@ -105,6 +105,7 @@ import Control.Monad.Trans.State.Strict (get, put) import Data.Functor.Identity (Identity, runIdentity) import Foreign.C.Error (Errno(Errno), ePIPE) +import GHC.Exts (build) import Pipes import Pipes.Core import Pipes.Internal @@ -414,12 +415,13 @@ > take (min m n) = take m >-> take n -} take :: Monad m => Int -> Pipe a a m () -take = loop where - loop 0 = return () - loop n = do - a <- await - yield a - loop (n-1) +take = go + where + go 0 = return () + go n = do + a <- await + yield a + go (n-1) {-# INLINABLE take #-} {-| @(takeWhile p)@ allows values to pass downstream so long as they satisfy @@ -467,12 +469,12 @@ > drop (m + n) = drop m >-> drop n -} drop :: Monad m => Int -> Pipe a a m r -drop = loop +drop = go where - loop 0 = cat - loop n = do - await - loop (n-1) + go 0 = cat + go n = do + await + go (n-1) {-# INLINABLE drop #-} {-| @(dropWhile p)@ discards values going downstream until one violates the @@ -611,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<Enter> ABC<Enter> <Enter> @@ -813,14 +815,15 @@ -- | Convert a pure 'Producer' into a list toList :: Producer a Identity () -> [a] -toList = go +toList prod0 = build (go prod0) where - go p = case p of + go prod cons nil = + case prod of Request v _ -> closed v - Respond a fu -> a:go (fu ()) - M m -> go (runIdentity m) - Pure _ -> [] -{-# INLINABLE toList #-} + Respond a fu -> cons a (go (fu ()) cons nil) + M m -> go (runIdentity m) cons nil + Pure _ -> nil +{-# INLINE toList #-} {-| Convert an effectful 'Producer' into a list diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/src/Pipes/Tutorial.hs new/pipes-4.3.2/src/Pipes/Tutorial.hs --- old/pipes-4.1.9/src/Pipes/Tutorial.hs 2016-04-25 02:07:22.000000000 +0200 +++ new/pipes-4.3.2/src/Pipes/Tutorial.hs 2016-12-20 19:53:21.000000000 +0100 @@ -92,10 +92,7 @@ import Control.Category import Control.Monad -import Control.Monad.Trans.Error -import Control.Monad.Trans.Writer.Strict import Pipes -import Pipes.Lift import qualified Pipes.Prelude as P import Prelude hiding ((.), id) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pipes-4.1.9/src/Pipes.hs new/pipes-4.3.2/src/Pipes.hs --- old/pipes-4.1.9/src/Pipes.hs 2016-05-07 19:09:03.000000000 +0200 +++ new/pipes-4.3.2/src/Pipes.hs 2016-12-20 19:53:21.000000000 +0100 @@ -1,10 +1,9 @@ -{-# LANGUAGE - RankNTypes - , FlexibleInstances - , MultiParamTypeClasses - , UndecidableInstances - , Trustworthy - #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Trustworthy #-} {-| This module is the recommended entry point to the @pipes@ library. @@ -61,29 +60,39 @@ , module Control.Monad.IO.Class , module Control.Monad.Trans.Class , module Control.Monad.Morph - , module Data.Foldable + , Foldable ) where -import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>))) import Control.Monad (void) -import Control.Monad.Error (MonadError(..)) +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)) import Control.Monad.Reader (MonadReader(..)) import Control.Monad.State (MonadState(..)) import Control.Monad.Trans.Class (MonadTrans(lift)) -import Control.Monad.Trans.Error (ErrorT(runErrorT)) +import Control.Monad.Trans.Except (ExceptT, runExceptT) import Control.Monad.Trans.Identity (IdentityT(runIdentityT)) import Control.Monad.Trans.Maybe (MaybeT(runMaybeT)) import Control.Monad.Writer (MonadWriter(..)) -import Data.Foldable (Foldable) -import Data.Monoid (Monoid(..)) +import Control.Monad.Zip (MonadZip(..)) import Pipes.Core import Pipes.Internal (Proxy(..)) import qualified Data.Foldable as F +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (Alternative(..)) +#else +import Control.Applicative +import Data.Foldable (Foldable) +import Data.Traversable (Traversable(..)) +import Data.Monoid +#endif + +import qualified Control.Monad.Catch + -- Re-exports -import Control.Monad.Morph (MFunctor(hoist)) +import Control.Monad.Morph (MFunctor(hoist), MMonad(embed)) infixl 4 <~ infixr 4 ~> @@ -400,20 +409,45 @@ -} 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 + foldMap f = go . enumerate + where + go p = case p of + Request v _ -> closed v + Respond a fu -> f a `mappend` go (fu ()) + M m -> F.foldMap go m + 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 @@ -422,35 +456,56 @@ 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 (Select p0) = Select (loop p0) + where + loop (Request a' fa ) = Request a' (\a -> loop (fa a )) + loop (Respond b fb') = Respond b (\b' -> loop (fb' b')) + loop (M m ) = for (enumerate (fmap loop (f m))) id + loop (Pure r ) = Pure r + {-# 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 @@ -475,15 +530,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 (Control.Monad.Catch.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 () @@ -520,9 +603,9 @@ Nothing -> return () Just a -> yield a -instance Enumerable (ErrorT e) where +instance Enumerable (ExceptT e) where toListT m = Select $ do - x <- lift $ runErrorT m + x <- lift $ runExceptT m case x of Left _ -> return () Right a -> yield a
