Benchmarks.hs

module Main (main) where

import Control.Applicative
import Data.Function ((&))
import Control.Monad (void)
import Control.Monad.Identity
import Criterion.Main
import Data.Void
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 Prelude

value :: Int
value = 1000000

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

drainMIO :: M.ProcessT IO Int o -> IO ()
drainMIO m = M.runT_ (sourceM M.~> m)

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

drainPIO :: P.Proxy () Int () a IO () -> IO ()
drainPIO p = P.runEffect $ sourceP P.>-> p P.>-> P.mapM_ (\_ -> return ())

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

drainCIO :: C.ConduitT Int a IO () -> IO ()
drainCIO c = C.runConduit $ (sourceC C..| c) C..| C.mapM_ (\_ -> return ())

drainSC :: C.ConduitT Int Void Identity b -> ()
drainSC c = runIdentity $ void $! C.runConduit $ sourceC C..| c

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

drainSIO :: (S.Stream (S.Of Int) IO () -> S.Stream (S.Of Int) IO ()) -> IO ()
drainSIO s = sourceS & s & S.mapM_ (\_ -> return ())

sourceM :: M.Source Int
sourceM = M.enumerateFromTo 1 value

sourceC :: Monad m => C.ConduitT i Int m ()
sourceC = C.enumFromTo 1 value

sourceP :: Monad m => P.Producer' Int m ()
sourceP = P.each [1..value]

sourceS :: Monad m => S.Stream (S.Of Int) m ()
sourceS = S.each [1..value]

