simple-conduit-0.5.1: test/bench.hs

{-# LANGUAGE Arrows #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import qualified Conduit as C
import           Conduit.Simple
import           Conduit.Simple.Compat
import           Control.Arrow
import           Control.Monad
import           Control.Monad.IO.Class
import           Criterion.Main (defaultMain, bench, nf)
import           Data.Functor.Identity
import           Data.Monoid
import qualified Data.Vector as V
import qualified Data.Text as T
import           Data.Text.Encoding
import System.IO.Unsafe (unsafePerformIO)

main :: IO ()
main = do
    xs <- yieldMany [1..10] $= mapC (+2) $$ sinkList
    print (xs :: [Int])

    ys <- yieldMany [1..10] $$ mapC (+2) =$ sinkList
    print (ys :: [Int])

    zs <- yieldMany [1..10] $= dropC 5 $= mapC (+2) $$ sinkList
    print (zs :: [Int])

    ws <- yieldMany [1..10] $= takeC 5 $= mapC (+2) $$ sinkList
    print (ws :: [Int])

    us <- (sourceFile "simple-conduit.cabal" <> sourceFile "README.md")
        $= takeC 1
        $$ sinkList
    print (T.unpack (decodeUtf8 (Prelude.head us)))

    vs <- sinkList
        $ (proc x -> do y <- mapC (+1) -< x
                        g <- takeC 1 -< y
                        returnA -< g)
        $ yieldMany ([1..10] :: [Int])
    print (vs :: [Int])

    x <- sinkList $ returnC $ sumC $ mapC (+1) $ yieldMany ([1..10] :: [Int])
    print x

    yieldMany ([1..10] :: [Int]) $$ mapM_C (liftIO . print)

    defaultMain
        [ -- bench "centipede1" $ nf (runIdentity . useThis) ([1..1000000] :: [Int])
        -- , bench "conduit1"   $ nf (runIdentity . useThat) ([1..1000000] :: [Int])
        -- , bench "centipede2" $ nf (runIdentity . useThis) ([1..1000000] :: [Int])
        -- , bench "centipede3" $ nf (runIdentity . useThis2) ([1..1000000] :: [Int])
        -- , bench "conduit2"   $ nf (runIdentity . useThat) ([1..1000000] :: [Int])
        -- ,
          bench "rechunk1"   $ nf (unsafePerformIO . rechunk1)
                                  (replicate 10 [1..10000])
        , bench "rechunk1IO" $ nf (unsafePerformIO . rechunk1IO)
                                  (replicate 10 [1..10000])
        , bench "C.rechunk1" $ nf (unsafePerformIO . conduitRechunk1)
                                  (replicate 10 [1..10000])
        , bench "C.rechunk3" $ nf (unsafePerformIO . conduitRechunk3)
                                  (replicate 10 [1..10000])
        ]
  where
    useThis xs = yieldMany xs $= mapC (+2) $$ sinkList
    useThis2 xs = yieldMany2 xs $= mapC (+2) $$ sinkList2
    useThat xs = C.yieldMany xs C.$= C.mapC (+2) C.$$ C.sinkList

rechunk1 :: [[Int]] -> IO [V.Vector Int]
rechunk1 xs = sourceList xs
         $= concatC
        =$= concatMapC (\x -> [x, x])
        =$= conduitVector 512
         $$ sinkList

rechunk1IO :: [[Int]] -> IO [V.Vector Int]
rechunk1IO xs = sourceList xs
         $= concatC
        =$= concatMapC (\x -> [x, x])
        =$= conduitVector 512
         $$ sinkList

-- rechunk2 =
--     mapC (concatMap $ replicate 2) =$= loop
--   where
--     loop = do
--         x <- takeCE 512 $= foldC
--         unless (null x) $ yield x >> loop

conduitRechunk1 :: [[Int]] -> IO [V.Vector Int]
conduitRechunk1 xs = C.yieldMany xs
        C.$= C.concatC
       C.=$= C.concatMapC (\x -> [x, x])
       C.=$= C.conduitVector 512
        C.$$ C.sinkList

-- conduitRechunk2 :: [[Int]] -> IO [V.Vector Int]
-- conduitRechunk2 xs = C.yieldMany xs
--      C.$= C.mapC (concatMap $ replicate 2)
--     C.=$= loop
--      C.$$ C.sinkList
--   where
--     loop = do
--         x <- C.takeCE 512 C.=$= C.foldC
--         unless (null x) $ C.yield x >> loop

conduitRechunk3 :: [[Int]] -> IO [V.Vector Int]
conduitRechunk3 xs = C.yieldMany xs
    C.$= C.vectorBuilderC 512 (\yield' -> C.mapM_CE (\x -> yield' x >> yield' x))
    C.$$ C.sinkList

yieldMany2 :: Monad m => [a] -> Source m a
yieldMany2 xs = source $ \z yield -> foldM yield z xs
{-# INLINE yieldMany2 #-}

sinkList2 :: Monad m => Sink a m [a]
sinkList2 = liftM (liftM ($ [])) $ sink id $ \r x -> return (r . (x:))
{-# INLINE sinkList2 #-}