drinkery-0.2.1: benchmarks/benchmark.hs

{-# 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 #-}