main :: IO ()
main =
  defaultMain
  [ bgroup "map"
      [ bench "machines" $ whnf drainM (M.mapping (+1))
      , bench "streaming" $ whnf drainS (S.map (+1))
      , bench "pipes" $ whnf drainP (P.map (+1))
      , bench "conduit" $ whnf drainC (C.map (+1))
      ]
  , bgroup "drop"
      [ bench "machines" $ whnf drainM (M.dropping value)
      , bench "streaming" $ whnf drainS (S.drop value)
      , bench "pipes" $ whnf drainP (P.drop value)
      , bench "conduit" $ whnf drainC (C.drop value)
      ]
  , bgroup "dropWhile"
      [ bench "machines" $ whnf drainM (M.droppingWhile (<= value))
      , bench "streaming" $ whnf drainS (S.dropWhile (<= value))
      , bench "pipes" $ whnf drainP (P.dropWhile (<= value))
      , bench "conduit" $ whnf drainC (CC.dropWhile (<= value))
      ]
  , bgroup "scan"
      [ bench "machines" $ whnf drainM (M.scan (+) 0)
      , bench "streaming" $ whnf drainS (S.scan (+) 0 id)
      , bench "pipes" $ whnf drainP (P.scan (+) 0 id)
      , bench "conduit" $ whnf drainC (CC.scanl (+) 0)
      ]
  , bgroup "take"
      [ bench "machines" $ whnf drainM (M.taking value)
      , bench "streaming" $ whnf drainS (S.take value)
      , bench "pipes" $ whnf drainP (P.take value)
      , bench "conduit" $ whnf drainC (C.isolate value)
      ]
  , bgroup "takeWhile"
      [ bench "machines" $ whnf drainM (M.takingWhile (<= value))
      , bench "streaming" $ whnf drainS (S.takeWhile (<= value))
      , bench "pipes" $ whnf drainP (P.takeWhile (<= value))
      , bench "conduit" $ whnf drainC (CC.takeWhile (<= value))
      ]
  , bgroup "fold"
      [ bench "machines" $ whnf drainM (M.fold (+) 0)
      , bench "streaming" $ whnf runIdentity $ (S.fold (+) 0 id) sourceS
      , bench "pipes" $ whnf runIdentity $ (P.fold (+) 0 id) sourceP
      , bench "conduit" $ whnf drainSC (C.fold (+) 0)
      ]
  , bgroup "filter"
      [ bench "machines" $ whnf drainM (M.filtered even)
      , bench "streaming" $ whnf drainS (S.filter even)
      , bench "pipes" $ whnf drainP (P.filter even)
      , bench "conduit" $ whnf drainC (C.filter even)
      ]
  , bgroup "mapM"
      [ bench "machines" $ whnf drainM (M.autoM Identity)
      , bench "streaming" $ whnf drainS (S.mapM Identity)
      , bench "pipes" $ whnf drainP (P.mapM Identity)
      , bench "conduit" $ whnf drainC (C.mapM Identity)
      ]
  , bgroup "zip"
      [ bench "machines" $ whnf (\x -> runIdentity $ M.runT_ x)
          (M.capT sourceM sourceM M.zipping)
      , bench "streaming" $ whnf (\x -> runIdentity $ S.effects $ x)
          (S.zip sourceS sourceS)
      , bench "pipes" $ whnf (\x -> runIdentity $ P.runEffect $ P.for x P.discard)
          (P.zip sourceP sourceP)
      , bench "conduit" $ whnf (\x -> runIdentity $ C.runConduit $ x C..| C.sinkNull)
          (C.getZipSource $ (,) <$> C.ZipSource sourceC <*> C.ZipSource sourceC)
      ]
  , bgroup "concat"
      [ bench "machines" $ whnf drainM (M.mapping (replicate 10) M.~> M.asParts)
      , bench "streaming" $ whnf drainS (S.concat . S.map (replicate 10))
      , bench "pipes" $ whnf drainP (P.map (replicate 10) P.>-> P.concat)
      , bench "conduit" $ whnf drainC (C.map (replicate 10) C..| C.concat)
      ]
  , bgroup "last"
      [ bench "machines" $ whnf drainM (M.final)
      , bench "streaming" $ whnf runIdentity $ S.last sourceS
      , bench "pipes" $ whnf runIdentity $ P.last sourceP
      ]
  , bgroup "buffered"
      [ bench "machines" $ whnf drainM (M.buffered 1000)
      ]
  , bgroup "toList"
      [ bench "machines"  $ whnf (length . runIdentity) $ M.runT sourceM
      , bench "streaming" $ whnf (length . runIdentity)
                          $ S.toList sourceS >>= (\(xs S.:> _) -> return xs)
      , bench "pipes"     $ whnf (length . runIdentity) $ P.toListM sourceP
      , bench "conduit"   $ whnf (length . runIdentity)
                          $ C.runConduit $ sourceC C..| CC.sinkList
      ]
  , bgroup "toListIO"
      [ bench "machines"  $ whnfIO $ M.runT sourceM
      , bench "streaming" $ whnfIO $ S.toList sourceS
      , bench "pipes"     $ whnfIO $ P.toListM sourceP
      , bench "conduit"   $ whnfIO $ C.runConduit $ sourceC C..| CC.sinkList
      ]

  , bgroup "compose"
      [
      -- Compose multiple ops, all stages letting everything through
        let m = M.filtered (<= value)
            s = S.filter (<= value)
            p = P.filter (<= value)
            c = C.filter (<= value)
        in bgroup "summary"
          [ bench "machines"  $ whnf drainM $ m M.~> m M.~> m M.~> m
          , bench "streaming" $ whnf drainS $ \x -> s x & s & s & s
          , bench "pipes"     $ whnf drainP $ p P.>-> p P.>-> p P.>-> p
          , bench "conduit"   $ whnf drainC $ c C..| c C..| c C..| c
          ]

      -- IO monad makes a big difference especially for machines
      , let m = M.filtered (<= value)
            s = S.filter (<= value)
            p = P.filter (<= value)
            c = C.filter (<= value)
        in bgroup "summary-io"
          [ bench "machines"  $ whnfIO $ drainMIO $ m M.~> m M.~> m M.~> m
          , bench "streaming" $ whnfIO $ drainSIO $ \x -> s x & s & s & s
          , bench "pipes"     $ whnfIO $ drainPIO $ p P.>-> p P.>-> p P.>-> p
          , bench "conduit"   $ whnfIO $ drainCIO $ c C..| c C..| c C..| c
          ]

      -- Scaling with same operation in sequence
      , let f = M.filtered (<= value)
        in bgroup "machines"
          [ bench "1-filter" $ whnf drainM f
          , bench "2-filters" $ whnf drainM $ f M.~> f
          , bench "3-filters" $ whnf drainM $ f M.~> f M.~> f
          , bench "4-filters" $ whnf drainM $ f M.~> f M.~> f M.~> f
          ]
      , let f = S.filter (<= value)
        in bgroup "streaming"
          [ bench "1-filter" $ whnf drainS (\x -> f x)
          , bench "2-filters" $ whnf drainS $ \x -> f x & f
          , bench "3-filters" $ whnf drainS $ \x -> f x & f & f
          , bench "4-filters" $ whnf drainS $ \x -> f x & f & f & f
          ]
      , let f = P.filter (<= value)
        in bgroup "pipes"
          [ bench "1-filter" $ whnf drainP f
          , bench "2-filters" $ whnf drainP $ f P.>-> f
          , bench "3-filters" $ whnf drainP $ f P.>-> f P.>-> f
          , bench "4-filters" $ whnf drainP $ f P.>-> f P.>-> f P.>-> f
          ]
      , let f = C.filter (<= value)
        in bgroup "conduit"
          [ bench "1-filter" $ whnf drainC f
          , bench "2-filters" $ whnf drainC $ f C..| f
          , bench "3-filters" $ whnf drainC $ f C..| f C..| f
          , bench "4-filters" $ whnf drainC $ f C..| f C..| f C..| f
          ]

      , let m = M.mapping (subtract 1) M.~> M.filtered (<= value)
            s = S.filter (<= value) . S.map (subtract 1)
            p = P.map (subtract 1)  P.>-> P.filter (<= value)
            c = C.map (subtract 1)  C..| C.filter (<= value)
        in bgroup "summary-alternate"
          [ bench "machines"  $ whnf drainM $ m M.~> m M.~> m M.~> m
          , bench "streaming" $ whnf drainS $ \x -> s x & s & s & s
          , bench "pipes"     $ whnf drainP $ p P.>-> p P.>-> p P.>-> p
          , bench "conduit"   $ whnf drainC $ c C..| c C..| c C..| c
          ]

      , let f = M.mapping (subtract 1) M.~> M.filtered (<= value)
        in bgroup "machines-alternate"
          [ bench "1-map-filter" $ whnf drainM f
          , bench "2-map-filters" $ whnf drainM $ f M.~> f
          , bench "3-map-filters" $ whnf drainM $ f M.~> f M.~> f
          , bench "4-map-filters" $ whnf drainM $ f M.~> f M.~> f M.~> f
          ]
      , let f = S.filter (<= value) . S.map (subtract 1)
        in bgroup "streaming-alternate"
          [ bench "1-map-filter" $ whnf drainS (\x -> f x)
          , bench "2-map-filters" $ whnf drainS $ \x -> f x & f
          , bench "3-map-filters" $ whnf drainS $ \x -> f x & f & f
          , bench "4-map-filters" $ whnf drainS $ \x -> f x & f & f & f
          ]
      , let f = P.map (subtract 1)  P.>-> P.filter (<= value)
        in bgroup "pipes-alternate"
          [ bench "1-map-filter" $ whnf drainP f
          , bench "2-map-filters" $ whnf drainP $ f P.>-> f
          , bench "3-map-filters" $ whnf drainP $ f P.>-> f P.>-> f
          , bench "4-map-filters" $ whnf drainP $ f P.>-> f P.>-> f P.>-> f
          ]
      , let f = C.map (subtract 1)  C..| C.filter (<= value)
        in bgroup "conduit-alternate"
          [ bench "1-map-filter" $ whnf drainC f
          , bench "2-map-filters" $ whnf drainC $ f C..| f
          , bench "3-map-filters" $ whnf drainC $ f C..| f C..| f
          , bench "4-map-filters" $ whnf drainC $ f C..| f C..| f C..| f
          ]

        -- how filtering affects the subsequent composition
      , let m = M.filtered (> value)
            s = S.filter   (> value)
            p = P.filter   (> value)
            c = C.filter   (> value)
        in bgroup "summary-filter-effect"
          [ bench "machines"  $ whnf drainM $ m M.~> m M.~> m M.~> m
          , bench "streaming" $ whnf drainS $ \x -> s x & s & s & s
          , bench "pipes"     $ whnf drainP $ p P.>-> p P.>-> p P.>-> p
          , bench "conduit"   $ whnf drainC $ c C..| c C..| c C..| c
          ]

      , let m = M.filtered (> value)
            s = S.filter   (> value)
            p = P.filter   (> value)
            c = C.filter   (> value)
        in bgroup "summary-filter-effect-io"
          [ bench "machines"  $ whnfIO $ drainMIO $ m M.~> m M.~> m M.~> m
          , bench "streaming" $ whnfIO $ drainSIO $ \x -> s x & s & s & s
          , bench "pipes"     $ whnfIO $ drainPIO $ p P.>-> p P.>-> p P.>-> p
          , bench "conduit"   $ whnfIO $ drainCIO $ c C..| c C..| c C..| c
          ]

      , let f = M.filtered (> value)
        in bgroup "machines-filter-effect"
          [ bench "filter1" $ whnf drainM f
          , bench "filter2" $ whnf drainM $ f M.~> f
          , bench "filter3" $ whnf drainM $ f M.~> f M.~> f
          , bench "filter4" $ whnf drainM $ f M.~> f M.~> f M.~> f
          ]
      , let f = S.filter (> value)
        in bgroup "streaming-filter-effect"
          [ bench "filter1" $ whnf drainS (\x -> f x)
          , bench "filter2" $ whnf drainS $ \x -> f x & f
          , bench "filter3" $ whnf drainS $ \x -> f x & f & f
          , bench "filter4" $ whnf drainS $ \x -> f x & f & f & f
          ]
      , let f = P.filter (> value)
        in bgroup "pipes-filter-effect"
          [ bench "filter1" $ whnf drainP f
          , bench "filter2" $ whnf drainP $ f P.>-> f
          , bench "filter3" $ whnf drainP $ f P.>-> f P.>-> f
          , bench "filter4" $ whnf drainP $ f P.>-> f P.>-> f P.>-> f
          ]
      , let f = C.filter (> value)
        in bgroup "conduit-filter-effect"
          [ bench "filter1" $ whnf drainC f
          , bench "filter2" $ whnf drainC $ f C..| f
          , bench "filter3" $ whnf drainC $ f C..| f C..| f
          , bench "filter4" $ whnf drainC $ f C..| f C..| f C..| f
          ]
      ]
  ]