michaelt · November 2, 2015 23:13 · michaelt · Nov 2, 2015
diff --git a/machinesbench.hs b/machinesbench.hs
 {-#LANGUAGE NoMonomorphismRestriction #-}
 module Main (main) where

 import Control.Monad (void)
 import Control.Monad.Identity
 import Criterion.Main
 import qualified Data.Conduit      as C
 import qualified Data.Conduit.Combinators as CC
 import qualified Data.Conduit.List as C
 import qualified Data.Machine      as M
 import qualified Pipes             as P
 import qualified Pipes.Prelude     as P
 import qualified Streaming.Prelude as S
 import Streaming (Of (..), Stream)

 value :: Int
 value = 1000000

 drainS :: (Stream (Of Int) Identity () -> Stream (Of o) Identity ()) -> ()
 drainS p = runIdentity $ S.effects $ p sourceS 

 drainM :: M.ProcessT Identity Int o -> ()
 drainM m = runIdentity $ M.runT_ (sourceM M.~> m)

 drainP :: P.Proxy () Int () a Identity () -> ()
 drainP p = runIdentity $ P.runEffect $ P.for (sourceP P.>-> p) P.discard

 drainC :: C.Conduit Int Identity a -> ()
 drainC c = runIdentity $ (sourceC C.$= c) C.$$ C.sinkNull

 drainSC :: C.Sink Int Identity b -> b
 drainSC c = runIdentity $ sourceC C.$$ c

 sourceM = M.enumerateFromTo 1 value
 sourceC = C.enumFromTo 1 value
 sourceP = P.each [1..value]
 sourceS = S.take value $ S.enumFrom 1
 main :: IO ()
 main =
  defaultMain
  [ bgroup "map"
      [ bench "streaming" $ whnf drainS (S.map (+1))
      , bench "conduit" $ whnf drainC (C.map (+1))
      , bench "pipes" $ whnf drainP (P.map (+1))
      , bench "machines" $ whnf drainM (M.auto (+1))
      ]
  , bgroup "drop"
      [ bench "streaming" $ whnf drainS (S.drop value)
      , bench "conduit" $ whnf drainC (C.drop value)
      , bench "pipes" $ whnf drainP (P.drop value)
      , bench "machines" $ whnf drainM (M.dropping value)

      ]
  , bgroup "dropWhile"
      [ bench "streaming" $ whnf drainS (S.dropWhile (<= value))
      , bench "conduit" $ whnf drainC (CC.dropWhile (<= value))
      , bench "pipes" $ whnf drainP (P.dropWhile (<= value))
      , bench "machines" $ whnf drainM (M.droppingWhile (<= value))
      ]
  , bgroup "scan"
      [ bench "streaming" $ whnf drainS (S.scan (+) 0 id)
      , bench "conduit" $ whnf drainC (CC.scanl (+) 0)
      , bench "pipes" $ whnf drainP (P.scan (+) 0 id)
      , bench "machines" $ whnf drainM (M.scan (+) 0)
      ]
  , bgroup "take"
      [ bench "streaming" $ whnf drainS (S.take value)
      , bench "conduit" $ whnf drainC (C.isolate value)
      , bench "pipes" $ whnf drainP (P.take value)
      , bench "machines" $ whnf drainM (M.taking value)
      ]
  , bgroup "takeWhile"
      [ bench "streaming" $ whnf drainS (S.takeWhile (<= value)) 
      , bench "conduit" $ whnf drainC (CC.takeWhile (<= value) C.=$= C.sinkNull)
      , bench "pipes" $ whnf drainP (P.takeWhile (<= value))
      , bench "machines" $ whnf drainM (M.takingWhile (<= value))
      ]

  ]
	{-#LANGUAGE NoMonomorphismRestriction #-}
	module Main (main) where

	import Control.Monad (void)
	import Control.Monad.Identity
	import Criterion.Main
	import qualified Data.Conduit as C
	import qualified Data.Conduit.Combinators as CC
	import qualified Data.Conduit.List as C
	import qualified Data.Machine as M
	import qualified Pipes as P
	import qualified Pipes.Prelude as P
	import qualified Streaming.Prelude as S
	import Streaming (Of (..), Stream)

	value :: Int
	value = 1000000

	drainS :: (Stream (Of Int) Identity () -> Stream (Of o) Identity ()) -> ()
	drainS p = runIdentity $ S.effects $ p sourceS

	drainM :: M.ProcessT Identity Int o -> ()
	drainM m = runIdentity $ M.runT_ (sourceM M.~> m)

	drainP :: P.Proxy () Int () a Identity () -> ()
	drainP p = runIdentity $ P.runEffect $ P.for (sourceP P.>-> p) P.discard

	drainC :: C.Conduit Int Identity a -> ()
	drainC c = runIdentity $ (sourceC C.$= c) C.$$ C.sinkNull

	drainSC :: C.Sink Int Identity b -> b
	drainSC c = runIdentity $ sourceC C.$$ c

	sourceM = M.enumerateFromTo 1 value
	sourceC = C.enumFromTo 1 value
	sourceP = P.each [1..value]
	sourceS = S.take value $ S.enumFrom 1
	main :: IO ()
	main =
	defaultMain
	[ bgroup "map"
	[ bench "streaming" $ whnf drainS (S.map (+1))
	, bench "conduit" $ whnf drainC (C.map (+1))
	, bench "pipes" $ whnf drainP (P.map (+1))
	, bench "machines" $ whnf drainM (M.auto (+1))
	]
	, bgroup "drop"
	[ bench "streaming" $ whnf drainS (S.drop value)
	, bench "conduit" $ whnf drainC (C.drop value)
	, bench "pipes" $ whnf drainP (P.drop value)
	, bench "machines" $ whnf drainM (M.dropping value)

	]
	, bgroup "dropWhile"
	[ bench "streaming" $ whnf drainS (S.dropWhile (<= value))
	, bench "conduit" $ whnf drainC (CC.dropWhile (<= value))
	, bench "pipes" $ whnf drainP (P.dropWhile (<= value))
	, bench "machines" $ whnf drainM (M.droppingWhile (<= value))
	]
	, bgroup "scan"
	[ bench "streaming" $ whnf drainS (S.scan (+) 0 id)
	, bench "conduit" $ whnf drainC (CC.scanl (+) 0)
	, bench "pipes" $ whnf drainP (P.scan (+) 0 id)
	, bench "machines" $ whnf drainM (M.scan (+) 0)
	]
	, bgroup "take"
	[ bench "streaming" $ whnf drainS (S.take value)
	, bench "conduit" $ whnf drainC (C.isolate value)
	, bench "pipes" $ whnf drainP (P.take value)
	, bench "machines" $ whnf drainM (M.taking value)
	]
	, bgroup "takeWhile"
	[ bench "streaming" $ whnf drainS (S.takeWhile (<= value))
	, bench "conduit" $ whnf drainC (CC.takeWhile (<= value) C.=$= C.sinkNull)
	, bench "pipes" $ whnf drainP (P.takeWhile (<= value))
	, bench "machines" $ whnf drainM (M.takingWhile (<= value))
	]

	]