{-# OPTIONS -ddump-simpl -dsuppress-all #-} import Control.Arrow import Control.Monad import Data.Functor.Identity import Data.List import Data.Void import Gauge.Main import qualified Data.Drinkery as D import qualified Data.Drinkery.Still as D import qualified ListT as L import qualified Pipes as P import qualified Pipes.Prelude as P import qualified Data.Conduit as C import qualified Data.Conduit.Combinators as CC import qualified Data.Machine as M drainD :: Monad m => D.Drinker (D.Tap () (Maybe a)) m () drainD = D.drainFrom D.drink sourceAlt :: Monad m => ([Int] -> m Int) -> m Int sourceAlt k = do a <- k [1..50] b <- k [1..a] c <- k [1..b] return $! a + b + c {-# INLINE sourceAlt #-} sourceSeq :: Monad m => (Int -> m ()) -> m () sourceSeq k = forM_ [1..50] $ \a -> forM_ [1..a] $ \b -> forM_ [1..b] $ \c -> k $! a + b + c {-# INLINE sourceSeq #-} sourceD :: Monad m => D.Cask () Int m sourceD = D.runSommelier (sourceAlt D.taste) {-# INLINE sourceD #-} sourceP :: Monad m => P.Producer Int m () sourceP = sourceSeq P.yield {-# INLINE sourceP #-} sourceC :: Monad m => C.ConduitT i Int m () sourceC = sourceSeq C.yield {-# INLINE sourceC #-} sourceM :: M.Source Int sourceM = M.construct $ sourceSeq M.yield {-# INLINE sourceM #-} main = defaultMain [ bgroup "map-filter" [ bench "drinkery/$&" $ whnfIO $ apply (\h -> sourceD D.++$ h D.+& drainD) (mapFilter D.++$ mapFilter D.++$ mapFilter D.++$ mapFilter) ] ] mapFilter :: Monad m => D.Pipe Int Int m mapFilter = D.map' (+1) D.++$ D.filter (>0) apply :: (a -> b) -> a -> b apply f x = f x {-# NOINLINE apply #-}