benchmark prelude compositions following the pattern of john weigley's https://github.com/jwiegley/streaming-tests

benchcompose.hs

{-#LANGUAGE BangPatterns #-}
module Main (main) where

import           Data.Conduit as C
import qualified Data.Conduit.Combinators as C

import           Pipes as P
import qualified Pipes.Prelude as P
  
import qualified Streaming.Prelude as Str

import qualified System.IO.Streams as IOS

import qualified Data.Vector.Fusion.Stream.Monadic as V

import qualified Data.Machine as M
import           Data.Machine.Runner  (foldlT)
import qualified Data.List as List

import           Control.Exception
import           Criterion.Main
--
import           Data.Function ((&))


import           Test.Hspec
import           Test.Hspec.Expectations
big :: Int
big = 24012000

main :: IO ()
main = do
    defaultMain 
      [ bgroup "sum"     [ bench "streaming"      $ nfIO streaming_sum
                         , bench "conduit"        $ nfIO conduit_sum
                         , bench "vector"         $ nfIO vector_sum
                         , bench "pipes"          $ nfIO pipes_sum
                         , bench "iostreams"      $ nfIO iostreams_sum
                         , bench "machine"        $ nfIO machines_sum
                         ]
      , bgroup "toList"  [ bench "streaming"      $ nfIO streaming_basic
                         , bench "conduit"        $ nfIO conduit_basic
                         , bench "vector"         $ nfIO vector_basic
                         , bench "pipes"          $ nfIO pipes_basic
                         , bench "iostreams"      $ nfIO iostreams_basic
                         , bench "machine"        $ nfIO machines_basic
                         ]
      ]

pipes_basic :: IO Int
pipes_basic = do
    xs <- P.toListM $ P.each [1..10000]
      >-> P.filter even
      >-> P.map (+1)
      >-> P.drop 1000
      >-> P.map (+1)
      >-> P.filter (\x -> x `mod` 2 == 0)
    assert (Prelude.length xs == 4000) $
        return (Prelude.length xs)

pipes_sum :: IO Int
pipes_sum = do
    n <- P.fold (+) 0 id $ P.each [1..10000]
      >-> P.filter even
      >-> P.map (+1)
      >-> P.drop 1000
      >-> P.map (+1)
      >-> P.filter (\x -> x `mod` 2 == 0)
    assert (n == big) $ return n

-- conduit_basic :: IO Int
conduit_basic = do
    xs <- C.yieldMany [1..10000]
      $= C.filter even
      $= C.map ((+1) :: Int -> Int)
      $= (C.drop 1000 >> C.awaitForever C.yield)
      $= C.map ((+1) :: Int -> Int)
      $= C.filter (\x -> x `mod` 2 == 0)
      $$ C.sinkList
    assert (Prelude.length xs == 4000) $
        return (Prelude.length (xs :: [Int]))

conduit_sum :: IO Int
conduit_sum = do
  n <- C.yieldMany [1..10000]
      $= C.filter even
      $= C.map ((+1) :: Int -> Int)
      $= (C.drop 1000 >> C.awaitForever C.yield)
      $= C.map ((+1) :: Int -> Int)
      $= C.filter (\x -> x `mod` 2 == 0)
      $$ C.foldl (+) 0
  assert (n == big) $  return n

streaming_basic :: IO Int
streaming_basic = do
    xs <- Str.toList_ $ 
      Str.each [1..10000]
      & Str.filter even
      & Str.map (+1)
      & Str.drop 1000
      & Str.map (+1)
      & Str.filter (\x -> x `mod` 2 == 0)
    assert (Prelude.length xs == 4000) $
        return (Prelude.length (xs :: [Int]))


streaming_sum :: IO Int
streaming_sum = do
    n <- Str.sum_ $ 
      Str.each [1..10000]
      & Str.filter even
      & Str.map (+1)
      & Str.drop 1000
      & Str.map (+1)
      & Str.filter (\x -> x `mod` 2 == 0)
    assert (n == big) $
        return n


iostreams_sum :: IO Int
iostreams_sum = do
  s0 <- IOS.fromList [1..10000]
  s1 <- IOS.filter even s0
  s2 <- IOS.map (+1) s1
  s3 <- IOS.drop 1000 s2
  s4 <- IOS.map (+1) s3
  s5 <- IOS.filter (\x -> x `mod` 2 == 0) s4
  n <- IOS.fold (+) 0 s5
  assert (n == big) $
      return n

iostreams_basic :: IO Int
iostreams_basic = do
  s0 <- IOS.fromList [1..10000]
  s1 <- IOS.filter even s0
  s2 <- IOS.map (+1) s1
  s3 <- IOS.drop 1000 s2
  s4 <- IOS.map (+1) s3
  s5 <- IOS.filter (\x -> x `mod` 2 == 0) s4
  xs <- IOS.toList s5
  assert (Prelude.length xs == 4000) $
      return (Prelude.length (xs :: [Int]))


machines_basic :: IO Int
machines_basic =  do 
  xs <- M.runT $ 
          M.source [1..10000 :: Int]
          M.~> M.filtered even 
          M.~> M.mapping (+1) 
          M.~> M.dropping 1000 
          M.~> M.mapping (+1)
          M.~> M.filtered (\x -> x `mod` 2 == 0)
  assert (Prelude.length xs == 4000) $
      return (Prelude.length xs)

machines_sum :: IO Int
machines_sum =  do 
  n <- foldlT (+) (0::Int) $ 
          M.source [1..10000 :: Int]
          M.~> M.filtered even 
          M.~> M.mapping (+1) 
          M.~> M.dropping 1000 
          M.~> M.mapping (+1)
          M.~> M.filtered (\x -> x `mod` 2 == 0)
  assert (n == big) $
      return n

vector_basic :: IO Int
vector_basic = do
    xs <- V.toList 
          $ V.filter even
          $ V.map (+1)
          $ V.drop 1000
          $ V.map (+1)
          $ V.filter (\x -> x `mod` 2 == 0) 
          $ V.enumFromTo 1 10000
    assert (Prelude.length xs == 4000) $
        return (Prelude.length (xs :: [Int]))

vector_sum :: IO Int
vector_sum = do
    n <-  V.foldl (+) 0 
        $ V.filter even
        $ V.map (+1)
        $ V.drop 1000
        $ V.map (+1)
        $ V.filter (\x -> x `mod` 2 == 0) 
        $ V.enumFromTo 1 10000
    assert (n == big) $
        return n   

compose.md

  benchmarking sum/streaming
  time                 37.82 μs   (37.60 μs .. 38.06 μs)
                       0.999 R²   (0.999 R² .. 1.000 R²)
  mean                 37.94 μs   (37.61 μs .. 38.31 μs)
  std dev              1.211 μs   (980.5 ns .. 1.685 μs)
  variance introduced by outliers: 34% (moderately inflated)

  benchmarking sum/conduit
  time                 111.9 μs   (109.4 μs .. 115.3 μs)
                       0.994 R²   (0.990 R² .. 0.998 R²)
  mean                 112.0 μs   (110.0 μs .. 115.2 μs)
  std dev              8.565 μs   (5.134 μs .. 12.87 μs)
  variance introduced by outliers: 72% (severely inflated)

  benchmarking sum/vector
  time                 239.9 μs   (238.1 μs .. 241.5 μs)
                       0.999 R²   (0.999 R² .. 1.000 R²)
  mean                 239.1 μs   (237.2 μs .. 241.4 μs)
  std dev              6.891 μs   (4.763 μs .. 11.87 μs)
  variance introduced by outliers: 23% (moderately inflated)

  benchmarking sum/pipes
  time                 457.6 μs   (455.0 μs .. 460.3 μs)
                       1.000 R²   (0.999 R² .. 1.000 R²)
  mean                 456.5 μs   (454.5 μs .. 459.1 μs)
  std dev              7.349 μs   (5.272 μs .. 10.26 μs)

  benchmarking sum/iostreams
  time                 570.7 μs   (566.0 μs .. 576.1 μs)
                       0.999 R²   (0.998 R² .. 1.000 R²)
  mean                 566.3 μs   (563.1 μs .. 572.5 μs)
  std dev              14.68 μs   (8.541 μs .. 25.83 μs)
  variance introduced by outliers: 17% (moderately inflated)

  benchmarking sum/machine
  time                 2.360 ms   (2.342 ms .. 2.399 ms)
                       0.997 R²   (0.990 R² .. 1.000 R²)
  mean                 2.417 ms   (2.398 ms .. 2.464 ms)
  std dev              95.28 μs   (58.46 μs .. 163.0 μs)
  variance introduced by outliers: 25% (moderately inflated)

  benchmarking toList/streaming
  time                 92.10 μs   (90.75 μs .. 94.10 μs)
                       0.997 R²   (0.994 R² .. 1.000 R²)
  mean                 91.62 μs   (90.83 μs .. 93.15 μs)
  std dev              3.510 μs   (1.814 μs .. 6.073 μs)
  variance introduced by outliers: 39% (moderately inflated)

  benchmarking toList/conduit
  time                 275.6 μs   (271.2 μs .. 281.5 μs)
                       0.998 R²   (0.995 R² .. 1.000 R²)
  mean                 271.5 μs   (269.3 μs .. 275.2 μs)
  std dev              9.518 μs   (5.900 μs .. 14.58 μs)
  variance introduced by outliers: 31% (moderately inflated)

  benchmarking toList/vector
  time                 328.0 μs   (326.9 μs .. 329.1 μs)
                       1.000 R²   (1.000 R² .. 1.000 R²)
  mean                 328.6 μs   (327.7 μs .. 329.8 μs)
  std dev              3.646 μs   (2.838 μs .. 4.934 μs)

  benchmarking toList/pipes
  time                 1.097 ms   (1.092 ms .. 1.103 ms)
                       1.000 R²   (0.999 R² .. 1.000 R²)
  mean                 1.101 ms   (1.096 ms .. 1.110 ms)
  std dev              23.72 μs   (16.26 μs .. 37.73 μs)
  variance introduced by outliers: 11% (moderately inflated)

  benchmarking toList/iostreams
  time                 1.987 ms   (1.977 ms .. 1.995 ms)
                       1.000 R²   (1.000 R² .. 1.000 R²)
  mean                 1.986 ms   (1.979 ms .. 1.994 ms)
  std dev              25.58 μs   (18.83 μs .. 34.73 μs)

  benchmarking toList/machine
  time                 2.809 ms   (2.778 ms .. 2.844 ms)
                       1.000 R²   (0.999 R² .. 1.000 R²)
  mean                 2.792 ms   (2.785 ms .. 2.803 ms)
  std dev              28.73 μs   (20.68 μs .. 39.23 μs)